Add optparse-applicative for parsing args (#46)

app/Command.hs

@@ -0,0 +1,21 @@
+module Command where
+
+import Options.Applicative
+
+data Command
+  = Deploy
+  | Rollback
+  deriving Show
+
+addCommand :: Command -> String -> String -> Mod CommandFields Command
+addCommand command' name description =
+  command name (info (pure command') (progDesc description))
+
+commands :: Parser Command
+commands
+  = subparser
+    (
+    addCommand Deploy "deploy" "Deploys the current release with the configure options"
+    <> addCommand Rollback "rollback" "Rolls back to the previous release"
+    )
+

app/Flag.hs

@@ -0,0 +1,11 @@
+module Flag where
+
+import Options.Applicative
+
+data Flag
+  = Version
+  deriving Show
+
+flags :: Parser Flag
+flags =
+  flag' Version (long "version" <> short 'v' <> help "Diplay the version of Hapistrano")

app/Main.hs

@@ -8,13 +8,13 @@ import System.Environment.Compat (lookupEnv)
 
 import System.Hapistrano (ReleaseFormat(..))
 
-import qualified Control.Monad as Monad
+import Control.Applicative (pure, (<*>))
-import qualified Data.Maybe as Maybe
-import qualified System.Console.GetOpt as GetOpt
-import qualified System.Environment as Environment
-import qualified System.Exit as Exit
 import qualified System.Exit.Compat as Exit
-import qualified System.IO as IO
+
+import Options
+
+import Paths_hapistrano (version)
+import Data.Version (showVersion)
 
 -- | Rolls back to previous release.
 rollback :: Hap.Config -> IO ()
@@ -66,82 +66,20 @@ configFromEnv = do
   where
     noEnv env = env ++ " environment variable does not exist"
 
-data HapCommand
-  = HapDeploy
-  | HapRollback
-  deriving Show
-
-parseHapCommand :: String -> Maybe HapCommand
-parseHapCommand "deploy" = Just HapDeploy
-parseHapCommand "rollback" = Just HapRollback
-parseHapCommand _ = Nothing
-
-data HapOptions =
-  HapOptions
-    { hapCommand :: Maybe HapCommand
-    , hapHelp :: Bool
-    }
-  deriving Show
-
-defaultHapOptions :: HapOptions
-defaultHapOptions =
-  HapOptions
-    { hapCommand = Nothing
-    , hapHelp = False
-    }
-
-hapOptionDescriptions :: [GetOpt.OptDescr (HapOptions -> HapOptions)]
-hapOptionDescriptions =
-  [ GetOpt.Option
-      ['h']
-      ["help"]
-      (GetOpt.NoArg (\hapOptions -> hapOptions { hapHelp = True }))
-      "Show this help text"
-
-  ]
-
-parseHapOptions :: [String] -> Either String HapOptions
-parseHapOptions args =
-  case GetOpt.getOpt GetOpt.Permute hapOptionDescriptions args of
-    (options, [], []) ->
-      Right (foldl (flip id) defaultHapOptions options)
-
-    (options, [command], []) ->
-      case parseHapCommand command of
-        Nothing ->
-          Left ("Invalid argument: " ++ command)
-
-        maybeHC ->
-          Right (foldl (flip id) defaultHapOptions {hapCommand = maybeHC} options)
-
-    _ ->
-      Left "First argument must be either 'deploy' or 'rollback'."
-
-hapHelpAction :: Maybe HapCommand -> IO ()
-hapHelpAction _ =
-  putStrLn hapUsage >> Exit.exitSuccess
-
-hapUsage :: String
-hapUsage =
-  GetOpt.usageInfo hapUsageHeader hapOptionDescriptions
-
-hapUsageHeader :: String
-hapUsageHeader =
-  "usage: hap [-h | --help] <command>\n"
-
 main :: IO ()
-main = do
+main = execParser (info (helper <*> opts) hapistranoDesc) >>= runOption
-  eitherHapOptions <- fmap parseHapOptions Environment.getArgs
 
-  HapOptions{..} <- either Exit.die return eitherHapOptions
+runOption :: Option -> IO ()
+runOption (Command command) = runCommand command
+runOption (Flag flag) = runFlag flag
 
-  Monad.when hapHelp (hapHelpAction hapCommand)
+runCommand :: Command -> IO ()
+runCommand Deploy = configFromEnv >>= deploy
+runCommand Rollback = configFromEnv >>= rollback
 
-  hapConfiguration <- configFromEnv
+runFlag :: Flag -> IO ()
+runFlag Version = printVersion
 
-  case hapCommand of
+printVersion :: IO ()
-    Just HapDeploy -> deploy hapConfiguration
+printVersion = putStrLn $ "Hapistrano " ++ showVersion version
 
-    Just HapRollback -> rollback hapConfiguration
-
-    Nothing -> hapHelpAction Nothing

app/Options.hs

@@ -0,0 +1,37 @@
+module Options (
+  Option(..)
+  , opts
+  , hapistranoDesc
+  -- | Imports from Options.Applicative
+  , execParser
+  , info
+  , helper
+  -- | Imports from other internal modules
+  , module Command
+  , module Flag
+  )
+  where
+
+import Command as Command
+import Flag as Flag
+
+import Options.Applicative
+
+-- | Flags and commands
+opts :: Parser Option
+opts
+  = fmap Flag flags
+  <|> fmap Command commands
+
+data Option
+  = Command (Command.Command)
+  | Flag (Flag.Flag)
+  deriving Show
+
+hapistranoDesc :: InfoMod a
+hapistranoDesc =
+  fullDesc
+    <> header "Hapistrano - A deployment library for Haskell applications"
+    <> progDesc "Deploy tool for Haskell applications"
+    <> footer "Run 'hap -h' for available commands"
+

hapistrano.cabal

@@ -48,9 +48,13 @@ library
 executable hap
   hs-source-dirs:      app
   main-is:             Main.hs
+  other-modules:       Options
+                      , Command
+                      , Flag
   build-depends:       base
                      , hapistrano
                      , base-compat >= 0.6 && < 1.0
+                     , optparse-applicative >= 0.11 && < 0.14
   ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010