map source file to target file

.gitignore

@@ -20,4 +20,3 @@ cabal.project.local
 cabal.project.local~
 .HTF/
 .ghc.environment.*
-examples/

app/Main.hs

@@ -1,10 +1,14 @@
 module Main where
 
-import Args
 import Options.Applicative (execParser)
+import Args
+import Itunes
 
 main :: IO ()
 main = execParser app >>= run
 
 run :: Args -> IO ()
 run = putStrLn . show
+
+escape :: Transform -> Action -> [Directory] ->  IO ()
+escape = undefined

escape-from-itunes.cabal

@@ -23,6 +23,8 @@ library
                      , optparse-applicative == 0.14.3.0
                      , regex-compat == 0.95.1
                      , data-accessor == 0.2.2.8
+                     , directory == 1.3.3.1
+                     , filepath == 1.4.2
   default-language:    Haskell2010
 
 executable escape-from-itunes
@@ -39,6 +41,7 @@ test-suite escape-from-itunes-test
   hs-source-dirs:      test
   main-is:             Spec.hs
   other-modules:       ArgsSpec
+                     , ItunesSpec
   build-depends:       base
                      , escape-from-itunes
                      , hspec

src/Attributes.hs

@@ -21,12 +21,13 @@ toAttribute "track" = Just Track
 toAttribute "composer" = Just Composer
 toAttribute _ = Nothing
 
-getAttribute :: Tag -> Attribute -> Maybe String
-getAttribute tag Artist = getArtist tag
-getAttribute tag Title = getTitle tag
-getAttribute tag Year = getYear tag
-getAttribute tag Track = getTrack tag
-getAttribute tag Composer = getFrameText "TCOM" tag
+getAttribute :: Attribute -> Tag -> Maybe String
+getAttribute Artist = getArtist
+getAttribute Title = getTitle
+getAttribute Album = getAlbum
+getAttribute Year = getYear
+getAttribute Track = getTrack
+getAttribute Composer = getFrameText "TCOM"
 
 getFrameText :: FrameID -> Tag -> Maybe String
 getFrameText frid tag = case tag^.frame frid of

src/Itunes.hs

@@ -1 +1,52 @@
 module Itunes where
+
+import Control.Monad (filterM)
+import Data.List (foldl')
+import System.IO (FilePath)
+import System.FilePath ((</>), takeFileName)
+import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
+import ID3.Simple (readTag, Tag)
+import Attributes (Attribute, getAttribute)
+
+type From = FilePath
+type To = FilePath
+type Directory = FilePath
+type PathSegment = String
+
+data Copy = Copy { from :: From
+                 , to :: To
+                 }
+
+type Action = Copy -> IO ()
+type Transform = From -> IO To
+
+handleDirectory :: Directory -> Transform -> IO ([Directory], [Copy])
+handleDirectory dir t = contents dir >>=
+    (\(dirs, files) -> ((,) dirs) <$> (sequence $ mkTarget t <$> files))
+
+contents :: Directory -> IO ([Directory], [FilePath])
+contents d = do
+    contents <- (fmap $ (</>) d) <$> listDirectory d
+    dirs <- filterM doesDirectoryExist contents
+    files <- filterM doesFileExist contents
+    return (dirs, files)
+
+mkTarget :: (From -> IO To) -> From -> IO Copy
+mkTarget t f = Copy f <$> t f
+
+mkTransform :: Directory -> [Attribute] -> (From -> IO To)
+mkTransform target attrs = transform
+  where transform f = defaultPath target f <$>
+                      (fmap $ joinPath target f) <$>
+                      (=<<) (readAttrs attrs) <$>
+                      (readTag f)
+
+readAttrs :: [Attribute] -> Tag -> Maybe [PathSegment]
+readAttrs attrs tag = sequence $ getAttribute <$> attrs <*> [tag]
+
+joinPath :: Directory -> From -> [PathSegment] -> To
+joinPath target f path = (foldl' (</>) target path) </> (takeFileName f)
+
+defaultPath :: Directory -> From -> Maybe To -> To
+defaultPath target _ (Just p) = p
+defaultPath target f Nothing = (target </> "<Nothing>") </> (takeFileName f)

stack.yaml

@@ -43,6 +43,8 @@ extra-deps: [
   , optparse-applicative-0.14.3.0
   , regex-compat-0.95.1
   , data-accessor-0.2.2.8
+  , directory-1.3.3.1
+  , filepath-1.4.2
 ]
 
 # Override default flag values for local packages and extra-deps

test/ItunesSpec.hs

@@ -0,0 +1,27 @@
+module ItunesSpec where
+
+import Test.Hspec
+import Attributes
+import Itunes
+
+spec :: Spec
+spec =
+    describe "transforming file path" $ do
+      it "joins the path segments from the attributes" $ do
+        joinPath "./target" "./src/artist/piece.mp3" ["composer", "album"] `shouldBe`
+          "./target/composer/album/piece.mp3"
+
+      it "anchors at target and interpolates the attribute values" $ do
+        let file = "./examples/holst/mars.mp3"
+        let target = "/home/stuart/music"
+        let attrs = [Composer, Album]
+        let transform = mkTransform target attrs
+        dest <- transform file
+        dest `shouldBe` "/home/stuart/music/Holst/Planets -- Atlanta Symphony/mars.mp3"
+      it "uses <Nothing> as a placeholder when attrs weren't satisfied" $ do
+        let file = "./examples/strauss/dinner.mp3"
+        let target = "/home/stuart/music"
+        let attrs = [Composer, Album]
+        let transform = mkTransform target attrs
+        dest <- transform file
+        dest `shouldBe` "/home/stuart/music/<Nothing>/dinner.mp3"