Parse Arguments

app/Main.hs

@@ -1,6 +1,10 @@
 module Main where
 
-import Data.String.Strip
+import Args
+import Options.Applicative (execParser)
 
 main :: IO ()
-main = interact strip
+main = execParser app >>= run
+
+run :: Args -> IO ()
+run = putStrLn . show

escape-from-itunes.cabal

@@ -15,9 +15,13 @@ cabal-version:       >=1.10
 
 library
   hs-source-dirs:      src
-  exposed-modules:     Data.String.Strip
+  exposed-modules:     Itunes
+                     , Args
+                     , Attributes
   build-depends:       base >= 4.7 && < 5
                      , idiii == 0.1.3.3
+                     , optparse-applicative == 0.14.3.0
+                     , regex-compat == 0.95.1
   default-language:    Haskell2010
 
 executable escape-from-itunes
@@ -26,16 +30,19 @@ executable escape-from-itunes
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   build-depends:       base
                      , escape-from-itunes
+                     , optparse-applicative == 0.14.3.0
   default-language:    Haskell2010
 
 test-suite escape-from-itunes-test
   type:                exitcode-stdio-1.0
   hs-source-dirs:      test
   main-is:             Spec.hs
+  other-modules:       ArgsSpec
   build-depends:       base
                      , escape-from-itunes
                      , hspec
                      , QuickCheck
+                     , optparse-applicative == 0.14.3.0
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010
 

src/Args.hs

@@ -0,0 +1,39 @@
+module Args where
+
+import Options.Applicative
+import Data.Semigroup ((<>))
+import Text.Regex (mkRegex, splitRegex)
+import Attributes
+
+data Args = Args {
+          source :: String
+          , target :: String
+          , attributes :: [Attribute]
+          }
+  deriving (Show, Eq)
+
+getArgs :: Parser Args
+getArgs = Args
+  <$> strOption
+    ( long "source" <>
+      short 's' <>
+      help "Root of existing library")
+  <*> strOption
+    ( long "target" <>
+      short 't' <>
+      help "Root of new library")
+  <*> attrList
+
+attrList :: Parser [Attribute]
+attrList = option (maybeReader attrList) (
+    long "attributes" <>
+    short 'a' <>
+    help "comma-separated list of orderedf attributes for building directory tree")
+  where attrList = sequence . (fmap toAttribute) . (splitRegex (mkRegex ","))
+        helpString = "comma-separated list of ordered attributes for building directory tree. Chosen from artist, title, album, year, track, composer"
+
+app :: ParserInfo Args
+app = info (getArgs <**> helper)
+      ( fullDesc
+     <> progDesc "Copies an iTunes music library to a new directory tree built from the ID3 tag hierarchy provided"
+     <> header "Make your music library make sense" )

src/Attributes.hs

@@ -0,0 +1,34 @@
+module Attributes where
+
+import Data.Accessor
+import ID3.Simple
+import ID3.Type
+
+data Attribute = Artist
+  | Title
+  | Album
+  | Year
+  | Track
+  | Composer
+  deriving (Show, Eq)
+
+toAttribute :: String -> Maybe Attribute
+toAttribute "artist" = Just Artist
+toAttribute "title" = Just Title
+toAttribute "album" = Just Album
+toAttribute "year" = Just Year
+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
+
+getFrameText :: FrameID -> Tag -> Maybe String
+getFrameText frid tag = case tag^.frame frid of
+                           Nothing -> Nothing
+                           Just fr -> Just (fr^.textContent)

src/Itunes.hs

@@ -0,0 +1 @@
+module Itunes where

stack.yaml

@@ -40,6 +40,8 @@ packages:
 # (e.g., acme-missiles-0.3)
 extra-deps: [
   idiii-0.1.3.3
+  , optparse-applicative-0.14.3.0
+  , regex-compat-0.95.1
 ]
 
 # Override default flag values for local packages and extra-deps

test/ArgsSpec.hs

@@ -0,0 +1,33 @@
+module ArgsSpec where
+
+import Test.Hspec
+import Options.Applicative
+import Attributes
+import Args
+
+spec = do
+  describe "parsing arguments" $ do
+    it "parses properly supplied short arguments" $ do
+      getParseResult (
+        execParserPure defaultPrefs app [ "-s"
+                                        , "/Users/shterrett/iTunesMusic"
+                                        , "-t"
+                                        , "/Users/shterrett/music"
+                                        , "-a"
+                                        , "composer,album,artist"
+                                        ])
+        `shouldBe` (Just $ Args "/Users/shterrett/iTunesMusic"
+                                "/Users/shterrett/music"
+                                [Composer, Album, Artist])
+    it "parses properly supplied long arguments" $ do
+      getParseResult (
+        execParserPure defaultPrefs app [ "--source"
+                                        , "/Users/shterrett/iTunesMusic"
+                                        , "--target"
+                                        , "/Users/shterrett/music"
+                                        , "--attributes"
+                                        , "composer,album,artist"
+                                        ])
+        `shouldBe` (Just $ Args "/Users/shterrett/iTunesMusic"
+                                "/Users/shterrett/music"
+                                [Composer, Album, Artist])