commander-cli-0.4.0.0: A command line argument/option parser library built around a monadic metaphor

Copyright(c) Samuel Schlesinger 2020
LicenseMIT
Maintainersgschlesinger@gmail.com
Stabilityexperimental
PortabilityPOSIX, Windows
Safe HaskellNone
LanguageHaskell2010

Options.Commander

Contents

Description

Commander is an embedded domain specific language describing a command line interface, along with ways to run those as real programs. An complete example of such a command line interface is:

main :: IO ()
main = command_ . toplevel "file" $
 (sub "maybe-read" $
  arg "filename" filename ->
  flag "read" b -> raw $
    if b
      then putStrLn =<< readFile filename
      else pure ())
  <+>
 (sub "maybe-write" $
  opt "file" @"file-to-write" mfilename -> raw $
    case mfilename of
      Just filename -> putStrLn =<< readFile filename
      Nothing -> pure ())

If I run this program with the argument help, it will output:

usage:
file maybe-read <filename :: String> ~read
file maybe-write -file <file-to-write :: String>

The point of this library is mainly so that you can write command line interfaces quickly and easily, with somewhat useful help messages, and not have to write any boilerplate.

Synopsis

Parsing Arguments and Options

class Typeable t => Unrender t where Source #

A class for interpreting command line arguments into Haskell types.

Methods

unrender :: Text -> Maybe t Source #

Instances
Unrender Bool Source # 
Instance details

Defined in Options.Commander

Unrender Char Source # 
Instance details

Defined in Options.Commander

Unrender Int Source # 
Instance details

Defined in Options.Commander

Methods

unrender :: Text -> Maybe Int Source #

Unrender Int8 Source # 
Instance details

Defined in Options.Commander

Unrender Int16 Source # 
Instance details

Defined in Options.Commander

Unrender Int32 Source # 
Instance details

Defined in Options.Commander

Unrender Int64 Source # 
Instance details

Defined in Options.Commander

Unrender Integer Source # 
Instance details

Defined in Options.Commander

Unrender Natural Source # 
Instance details

Defined in Options.Commander

Unrender Word Source # 
Instance details

Defined in Options.Commander

Unrender Word8 Source # 
Instance details

Defined in Options.Commander

Unrender Word16 Source # 
Instance details

Defined in Options.Commander

Unrender Word32 Source # 
Instance details

Defined in Options.Commander

Unrender Word64 Source # 
Instance details

Defined in Options.Commander

Unrender () Source # 
Instance details

Defined in Options.Commander

Methods

unrender :: Text -> Maybe () Source #

Unrender String Source # 
Instance details

Defined in Options.Commander

Unrender Text Source # 
Instance details

Defined in Options.Commander

Unrender a => Unrender (Maybe a) Source # 
Instance details

Defined in Options.Commander

Methods

unrender :: Text -> Maybe (Maybe a) Source #

(Unrender a, Unrender b) => Unrender (Either a b) Source # 
Instance details

Defined in Options.Commander

Methods

unrender :: Text -> Maybe (Either a b) Source #

Run CLI Programs

command :: HasProgram p => ProgramT p IO a -> IO (Maybe a) Source #

This is a combinator which runs a ProgramT with the options, arguments, and flags that I get using the initialState function, returning Just the output of the program upon successful option and argument parsing and returning Nothing otherwise.

command_ :: HasProgram p => ProgramT p IO a -> IO () Source #

This is a combinator which runs a ProgramT with the options, arguments, and flags that I get using the initialState function, ignoring the output of the program.

CLI Combinators

arg :: KnownSymbol name => (x -> ProgramT p m a) -> ProgramT (Arg name x & p) m a Source #

Argument combinator

opt :: (KnownSymbol option, KnownSymbol name) => (Maybe x -> ProgramT p m a) -> ProgramT (Opt option name x & p) m a Source #

Option combinator

raw :: m a -> ProgramT Raw m a Source #

Raw monadic combinator

sub :: KnownSymbol s => ProgramT p m a -> ProgramT (s & p) m a Source #

Subcommand combinator

named :: KnownSymbol s => ProgramT p m a -> ProgramT (Named s & p) m a Source #

Named command combinator, should only really be used at the top level.

flag :: KnownSymbol f => (Bool -> ProgramT p m a) -> ProgramT (Flag f & p) m a Source #

Boolean flag combinator

toplevel :: forall s p m. (HasProgram p, KnownSymbol s, MonadIO m) => ProgramT p m () -> ProgramT (Named s & (("help" & Raw) + p)) m () Source #

A convenience combinator that constructs the program I often want to run out of a program I want to write.

(<+>) :: forall x y m a. ProgramT x m a -> ProgramT y m a -> ProgramT (x + y) m a infixr 2 Source #

The command line program which consists of trying to enter one and then trying the other.

usage :: forall p m. (MonadIO m, HasProgram p) => ProgramT Raw m () Source #

A meta-combinator that takes a type-level description of a command line program and produces a simple usage program.

Type Level CLI Description

data (&) :: k -> * -> * infixr 4 Source #

The type level program sequencing combinator, taking two program types and sequencing them one after another.

Instances
(KnownSymbol flag, HasProgram p) => HasProgram (Flag flag & p :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (Flag flag & p) m a :: Type

Methods

run :: ProgramT (Flag flag & p) IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT (Flag flag & p) m a -> ProgramT (Flag flag & p) n a Source #

invocations :: [Text] Source #

(KnownSymbol name, HasProgram p) => HasProgram (Named name & p :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (Named name & p) m a :: Type

Methods

run :: ProgramT (Named name & p) IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT (Named name & p) m a -> ProgramT (Named name & p) n a Source #

invocations :: [Text] Source #

(KnownSymbol name, KnownSymbol option, HasProgram p, Unrender t) => HasProgram (Opt option name t & p :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (Opt option name t & p) m a :: Type

Methods

run :: ProgramT (Opt option name t & p) IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT (Opt option name t & p) m a -> ProgramT (Opt option name t & p) n a Source #

invocations :: [Text] Source #

(Unrender t, KnownSymbol name, HasProgram p) => HasProgram (Arg name t & p :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (Arg name t & p) m a :: Type

Methods

run :: ProgramT (Arg name t & p) IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT (Arg name t & p) m a -> ProgramT (Arg name t & p) n a Source #

invocations :: [Text] Source #

(KnownSymbol sub, HasProgram p) => HasProgram (sub & p :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (sub & p) m a :: Type

Methods

run :: ProgramT (sub & p) IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT (sub & p) m a -> ProgramT (sub & p) n a Source #

invocations :: [Text] Source #

newtype ProgramT (Flag flag & p :: Type) m a Source # 
Instance details

Defined in Options.Commander

newtype ProgramT (Flag flag & p :: Type) m a = FlagProgramT {}
newtype ProgramT (Named name & p :: Type) m a Source # 
Instance details

Defined in Options.Commander

newtype ProgramT (Named name & p :: Type) m a = NamedProgramT {}
newtype ProgramT (Opt option name t & p :: Type) m a Source # 
Instance details

Defined in Options.Commander

newtype ProgramT (Opt option name t & p :: Type) m a = OptProgramT {}
newtype ProgramT (Arg name t & p :: Type) m a Source # 
Instance details

Defined in Options.Commander

newtype ProgramT (Arg name t & p :: Type) m a = ArgProgramT {}
newtype ProgramT (sub & p :: Type) m a Source # 
Instance details

Defined in Options.Commander

newtype ProgramT (sub & p :: Type) m a = SubProgramT {}

data a + b infixr 2 Source #

The type level combining combinator, taking two program types as input, and being interpreted as a program which attempts to run the first command line program and, if parsing its flags, subprograms, options or arguments fails, runs the second, otherwise failing.

Instances
(HasProgram x, HasProgram y) => HasProgram (x + y :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (x + y) m a :: Type

Methods

run :: ProgramT (x + y) IO a -> CommanderT State IO a Source #

hoist :: (forall x0. m x0 -> n x0) -> ProgramT (x + y) m a -> ProgramT (x + y) n a Source #

invocations :: [Text] Source #

data ProgramT (x + y :: Type) m a Source # 
Instance details

Defined in Options.Commander

data ProgramT (x + y :: Type) m a = (ProgramT x m a) :+: (ProgramT y m a)

data Arg :: Symbol -> * -> * Source #

The type level argument combinator, with a Symbol designating the name of that argument.

Instances
(Unrender t, KnownSymbol name, HasProgram p) => HasProgram (Arg name t & p :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (Arg name t & p) m a :: Type

Methods

run :: ProgramT (Arg name t & p) IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT (Arg name t & p) m a -> ProgramT (Arg name t & p) n a Source #

invocations :: [Text] Source #

newtype ProgramT (Arg name t & p :: Type) m a Source # 
Instance details

Defined in Options.Commander

newtype ProgramT (Arg name t & p :: Type) m a = ArgProgramT {}

data Opt :: Symbol -> Symbol -> * -> * Source #

The type level option combinator, with a Symbol designating the option's name and another representing the metavariables name for documentation purposes.

Instances
(KnownSymbol name, KnownSymbol option, HasProgram p, Unrender t) => HasProgram (Opt option name t & p :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (Opt option name t & p) m a :: Type

Methods

run :: ProgramT (Opt option name t & p) IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT (Opt option name t & p) m a -> ProgramT (Opt option name t & p) n a Source #

invocations :: [Text] Source #

newtype ProgramT (Opt option name t & p :: Type) m a Source # 
Instance details

Defined in Options.Commander

newtype ProgramT (Opt option name t & p :: Type) m a = OptProgramT {}

data Named :: Symbol -> * Source #

The type level naming combinator, giving your program a name for the sake of documentation.

Instances
(KnownSymbol name, HasProgram p) => HasProgram (Named name & p :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (Named name & p) m a :: Type

Methods

run :: ProgramT (Named name & p) IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT (Named name & p) m a -> ProgramT (Named name & p) n a Source #

invocations :: [Text] Source #

newtype ProgramT (Named name & p :: Type) m a Source # 
Instance details

Defined in Options.Commander

newtype ProgramT (Named name & p :: Type) m a = NamedProgramT {}

data Raw :: * Source #

The type level raw monadic program combinator, allowing a command line program to just do some computation.

Instances
HasProgram Raw Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT Raw m a :: Type

Methods

run :: ProgramT Raw IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT Raw m a -> ProgramT Raw n a Source #

invocations :: [Text] Source #

newtype ProgramT Raw m a Source # 
Instance details

Defined in Options.Commander

newtype ProgramT Raw m a = RawProgramT {}

data Flag :: Symbol -> * Source #

The type level flag combinator, taking a name as input, allowing your program to take flags with the syntax ~flag.

Instances
(KnownSymbol flag, HasProgram p) => HasProgram (Flag flag & p :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (Flag flag & p) m a :: Type

Methods

run :: ProgramT (Flag flag & p) IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT (Flag flag & p) m a -> ProgramT (Flag flag & p) n a Source #

invocations :: [Text] Source #

newtype ProgramT (Flag flag & p :: Type) m a Source # 
Instance details

Defined in Options.Commander

newtype ProgramT (Flag flag & p :: Type) m a = FlagProgramT {}

class HasProgram p where Source #

This is the workhorse of the library. Basically, it allows you to run your ProgramT representation of your program as a CommanderT and pump the State through it until you've processed all of the arguments, options, and flags that you have specified must be used in your ProgramT. You can 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.

Methods

run :: ProgramT p IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT p m a -> ProgramT p n a Source #

invocations :: [Text] Source #

Instances
HasProgram Raw Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT Raw m a :: Type

Methods

run :: ProgramT Raw IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT Raw m a -> ProgramT Raw n a Source #

invocations :: [Text] Source #

(KnownSymbol flag, HasProgram p) => HasProgram (Flag flag & p :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (Flag flag & p) m a :: Type

Methods

run :: ProgramT (Flag flag & p) IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT (Flag flag & p) m a -> ProgramT (Flag flag & p) n a Source #

invocations :: [Text] Source #

(KnownSymbol name, HasProgram p) => HasProgram (Named name & p :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (Named name & p) m a :: Type

Methods

run :: ProgramT (Named name & p) IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT (Named name & p) m a -> ProgramT (Named name & p) n a Source #

invocations :: [Text] Source #

(KnownSymbol name, KnownSymbol option, HasProgram p, Unrender t) => HasProgram (Opt option name t & p :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (Opt option name t & p) m a :: Type

Methods

run :: ProgramT (Opt option name t & p) IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT (Opt option name t & p) m a -> ProgramT (Opt option name t & p) n a Source #

invocations :: [Text] Source #

(Unrender t, KnownSymbol name, HasProgram p) => HasProgram (Arg name t & p :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (Arg name t & p) m a :: Type

Methods

run :: ProgramT (Arg name t & p) IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT (Arg name t & p) m a -> ProgramT (Arg name t & p) n a Source #

invocations :: [Text] Source #

(KnownSymbol sub, HasProgram p) => HasProgram (sub & p :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (sub & p) m a :: Type

Methods

run :: ProgramT (sub & p) IO a -> CommanderT State IO a Source #

hoist :: (forall x. m x -> n x) -> ProgramT (sub & p) m a -> ProgramT (sub & p) n a Source #

invocations :: [Text] Source #

(HasProgram x, HasProgram y) => HasProgram (x + y :: Type) Source # 
Instance details

Defined in Options.Commander

Associated Types

data ProgramT (x + y) m a :: Type

Methods

run :: ProgramT (x + y) IO a -> CommanderT State IO a Source #

hoist :: (forall x0. m x0 -> n x0) -> ProgramT (x + y) m a -> ProgramT (x + y) n a Source #

invocations :: [Text] Source #

The CommanderT Monad

data CommanderT state m a Source #

A CommanderT action is a metaphor for a military commander. At each step, we have a new Action to take, or we could have experienced Defeat, or we can see Victory. While a real life commander worries about moving his troops around in order to achieve a victory in battle, a CommanderT worries about iteratively transforming a state to find some value. We will deal with the subset of these actions where every function must decrease the size of the state, as those are the actions for which this is a monad.

Constructors

Action (state -> m (CommanderT state m a, state)) 
Defeat 
Victory a 
Instances
MonadTrans (CommanderT state) Source # 
Instance details

Defined in Options.Commander

Methods

lift :: Monad m => m a -> CommanderT state m a #

Monad m => Monad (CommanderT state m) Source # 
Instance details

Defined in Options.Commander

Methods

(>>=) :: CommanderT state m a -> (a -> CommanderT state m b) -> CommanderT state m b #

(>>) :: CommanderT state m a -> CommanderT state m b -> CommanderT state m b #

return :: a -> CommanderT state m a #

fail :: String -> CommanderT state m a #

Functor m => Functor (CommanderT state m) Source # 
Instance details

Defined in Options.Commander

Methods

fmap :: (a -> b) -> CommanderT state m a -> CommanderT state m b #

(<$) :: a -> CommanderT state m b -> CommanderT state m a #

Monad m => Applicative (CommanderT state m) Source # 
Instance details

Defined in Options.Commander

Methods

pure :: a -> CommanderT state m a #

(<*>) :: CommanderT state m (a -> b) -> CommanderT state m a -> CommanderT state m b #

liftA2 :: (a -> b -> c) -> CommanderT state m a -> CommanderT state m b -> CommanderT state m c #

(*>) :: CommanderT state m a -> CommanderT state m b -> CommanderT state m b #

(<*) :: CommanderT state m a -> CommanderT state m b -> CommanderT state m a #

MonadIO m => MonadIO (CommanderT state m) Source # 
Instance details

Defined in Options.Commander

Methods

liftIO :: IO a -> CommanderT state m a #

Monad m => Alternative (CommanderT state m) Source # 
Instance details

Defined in Options.Commander

Methods

empty :: CommanderT state m a #

(<|>) :: CommanderT state m a -> CommanderT state m a -> CommanderT state m a #

some :: CommanderT state m a -> CommanderT state m [a] #

many :: CommanderT state m a -> CommanderT state m [a] #

runCommanderT :: Monad m => CommanderT state m a -> state -> m (Maybe a) Source #

We can run a CommanderT action on a state and see if it has a successful campaign.

initialState :: IO State Source #

A simple default for getting out the arguments, options, and flags using getArgs. We use the syntax ~flag for flags and ~opt for options, with arguments using the typical ordered representation.

data State Source #

This is the State that the CommanderT library uses for its role in this library. It is not inlined, because that does nothing but obfuscate the CommanderT monad. It consists of arguments, options, and flags.

Constructors

State 
Instances
Eq State Source # 
Instance details

Defined in Options.Commander

Methods

(==) :: State -> State -> Bool #

(/=) :: State -> State -> Bool #

Ord State Source # 
Instance details

Defined in Options.Commander

Methods

compare :: State -> State -> Ordering #

(<) :: State -> State -> Bool #

(<=) :: State -> State -> Bool #

(>) :: State -> State -> Bool #

(>=) :: State -> State -> Bool #

max :: State -> State -> State #

min :: State -> State -> State #

Show State Source # 
Instance details

Defined in Options.Commander

Methods

showsPrec :: Int -> State -> ShowS #

show :: State -> String #

showList :: [State] -> ShowS #

Generic State Source # 
Instance details

Defined in Options.Commander

Associated Types

type Rep State :: Type -> Type #

Methods

from :: State -> Rep State x #

to :: Rep State x -> State #

type Rep State Source # 
Instance details

Defined in Options.Commander

type Rep State = D1 (MetaData "State" "Options.Commander" "commander-cli-0.4.0.0-5Yut4Oc7CWQ47LRuGBYakx" False) (C1 (MetaCons "State" PrefixI True) (S1 (MetaSel (Just "arguments") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [Text]) :*: (S1 (MetaSel (Just "options") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (HashMap Text Text)) :*: S1 (MetaSel (Just "flags") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (HashSet Text)))))

Middleware for CommanderT

type Middleware m n = forall a. CommanderT State m a -> CommanderT State n a Source #

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.

logState :: MonadIO m => Middleware m m Source #

Middleware to log the state to standard out for every step of the CommanderT computation.

transform :: (Monad m, Monad n) => (forall a. m a -> n a) -> Middleware m n Source #

Middleware to transform the base monad with a natural transformation.

withActionEffects :: Monad m => m a -> Middleware m m Source #

Middleware to add monadic effects for every Action. Useful for debugging complex command line programs.

withDefeatEffects :: Monad m => m a -> Middleware m m Source #

Middleware to have effects whenever the program might backtrack.

withVictoryEffects :: Monad m => m a -> Middleware m m Source #

Middleware to have effects whenever the program successfully computes a result.