Change command-line usage

Now using optparse-applicative to support subcommands

(There is presently only one subcommand: 'build')

2 files changed, 33 insertions, 15 deletions

diff --git a/fsmgr.cabal b/fsmgr.cabal
index 3da9bf6..4b96133 100644
--- a/fsmgr.cabal
+++ b/fsmgr.cabal
@@ -35,7 +35,7 @@ executable fsmgr
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -W -Wall
   build-depends: fsmgr,
                  base >=4.7 && <5, rebase, optparse-applicative, typed-process,
-                 directory, filepath, yaml-combinators, lens, lens-aeson, cryptonite, memory, basement, shake
+                 directory, filepath, yaml-combinators, lens, lens-aeson, cryptonite, memory, basement, shake, optparse-applicative
   default-language: Haskell2010
 
 -- test-suite fsmgr-test
diff --git a/fsmgr.hs b/fsmgr.hs
index d5df8ac..a72e510 100644
--- a/fsmgr.hs
+++ b/fsmgr.hs
@@ -8,13 +8,16 @@
 {-# LANGUAGE ScopedTypeVariables  #-}
 
 module Main where
-import Rebase.Prelude hiding (bool, hash, (<.>))
+import Rebase.Prelude hiding (bool, hash, o, (<.>))
 
-import Development.Shake            hiding (getEnv)
-import Development.Shake.Command    ()
+import qualified Rebase.Data.Text as Text
+         ;import Rebase.Data.Text (pack, unpack)
+
+import Development.Shake          hiding (getEnv)
+import Development.Shake.Command  ()
 import Development.Shake.FilePath
-import qualified Rebase.Data.Text   as Text
-         ;import Rebase.Data.Text   (pack, unpack)
+
+import Options.Applicative as Opt
 
 import ConfigFile
 
@@ -98,16 +101,31 @@ defaultImageName = "minbase"
 stripSuffix :: Text -> String -> String
 stripSuffix s t = fromMaybe t $ fmap unpack $ Text.stripSuffix s $ pack t
 
+data Options = Options { optCommand :: Command }
+data Command = Build BuildOpts
+data BuildOpts = BuildOpts { optTarget :: String }
+
+buildOpts :: Parser Command
+buildOpts = Build . BuildOpts <$> argument str idm
+
+-- TODO: Fail early on:
+-- 1. not running as root
+-- 2. no "selfstrap" in PATH
 main :: IO ()
-main = do
-  -- TODO: Fail early on:
-  -- 1. not running as root
-  -- 2. no "selfstrap" in PATH
-  args <- getArgs
-  case args of
-    [target] -> shakeBuildOneImage (stripSuffix ".yaml" target)
-    []       -> shakeBuildOneImage defaultImageName
-    _        -> error "usage"
+main = customExecParser (prefs showHelpOnEmpty) (info opts desc) >>= run
+  where
+    opts :: Parser Options
+    opts = Options <$> parseCommand
+    desc = fullDesc <> progDesc detailed <> header "fsmgr - Debian rootfs image manager"
+    detailed = unwords ["This program generates btrfs filesystem images using 'selfstrap'",
+                        "which, much like 'debootstrap', creates new installations of Debian."]
+    parseCommand :: Parser Command
+    parseCommand = subparser $ Opt.command "build" (info' buildOpts buildDesc)
+    buildDesc = ["build the image specified by the YAML config file"]
+    info' o d = info (helper <*> o) (progDesc $ unwords d)
+
+run :: Options -> IO ()
+run (Options (Build (BuildOpts target)))= shakeBuildOneImage (stripSuffix ".yaml" target)
 
 shakeBuildOneImage :: FilePath -> IO ()
 shakeBuildOneImage target =