summaryrefslogtreecommitdiff
path: root/fsmgr.hs
diff options
context:
space:
mode:
Diffstat (limited to 'fsmgr.hs')
-rw-r--r--fsmgr.hs46
1 files changed, 32 insertions, 14 deletions
diff --git a/fsmgr.hs b/fsmgr.hs
index d5df8ac..a72e510 100644
--- a/fsmgr.hs
+++ b/fsmgr.hs
@@ -8,13 +8,16 @@
8{-# LANGUAGE ScopedTypeVariables #-} 8{-# LANGUAGE ScopedTypeVariables #-}
9 9
10module Main where 10module Main where
11import Rebase.Prelude hiding (bool, hash, (<.>)) 11import Rebase.Prelude hiding (bool, hash, o, (<.>))
12 12
13import Development.Shake hiding (getEnv) 13import qualified Rebase.Data.Text as Text
14import Development.Shake.Command () 14 ;import Rebase.Data.Text (pack, unpack)
15
16import Development.Shake hiding (getEnv)
17import Development.Shake.Command ()
15import Development.Shake.FilePath 18import Development.Shake.FilePath
16import qualified Rebase.Data.Text as Text 19
17 ;import Rebase.Data.Text (pack, unpack) 20import Options.Applicative as Opt
18 21
19import ConfigFile 22import ConfigFile
20 23
@@ -98,16 +101,31 @@ defaultImageName = "minbase"
98stripSuffix :: Text -> String -> String 101stripSuffix :: Text -> String -> String
99stripSuffix s t = fromMaybe t $ fmap unpack $ Text.stripSuffix s $ pack t 102stripSuffix s t = fromMaybe t $ fmap unpack $ Text.stripSuffix s $ pack t
100 103
104data Options = Options { optCommand :: Command }
105data Command = Build BuildOpts
106data BuildOpts = BuildOpts { optTarget :: String }
107
108buildOpts :: Parser Command
109buildOpts = Build . BuildOpts <$> argument str idm
110
111-- TODO: Fail early on:
112-- 1. not running as root
113-- 2. no "selfstrap" in PATH
101main :: IO () 114main :: IO ()
102main = do 115main = customExecParser (prefs showHelpOnEmpty) (info opts desc) >>= run
103 -- TODO: Fail early on: 116 where
104 -- 1. not running as root 117 opts :: Parser Options
105 -- 2. no "selfstrap" in PATH 118 opts = Options <$> parseCommand
106 args <- getArgs 119 desc = fullDesc <> progDesc detailed <> header "fsmgr - Debian rootfs image manager"
107 case args of 120 detailed = unwords ["This program generates btrfs filesystem images using 'selfstrap'",
108 [target] -> shakeBuildOneImage (stripSuffix ".yaml" target) 121 "which, much like 'debootstrap', creates new installations of Debian."]
109 [] -> shakeBuildOneImage defaultImageName 122 parseCommand :: Parser Command
110 _ -> error "usage" 123 parseCommand = subparser $ Opt.command "build" (info' buildOpts buildDesc)
124 buildDesc = ["build the image specified by the YAML config file"]
125 info' o d = info (helper <*> o) (progDesc $ unwords d)
126
127run :: Options -> IO ()
128run (Options (Build (BuildOpts target)))= shakeBuildOneImage (stripSuffix ".yaml" target)
111 129
112shakeBuildOneImage :: FilePath -> IO () 130shakeBuildOneImage :: FilePath -> IO ()
113shakeBuildOneImage target = 131shakeBuildOneImage target =