commander-cli 0.9.0.0 → 0.10.0.0

raw patch · 4 files changed

+165/−67 lines, 4 filesdep +containersPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

API changes (from Hackage documentation)

Files

• README.md +74/−13
• app/Main.hs +28/−20
• commander-cli.cabal +3/−2
• src/Options/Commander.hs +60/−32

@@ -5,21 +5,81 @@  This library is meant to allow Haskell programs to quickly and easily construct command line interfaces which are easy to use, especially as a Haskell user. To-begin, I suggest viewing/playing with the task-manager application which-comes with this repository. Its usage info is generated as:+learn, I suggest viewing/playing with the task-manager application which+comes with this repository. Here, we'll display a simpler example: -```bash+```haskell+main = command_ . toplevel @"argument-taker" . arg @"example-argument" $ raw . putStrLn+```++When you run this program with `argument-taker help`, you will see:++``` usage:-task-manager help-task-manager (required env: TASK_DIRECTORY :: [Char]) edit <task-name :: [Char]>-task-manager (required env: TASK_DIRECTORY :: [Char]) open <task-name :: [Char]>-task-manager (required env: TASK_DIRECTORY :: [Char]) close <task-name :: [Char]>-task-manager (required env: TASK_DIRECTORY :: [Char]) tasks-task-manager (required env: TASK_DIRECTORY :: [Char]) priorities-task-manager (required env: TASK_DIRECTORY :: [Char])+name: argument-taker+|++- subprogram: help+|+`- argument: example-argument :: [Char] ``` +The meaning of this is that every path in the tree is a unique command. The one+we've used is the help command. If we run this program with `argument-taker hello`+we will see: +```+hello+```++Okay, so we've made a program with hardly any scaffolding that gives us a+decent help message, and pipes through our argument correctly. Naturally, we+might want to expand on the documentation of this program, as its not quite+obvious enough what it does.++```+main = command_ . toplevel @"argument-taker" . arg @"example-argument" $ (description @"Takes the argument and prints it" . raw . putStrLn)+```++Printing out the documentation again with `argument-taker help`, we see:++```haskell+usage:+name: argument-taker+|++- subprogram: help+|+`- argument: example-argument :: [Char]+   |+   `- description: Takes the argument and prints it+```++Okay, so we can expand the documentation. But what if I have an option to pass to the same program? Well, we can pass an option like so:++```+main = command_ . toplevel @"argument-taker" $+  opt @"m" @"mode" \mode ->+    arg @"example-argument" $ \arg ->+      description @"Takes the argument and prints it or not, depending on the mode" . raw $ do+        if mode == "Print" then putStrLn arg else pure ()+```++Now, when we run `argument-taker help` we will see:++```+usage:+name: argument-taker+|++- subprogram: help+|+`- option: -m <mode :: [Char]>+   |+   `- argument: example-argument :: [Char]+      |+      `- description: Takes the argument and prints it or not, depending on the mode+```++## Design+ The library is based around the following classes:  ```haskell@@ -35,10 +95,11 @@   data ProgramT p m a   run :: ProgramT p IO a -> CommanderT State IO a   hoist :: (forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a-  invocations :: [Text]+  documentation :: Forest String ```  Instances of this class will define a syntactic element, a new instance of the data family ProgramT, as well as its semantics in terms of the CommanderT monad,-which is a backtracking monad based on a metaphor to military commanders which-retreats upon defeat.+which is something like a free backtracking monad. Users should not have to make+instances of this class, as the common CLI elements are already defined as+instances. Of course, you can if you want to, and it can be profitable to do so.

@@ -1,3 +1,4 @@+{-# LANGUAGE BlockArguments #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -21,32 +22,39 @@  type TaskManager   = Named "task-manager"-  & ("help" & Raw-  + Env 'Optional "TASK_DIRECTORY" FilePath-    & ("edit"  & TaskProgram-     + "open"  & TaskProgram-     + "close" & TaskProgram-     + "tasks" & Raw-     + "priorities" & Raw+  & Env 'Optional "TASK_DIRECTORY" FilePath+    & ("help"+      & Description "Displays this help text."+      & Raw+     + "edit"+      & Description "Edits an already existing task. Fails if the task does not exist."+      & TaskProgram+     + "open"+      & Description "Opens a new task for editing. Fails if the task exists already."+      & TaskProgram+     + "close"+      & Description "Closes a task. Fails if there are remaining priorities within the task."+      & TaskProgram+     + "tasks"+      & Description "Lists current tasks."+      & Raw+     + "priorities" +      & Description "Lists priorities for every task."+      & Raw      + Raw     )-  )  type TaskProgram = Arg "task-name" String & Raw    taskManager :: ProgramT TaskManager IO ()-taskManager = toplevel @"task-manager" . envOptDef @"TASK_DIRECTORY" "tasks" $ \tasksFilePath -> -      sub @"edit" (editTask tasksFilePath) -  <+> sub @"open" (newTask tasksFilePath)-  <+> sub @"close" (closeTask tasksFilePath)-  <+> sub @"tasks" (listTasks tasksFilePath)-  <+> sub @"priorities" (listPriorities tasksFilePath)-  <+> hoist describeTaskManager (usage @TaskManager)-  where-    describeTaskManager :: IO a -> IO a-    describeTaskManager io = do-      putStrLn "Welcome to the Task Manager! This is a tool to help you manage tasks, each with priorities."-      io+taskManager = named @"task-manager" . envOptDef @"TASK_DIRECTORY" "tasks" $ \tasksFilePath -> +      sub @"help" (description $ usage @TaskManager)+  <+> sub @"edit" (description $ editTask tasksFilePath) +  <+> sub @"open" (description $ newTask tasksFilePath)+  <+> sub @"close" (description $ closeTask tasksFilePath)+  <+> sub @"tasks" (description $ listTasks tasksFilePath)+  <+> sub @"priorities" (description $ listPriorities tasksFilePath)+  <+> usage @TaskManager  editTask tasksFilePath = arg @"task-name" $ \taskName -> raw    $ withTask tasksFilePath taskName $ \Context{home} task -> callProcess "vim" [home ++ "/" <> tasksFilePath <> "/" ++ taskName ++ ".task"]

@@ -1,7 +1,7 @@ cabal-version:       2.4  name:                commander-cli-version:             0.9.0.0+version:             0.10.0.0 synopsis:            A command line argument/option parser library description:         A command line argument/option parser library. homepage:            https://github.com/SamuelSchlesinger/commander-cli@@ -46,7 +46,8 @@                        mtl >=2.2 && <3,                        text >=1.2 && <2,                        unordered-containers >=0.2 && < 1,-                       commandert >=0.1+                       commandert >=0.1,+                       containers >=0.1   hs-source-dirs:      src   default-language:    Haskell2010 

@@ -78,7 +78,7 @@     variables as well. We also have a convenience combinator, 'toplevel',     which lets you add a name and a help command to your program using the 'usage' combinator.   -}-  arg, opt, optDef, raw, sub, named, flag, toplevel, (<+>), usage, env, envOpt, envOptDef,+  arg, opt, optDef, raw, sub, named, flag, toplevel, (<+>), usage, env, envOpt, envOptDef, description,   -- ** Run CLI Programs   {- |     To run a 'ProgramT' (a specification of a CLI program), you will @@ -89,14 +89,14 @@     Each 'ProgramT' has a type level description, build from these type level     combinators.   -}-  type (&), type (+), Arg, Opt, Named, Raw, Flag, Env, Optionality(Required, Optional),+  type (&), type (+), Arg, Opt, Named, Raw, Flag, Env, Optionality(Required, Optional), Description,   -- ** Interpreting CLI Programs   {- |     The 'HasProgram' class forms the backbone of this library, defining the     syntax for CLI programs using the 'ProgramT' data family, and defining     the interpretation of all of the various pieces of a CLI.   -}-  HasProgram(ProgramT, run, hoist, invocations),+  HasProgram(ProgramT, run, hoist, documentation),   ProgramT(ArgProgramT, unArgProgramT,            OptProgramT, unOptProgramT, unOptDefault,            RawProgramT, unRawProgramT,@@ -105,6 +105,7 @@            FlagProgramT, unFlagProgramT,            EnvProgramT'Optional, unEnvProgramT'Optional, unEnvDefault,            EnvProgramT'Required, unEnvProgramT'Required,+           DescriptionProgramT,            (:+:)            ),   -- ** The CommanderT Monad@@ -144,6 +145,7 @@ import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as LBS import Control.Monad.Commander+import Data.Tree  -- | A class for interpreting command line arguments into Haskell types. class Typeable t => Unrender t where@@ -235,6 +237,10 @@ -- program to just do some computation. data Raw :: * +-- | The type level description combinator, allowing a command line program+-- to have better documentation.+data Description :: Symbol -> *+ -- | The type level tag for whether or not a variable is required or not. data Optionality = Required | Optional @@ -268,14 +274,14 @@ -- think of 'ProgramT' as a useful syntax for command line programs, but -- 'CommanderT' as the semantics of that program. We also give the ability -- to 'hoist' 'ProgramT' actions between monads if you can uniformly turn--- computations in one into another. All of the different 'invocations'--- are also stored to give a primitive form of automatically generated--- documentation.+-- computations in one into another. We also store 'documentation' in the+-- form of a @'Forest' 'String'@, in order to automatically generate+-- 'usage' programs. class HasProgram p where   data ProgramT p (m :: * -> *) a   run :: ProgramT p IO a -> CommanderT State IO a   hoist :: (forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a-  invocations :: [Text]+  documentation :: Forest String  instance (Unrender t, KnownSymbol name, HasProgram p) => HasProgram (Env 'Required name t & p) where   newtype ProgramT (Env 'Required name t & p) m a = EnvProgramT'Required { unEnvProgramT'Required :: t -> ProgramT p m a }@@ -288,10 +294,10 @@           Nothing -> return (Defeat, state)       Nothing -> return (Defeat, state)   hoist n (EnvProgramT'Required f) = EnvProgramT'Required (hoist n . f)-  invocations =-    [(("(required env: " <> pack (symbolVal (Proxy @name))-    <> " :: " <> pack (show (typeRep (Proxy @t)))-    <> ") ") <>)] <*> invocations @p+  documentation = [Node+    ("required env: " <> symbolVal (Proxy @name)+    <> " :: " <> show (typeRep (Proxy @t)))+    (documentation @p)]  instance (Unrender t, KnownSymbol name, HasProgram p) => HasProgram (Env 'Optional name t & p) where   data ProgramT (Env 'Optional name t & p) m a = EnvProgramT'Optional@@ -307,10 +313,10 @@       Nothing -> return (run (unEnvProgramT'Optional f (unEnvDefault f)), state)    hoist n (EnvProgramT'Optional f d) = EnvProgramT'Optional (hoist n . f) d-  invocations =-    [(("(optional env: " <> pack (symbolVal (Proxy @name))-    <> " :: " <> pack (show (typeRep (Proxy @t)))-    <> ") ") <>)] <*> invocations @p+  documentation = [Node+    ("optional env: " <> symbolVal (Proxy @name)+    <> " :: " <> show (typeRep (Proxy @t)))+    (documentation @p)]  instance (Unrender t, KnownSymbol name, HasProgram p) => HasProgram (Arg name t & p) where   newtype ProgramT (Arg name t & p) m a = ArgProgramT { unArgProgramT :: t -> ProgramT p m a }@@ -322,16 +328,16 @@           Nothing -> return (Defeat, State{..})       [] -> return (Defeat, State{..})   hoist n (ArgProgramT f) = ArgProgramT (hoist n . f)-  invocations =-    [(("<" <> pack (symbolVal (Proxy @name))-    <> " :: " <> pack (show (typeRep (Proxy @t)))-    <> "> ") <>)] <*> invocations @p+  documentation = [Node+    ("argument: " <> symbolVal (Proxy @name)+    <> " :: " <> show (typeRep (Proxy @t)))+    (documentation @p)]  instance (HasProgram x, HasProgram y) => HasProgram (x + y) where   data ProgramT (x + y) m a = ProgramT x m a :+: ProgramT y m a   run (f :+: g) = run f <|> run g   hoist n (f :+: g) = hoist n f :+: hoist n g-  invocations = invocations @x <> invocations @y+  documentation = documentation @x <> documentation @y  infixr 2 :+: @@ -339,8 +345,7 @@   newtype ProgramT Raw m a = RawProgramT { unRawProgramT :: m a }   run = liftIO . unRawProgramT   hoist n (RawProgramT m) = RawProgramT (n m)-  invocations = [mempty]-+  documentation = []  instance (KnownSymbol name, KnownSymbol option, HasProgram p, Unrender t) => HasProgram (Opt option name t & p) where   data ProgramT (Opt option name t & p) m a = OptProgramT@@ -354,11 +359,12 @@           Nothing -> return (Defeat, State{..})       Nothing  -> return (run (unOptProgramT f (unOptDefault f)), State{..})   hoist n (OptProgramT f d) = OptProgramT (hoist n . f) d-  invocations =-    [(("-" <> pack (symbolVal (Proxy @option)) -    <> " <" <> pack (symbolVal (Proxy @name)) -    <> " :: " <> pack (show (typeRep (Proxy @t)))-    <> "> ") <>)  ] <*> invocations @p+  documentation = [Node+    ("option: -" <> symbolVal (Proxy @option)+    <> " <" <> symbolVal (Proxy @name)+    <> " :: " <> show (typeRep (Proxy @t))+    <> ">")+    (documentation @p)]  instance (KnownSymbol flag, HasProgram p) => HasProgram (Flag flag & p) where   newtype ProgramT (Flag flag & p) m a = FlagProgramT { unFlagProgramT :: Bool -> ProgramT p m a }@@ -366,14 +372,26 @@     let presence = HashSet.member (pack (symbolVal (Proxy @flag))) flags     return (run (unFlagProgramT f presence), State{..})   hoist n = FlagProgramT . fmap (hoist n) . unFlagProgramT-  invocations = [(("~" <> pack (symbolVal (Proxy @flag)) <> " ") <>)] <*> invocations @p+  documentation = [Node+    ("flag: ~" <> symbolVal (Proxy @flag))+    (documentation @p)]  instance (KnownSymbol name, HasProgram p) => HasProgram (Named name & p) where   newtype ProgramT (Named name &p) m a = NamedProgramT { unNamedProgramT :: ProgramT p m a }   run = run . unNamedProgramT    hoist n = NamedProgramT . hoist n . unNamedProgramT-  invocations = [((pack (symbolVal (Proxy @name)) <> " ") <>)] <*> invocations @p+  documentation = [Node+    ("name: " <> symbolVal (Proxy @name))+    (documentation @p)] +instance (KnownSymbol description, HasProgram p) => HasProgram (Description description & p) where+  newtype ProgramT (Description description &p) m a = DescriptionProgramT { unDescriptionProgramT :: ProgramT p m a }+  run = run . unDescriptionProgramT +  hoist n = DescriptionProgramT . hoist n . unDescriptionProgramT+  documentation = [Node+    ("description: " <> symbolVal (Proxy @description))+    []] <> documentation @p+ instance (KnownSymbol sub, HasProgram p) => HasProgram (sub & p) where   newtype ProgramT (sub & p) m a = SubProgramT { unSubProgramT :: ProgramT p m a }   run s = Action $ \State{..} -> do @@ -384,8 +402,9 @@           else return (Defeat, State{..})       [] -> return (Defeat, State{..})   hoist n = SubProgramT . hoist n . unSubProgramT-  invocations = [(pack (symbolVal (Proxy @sub) <> " ") <> )] -            <*> invocations @p+  documentation = [Node+    ("subprogram: " <> symbolVal (Proxy @sub))+    (documentation @p)]  -- | A simple default for getting out the arguments, options, and flags -- using 'getArgs'. We use the syntax ~flag for flags and ~opt@@ -504,8 +523,11 @@ usage :: forall p m. (MonadIO m, HasProgram p) => ProgramT Raw m () usage = raw $ do   liftIO $ putStrLn "usage:"-  void . traverse (liftIO . putStrLn . unpack) $ invocations @p+  liftIO $ putStrLn (document @p) +description :: forall description p m a. (HasProgram p, KnownSymbol description) => ProgramT p m a -> ProgramT (Description description & p) m a+description = DescriptionProgramT+ -- | The type of middleware, which can transform interpreted command line programs -- by meddling with arguments, options, or flags, or by adding effects for -- every step. You can also change the underlying monad.@@ -543,6 +565,12 @@     pure (withVictoryEffects ma commander', state')   Defeat -> Defeat   Victory a -> Action $ \state -> ma $> (Victory a, state)+++-- | Produce a 2-dimensional textual drawing of the 'Tree' description of+-- this program.+document :: forall p. HasProgram p => String+document = drawForest (documentation @p)  -- | Middleware to log the state to standard out for every step of the -- 'CommanderT' computation.