BandCamp.hs

module Main where

import System.Directory
import System.FilePath
import System.Process
import Data.Maybe
import Data.List

myMusicDirectory = "/home/shae/Music"

main :: IO ()
main = do
  let allDirs = (myMusicDirectory </> ) <$> dirList
  print allDirs
  eachFoo <- mapM listDirectory' allDirs
  let flacsOnly = filter (("calf" ==) . take 4 . reverse) <$> eachFoo
      transCode = concatMap (fmap transcodeCommand) (newNames <$> flacsOnly)
  mapM_ callCommand transCode

wrapFile :: FilePath -> FilePath
wrapFile f = "\"" <> f <> "\""

transcodeCommand :: (String, String) -> String
transcodeCommand (old,new) =
    mconcat [", sox --show-progress --no-clobber "
            , wrapFile old
            , " -r 44100 -b 16 "
            , wrapFile $ replaceFileName old new
            ]

listDirectory' :: FilePath -> IO [FilePath]
listDirectory' dir = do
    fs <- listDirectory dir
    pure $ (dir </>) <$> fs

prefexes :: [[Char]]
prefexes = [[a,b,'-'] | a <- letrs, b <- letrs]
    where letrs = ['A' .. 'Z']

newNames :: [FilePath] -> [(FilePath,FilePath)]
newNames oops@[_] = error $ "newNames breaks with one input " <> show oops
newNames paths = zip (sort paths) $ zipWith (<>) prefexes newPaths
    where cp = commonPrefix paths :: FilePath
          newPaths = sort $ drop (length cp) <$> paths

the :: Eq a => [a] -> Maybe a
the [] = Nothing
the (x:xs)
  | all (==x) xs = Just x
  | otherwise          = Nothing

commonPrefix :: Eq a => [[a]] -> [a]
commonPrefix = catMaybes . takeWhile isJust . map the . transpose

dirList = [ "danheim/2018_runagaldr"
          , "danheim/2021_domadagr"
          , "danheim/singles"
          , "tipper/2019_jettison_mind_hatch"
          , "tipper/2021_insolito"
          , "tipper/2022_marble_hunting"
]