on master help sign in
command: Factor out common thunk command options
commitba1ddd1a7083d544d57e7d9b7abcea4856f6c853 authorElliot Cameron <eacameron@gmail.com> dateFri 27 Mar 2020, 14:46 (7 years ago) parentc497e3a
1 file changed+29−18
lib/command/src/Obelisk/Command.hs+29−18
lib/command/src/Obelisk/Command.hs+29−18
@@ -9,7 +9,9 @@ import Control.Monad
99import Control.Monad.IO.Class (liftIO)
1010import Data.Bool (bool)
1111import Data.Foldable (for_)
12−import Data.List
12+import Data.List (isInfixOf, isPrefixOf)
13+import Data.List.NonEmpty (NonEmpty)
14+import qualified Data.List.NonEmpty as NonEmpty
1315import qualified Data.Text as T
1416import Options.Applicative
1517import Options.Applicative.Help.Pretty (text, (<$$>))
@@ -82,7 +84,7 @@ data ObCommand
8284 | ObCommand_Deploy DeployCommand
8385 | ObCommand_Run
8486 | ObCommand_Profile String [String]
85− | ObCommand_Thunk ThunkCommand
87+ | ObCommand_Thunk ThunkOption
8688 | ObCommand_Repl
8789 | ObCommand_Watch
8890 | ObCommand_Shell ShellOpts
@@ -104,7 +106,7 @@ obCommand cfg = hsubparser
104106 , command "deploy" $ info (ObCommand_Deploy <$> deployCommand cfg) $ progDesc "Prepare a deployment for an Obelisk project"
105107 , command "run" $ info (pure ObCommand_Run) $ progDesc "Run current project in development mode"
106108 , command "profile" $ info (uncurry ObCommand_Profile <$> profileCommand) $ progDesc "Run current project with profiling enabled"
107− , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"
109+ , command "thunk" $ info (ObCommand_Thunk <$> thunkOption) $ progDesc "Manipulate thunk directories"
108110 , command "repl" $ info (pure ObCommand_Repl) $ progDesc "Open an interactive interpreter"
109111 , command "watch" $ info (pure ObCommand_Watch) $ progDesc "Watch current project for errors and warnings"
110112 , command "shell" $ info (ObCommand_Shell <$> shellOpts) $ progDesc "Enter a shell with project dependencies"
@@ -224,20 +226,27 @@ thunkPackConfig = ThunkPackConfig
224226 <$> switch (long "force" <> short 'f' <> help "Force packing thunks even if there are branches not pushed upstream, uncommitted changes, stashes. This will cause changes that have not been pushed upstream to be lost; use with care.")
225227 <*> thunkConfig
226228
229+data ThunkOption = ThunkOption
230+ { _thunkOption_thunks :: NonEmpty FilePath
231+ , _thunkOption_command :: ThunkCommand
232+ } deriving Show
233+
227234data ThunkCommand
228− = ThunkCommand_Update [FilePath] ThunkUpdateConfig
229− | ThunkCommand_Unpack [FilePath]
230− | ThunkCommand_Pack [FilePath] ThunkPackConfig
231− | ThunkCommand_Init [FilePath]
235+ = ThunkCommand_Update ThunkUpdateConfig
236+ | ThunkCommand_Unpack
237+ | ThunkCommand_Pack ThunkPackConfig
238+ | ThunkCommand_Init
232239 deriving Show
233240
234−thunkCommand :: Parser ThunkCommand
235−thunkCommand = hsubparser $ mconcat
236− [ command "update" $ info (ThunkCommand_Update <$> some thunkDirectoryParser <*> thunkUpdateConfig) $ progDesc "Update thunk to latest revision available"
237− , command "unpack" $ info (ThunkCommand_Unpack <$> some thunkDirectoryParser) $ progDesc "Unpack thunk into git checkout of revision it points to"
238− , command "pack" $ info (ThunkCommand_Pack <$> some thunkDirectoryParser <*> thunkPackConfig) $ progDesc "Pack git checkout into thunk that points at the current branch's upstream"
239− , command "init" $ info (ThunkCommand_Init <$> some thunkDirectoryParser) $ progDesc "Initialize a git checkout by converting it to an unpacked thunk"
241+thunkOption :: Parser ThunkOption
242+thunkOption = hsubparser $ mconcat
243+ [ command "update" $ info (thunkOptionWith $ ThunkCommand_Update <$> thunkUpdateConfig) $ progDesc "Update thunk to latest revision available"
244+ , command "unpack" $ info (thunkOptionWith $ pure ThunkCommand_Unpack) $ progDesc "Unpack thunk into git checkout of revision it points to"
245+ , command "pack" $ info (thunkOptionWith $ ThunkCommand_Pack <$> thunkPackConfig) $ progDesc "Pack git checkout into thunk that points at the current branch's upstream"
246+ , command "init" $ info (thunkOptionWith $ pure ThunkCommand_Init) $ progDesc "Initialize a git checkout by converting it to an unpacked thunk"
240247 ]
248+ where
249+ thunkOptionWith f = ThunkOption <$> NonEmpty.some1 thunkDirectoryParser <*> f
241250
242251data ShellOpts
243252 = ShellOpts
@@ -374,11 +383,13 @@ ob = \case
374383 DeployCommand_Test (platform, extraArgs) -> deployMobile platform extraArgs
375384 ObCommand_Run -> run
376385 ObCommand_Profile basePath rtsFlags -> profile basePath rtsFlags
377− ObCommand_Thunk tc -> case tc of
378− ThunkCommand_Update thunks config -> for_ thunks (updateThunkToLatest config)
379− ThunkCommand_Unpack thunks -> for_ thunks unpackThunk
380− ThunkCommand_Pack thunks config -> for_ thunks (packThunk config)
381− ThunkCommand_Init thunks -> for_ thunks initThunk
386+ ObCommand_Thunk to -> case _thunkOption_command to of
387+ ThunkCommand_Update config -> for_ thunks (updateThunkToLatest config)
388+ ThunkCommand_Unpack -> for_ thunks unpackThunk
389+ ThunkCommand_Pack config -> for_ thunks (packThunk config)
390+ ThunkCommand_Init -> for_ thunks initThunk
391+ where
392+ thunks = _thunkOption_thunks to
382393 ObCommand_Repl -> runRepl
383394 ObCommand_Watch -> runWatch
384395 ObCommand_Shell so -> withProjectRoot "." $ \root ->