commander (empty) → 0.1.0.0

raw patch · 9 files changed

+829/−0 lines, 9 filesdep +basedep +commanderdep +containerssetup-changed

Dependencies added: base, commander, containers, mtl, transformers

Files

LICENSE +30/−0
README.md +74/−0
Setup.hs +2/−0
commander.cabal +68/−0
examples/Example1.hs +97/−0
src/Commander.hs +145/−0
src/Commander/Commands.hs +313/−0
src/Commander/Params.hs +98/−0
test/Spec.hs +2/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright James Wilson (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,74 @@+# Commander: A Haskell Library for parsing commands++This library aims to make it super easy to create and use nested commands with flags in the form of an object that is easy to traverse and run custom actions on, and easy to extend with handling for safe casting to values from their input strings.++As an example of usage (take a look in the _examples_ folder for more) we can define commands as follows:++```+someCommands :: Command (IO ())+someCommands = commands $ do++    command "repeat" $ do++        help "Repeat a string n times"++        run $+            \(Value str :: Value "value to repeat" String)+             (Flag n :: Flag '["n"] "times to repeat" Int) ->+             sequence_ $ replicate n (putStrLn str)++    command "calculate" $ do++        help "perform calculations"++        command "add" $ do++            help "add two numbers"++            run $+                \(Value n1 :: Value "number 1" Int)+                 (Value n2 :: Value "number 2" Int)+                 (Flag verbose :: Flag '["v", "verbose"] "verbose mode" Bool) ->+                 if verbose+                    then putStrLn $ (show n1) ++ " + " ++ (show n2) ++ " = " ++ (show $ n1 + n2)+                    else putStrLn (show $ n1 + n2)++        command "multiply" $ do++            help "multiply two numbers"++            run $+                \(Value n1 :: Value "number 1" Int)+                 (Value n2 :: Value "number 2" Int) ->+                 putStrLn $ (show n1) ++ " x " ++ (show n2) ++ " = " ++ (show $ n1 * n2)++```++And this leads to `someCommands` being a nested record of type `Command (IO ())` (where `IO ()` corresponds to the output from the functions you provide). This record can then be traversed and interacted with.++The novelty of this approach (compared to others I have seen, which is a non exhaustive list!) is the use of the functions input parameter types to cast-from-string and inject the appropriate values into the function safely at runtime, as well as to generate documentation. This means that we only declare the flags and values each command requires in one place, and do not execute any of the output unless all parameters are fully satisfied. These functions are then safely hidden away inside an existential type, and so we don't need any other type level magic or handling to work with the output.++# Installation++1. Add this repository to your stack.yaml file under the packages folder, so we end up with something that looks a bit like:++    ```+    packages:+    - '.'+    - location:+       git: https://github.com/jsdw/hs-commander+       commit: abcdef123456789abcdef1234+    ```++2. run `stack install`.+3. import `Commander` into your library.++you can run the example code by running `stack install :example1 && example1` assuming that the directory stack copies binaries to is present in your `PATH`.++# Documentation++if you clone this repository locally somewhere, you can use `stack haddock` inside its folder in order to generate haddock documentation for it.++# Disclaimer++This project is still under heavy development and could well change drastically!

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ commander.cabal view

@@ -0,0 +1,68 @@+name:                commander+version:             0.1.0.0+synopsis:            pattern matching against string based commands+homepage:            https://github.com/jsdw/hs-commander+license:             BSD3+license-file:        LICENSE+author:              James Wilson+maintainer:          me@unbui.lt+copyright:           (c) 2016 James Wilson+stability:           experimental+category:            Text+build-type:          Simple+cabal-version:       >=1.10+description:+    An extensible, format-agnostic command parsing library designed+    to be easy to use and syntactically light weight.+    .+    Assuming we write a parser to convert a command such as+    .+    @calculator add 1 2 -v=yes@+    .+    Into path and flags such as @["calculator", "add"]@ and @Map.fromList [("v","yes")]@,+    This library will then match said path and flags against a nested record type of+    commands built up using lightweight monadic syntax and tries to execute+    the associated function if the matching and value converting works, or returns+    an error if the path/flags fail to match any command.+    .+    To get started, see the documentation for the @Commander@ module+    below. Additionally, an /examples/ folder is included in the source+    illustrating usage - see https://github.com/jsdw/hs-commander for+    more.++extra-source-files:+    README.md+    examples/*.hs++library+  hs-source-dirs:      src+  ghc-options:         -Wall+  exposed-modules:     Commander+                     , Commander.Commands+                     , Commander.Params+  build-depends:       base         >= 4.8   && < 5+                     , containers   >= 0.5   && < 0.6+                     , transformers >= 0.4.2 && < 0.5+                     , mtl          >= 2.2   && < 2.3+  default-language:    Haskell2010++test-suite commander-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , commander+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++executable example1+  hs-source-dirs:      examples+  main-is:             Example1.hs+  build-depends:       base+                     , commander+                     , containers+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/jsdw/hs-commander

+ examples/Example1.hs view

@@ -0,0 +1,97 @@+{-# LANGUAGE DataKinds, ScopedTypeVariables #-}++module Main where++import qualified Data.Map as Map+import Commander.Params   (Flag(..), Value(..))+import Commander.Commands (Command(..), commands, command, help, run, evalCommand)++--+-- build up a Command (IO ()) object. The IO () is based+-- on the output of the functions used in the commands.+--+someCommands :: Command (IO ())+someCommands = commands $ do++    command "repeat" $ do++        help "Repeat a string n times"++        run $+            \(Value str :: Value "value to repeat" String)+             (Flag n :: Flag '["n"] "times to repeat" Int) ->+             sequence_ $ replicate n (putStrLn str)++    command "calculate" $ do++        help "perform calculations"++        command "add" $ do++            help "add two numbers"++            run $+                \(Value n1 :: Value "number 1" Int)+                 (Value n2 :: Value "number 2" Int)+                 (Flag verbose :: Flag '["v", "verbose"] "verbose mode" Bool) ->+                 if verbose+                    then putStrLn $ (show n1) ++ " + " ++ (show n2) ++ " = " ++ (show $ n1 + n2)+                    else putStrLn (show $ n1 + n2)++        command "multiply" $ do++            help "multiply two numbers"++            run $+                \(Value n1 :: Value "number 1" Int)+                 (Value n2 :: Value "number 2" Int) ->+                 putStrLn $ (show n1) ++ " x " ++ (show n2) ++ " = " ++ (show $ n1 * n2)++    command "login" $ do++        help "pretend authentication"++        run $+            \(Value username :: Value "Username" String)+             (Flag mPassword :: Flag '["p", "password"] "Password" (Maybe String)) -> do+             pass <- case mPassword of+                Just password -> return password+                Nothing -> getLine+             putStrLn $ "logging in with username=" ++ username ++ " password=" ++ pass++++--+-- run an IO () command, printing the error or command output:+--+runCommand :: [String] -> [(String,String)] -> Command (IO ()) -> IO ()+runCommand vals flags cmds = case evalCommand vals (Map.fromList flags) cmds of+    Left err -> putStrLn ("Error: " ++ show err)+    Right res -> res++--+-- run some commands. Here, we basically pass in strings denoting a path and flags.+-- Commander maps these to output commands if possible, performing whatever type+-- converstion is required to conform to the flags and values these commands expect+-- in a completely safe way.+--+main :: IO ()+main = do++    putStrLn "\nRepeat Command:"+    runCommand ["repeat", "hello there"] [("n","2")] someCommands++    putStrLn "\nAdd numbers:"+    runCommand ["calculate", "add", "12", "13"] [] someCommands++    putStrLn "\nAdd numbers (verbosely):"+    runCommand ["calculate", "add", "12", "13"] [("verbose", "")] someCommands++    putStrLn "\nMultiply numbers:"+    runCommand ["calculate", "multiply", "12", "13"] [] someCommands++    putStrLn "\nPretend Auth (password provided):"+    runCommand ["login", "james"] [("p", "lemons")] someCommands++    putStrLn "\nPretend Auth (please type a random string):"+    runCommand ["login", "james"] [] someCommands

+ src/Commander.hs view

@@ -0,0 +1,145 @@+-- |+-- Module: Commander+--+-- re-exports everything defined in @Commander.Params@ and @Commander.Commands@+-- for convenience.+--+module Commander (++    -- * Example Usage+    -- $usage++    module Commander.Params,+    module Commander.Commands+) where++import Commander.Params+import Commander.Commands++-- $usage+--+-- The below header gives us the language extensions and imports we need+-- for basic usage of 'Commander':+--+-- > {-# LANGUAGE DataKinds, ScopedTypeVariables #-}+-- >+-- > module Main where+-- >+-- > import qualified Data.Map as Map+-- > import Commander.Params   (Flag(..), Value(..))+-- > import Commander.Commands (Command(..), commands, command, help, run, evalCommand)+--+-- The next step is to define the various commands that we care to match+-- against, which looks something like this:+--+-- > someCommands :: Command (IO ())+-- > someCommands = commands $ do+-- >+-- >     command "repeat" $ do+-- >+-- >         help "Repeat a string n times"+-- >+-- >         run $+-- >             \(Value str :: Value "value to repeat" String)+-- >              (Flag n :: Flag '["n"] "times to repeat" Int) ->+-- >              sequence_ $ replicate n (putStrLn str)+-- >+-- >     command "calculate" $ do+-- >+-- >         help "perform calculations"+-- >+-- >         command "add" $ do+-- >+-- >             help "add two numbers"+-- >+-- >             run $+-- >                 \(Value n1 :: Value "number 1" Int)+-- >                  (Value n2 :: Value "number 2" Int)+-- >                  (Flag verbose :: Flag '["v", "verbose"] "verbose mode" Bool) ->+-- >                  if verbose+-- >                     then putStrLn $ (show n1) ++ " + " ++ (show n2) ++ " = " ++ (show $ n1 + n2)+-- >                     else putStrLn (show $ n1 + n2)+-- >+-- >         command "multiply" $ do+-- >+-- >             help "multiply two numbers"+-- >+-- >             run $+-- >                 \(Value n1 :: Value "number 1" Int)+-- >                  (Value n2 :: Value "number 2" Int) ->+-- >                  putStrLn $ (show n1) ++ " x " ++ (show n2) ++ " = " ++ (show $ n1 * n2)+-- >+-- >     command "login" $ do+-- >+-- >         help "pretend authentication"+-- >+-- >         run $+-- >             \(Value username :: Value "Username" String)+-- >              (Flag mPassword :: Flag '["p", "password"] "Password" (Maybe String)) -> do+-- >              pass <- case mPassword of+-- >                 Just password -> return password+-- >                 Nothing -> getLine+-- >              putStrLn $ "logging in with username=" ++ username ++ " password=" ++ pass+--+-- Commands can be arbitrary nested, making it super easy to define subcommands as far+-- down as you like.+--+-- Using a couple of pre-baked parameter types from 'Commander.Params', namely 'Value' and 'Flag',+-- we define in the function signature itself additional /values/ and /flags/ that we expect,+-- each fully typed and with help text (the 'Flag' type in addition state which flags it will+-- try to match against).+--+-- If you prefer alternate behaviour to the provided types, it is easy to create your own custom+-- alternatives; it's simply a case of making your custom types instances of a few very basic+-- typeclasses.+--+-- The return types of the provided functions must match, so that we know what we're getting back+-- when we try executing a command; this is the only parameter needed by the 'Command' type.+--+-- Making use of the above, one could do the following:+--+-- > runCommand :: [String] -> [(String,String)] -> Command (IO ()) -> IO ()+-- > runCommand vals flags cmds = case evalCommand vals (Map.fromList flags) cmds of+-- >     Left err -> putStrLn ("Error: " ++ show err)+-- >     Right res -> res+-- >+-- > main :: IO ()+-- > main = do+-- >+-- >     putStrLn "\nRepeat Command:"+-- >     runCommand ["repeat", "hello there"] [("n","2")] someCommands+-- >+-- >     putStrLn "\nAdd numbers:"+-- >     runCommand ["calculate", "add", "12", "13"] [] someCommands+-- >+-- >     putStrLn "\nAdd numbers (verbosely):"+-- >     runCommand ["calculate", "add", "12", "13"] [("verbose", "")] someCommands+-- >+-- >     putStrLn "\nMultiply numbers:"+-- >     runCommand ["calculate", "multiply", "12", "13"] [] someCommands+-- >+-- >     putStrLn "\nPretend Auth (password provided):"+-- >     runCommand ["login", "james"] [("p", "lemons")] someCommands+-- >+-- >     putStrLn "\nPretend Auth (please type a random string):"+-- >     runCommand ["login", "james"] [] someCommands+--+-- Where we first define a function that makes use of 'evalCommand' to match the provided+-- flags and values against a specific command and either run it or return an error, and+-- either prints the error or runs the resulting IO action.+--+-- This library has no opinion on how a text based command is parsed into a path list and+-- 'Map' of flags, and so the user is free to select an approach that works best for them.+--++++++++++++

+ src/Commander/Commands.hs view

@@ -0,0 +1,313 @@+-- |+-- Module: Commander.Commands+--+-- This module contains the core types and functions for working with them.+--+{-# LANGUAGE+    MultiParamTypeClasses,+    FlexibleInstances,+    UndecidableInstances,+    ScopedTypeVariables,+    TypeFamilies,+    ConstraintKinds,+    ExistentialQuantification #-}++module Commander.Commands (++    -- * Creating new Commands+    -- $creatingcommands++    -- ** Core types+    Command(..),+    Commands,+    CommandError(..),++    -- ** Attaching values to Commands+    -- $attachingvalues+    commands,+    command,+    help,+    run,++    -- * Extracting and running Commands+    -- $runningcommands+    evalCommand,+    getCommand,++    -- * Function parameters+    -- $functionparameters++    -- ** Creating new function parameters+    IsParameter,+    ToParam(..),+    ParamFlags(..),+    ParamHelp(..),++    -- ** Working with function parameters+    Fn(..),+    injectParams,+    extractParams,+    Parameter(..)++) where++import qualified Data.Map as Map+import qualified Data.Maybe as Maybe+import qualified Control.Monad.State as State+import Data.Map (Map)+import Data.Proxy (Proxy(..))++-- | A tuple of typeclasses that must all be implemented for function parameter+-- types in order that they can be used in the functions attached to commands.+-- 'ToParam' is the only mandatory requirement ('ParamFlags' and 'ParamHelp'+-- have default defitions), however it is recommended that you implement+-- 'ParamHelp' in all cases, and you must implement 'ParamFlags' if you want+-- your new type to match against provided flags. An example custom parameter+-- implementation:+--+-- > data Verbose = Verbose Bool+-- >+-- > instance ParamFlags Verbose where+-- >     paramFlags _ = Just ["v", "verbose"]+-- > instance ParamHelp Verbose where+-- >     paramHelp _ = "Make the command more verbose"+-- > instance ToParam Verbose where+-- >     toParam (Just _) = Right (Verbose True)+-- >     toParam Nothing = Right (Verbose False)+--+-- Here, we define a @Verbose@ type that will equal @Verbose True@ if the "v"+-- or "verbose" flag is used in the command, or @Verbose False@ otherwise.+--+-- To extract the value, all we have to do is use @(Verbose b)@ in our commands+-- function now, where @b@ will be either @True@ or @False@.+--+-- See 'Commander.Params' for the definitions of the provided 'Value' and 'Flag'+-- parameter types.+--+type IsParameter a = (ToParam a, ParamFlags a, ParamHelp a)++-- | Describe how to turn the @String@ parameter given into our custom type.+-- The input may be @Nothing@ if the flag/value is not provided, else it will+-- be @Just str@ where @str@ is the input string.+class ToParam a where+    toParam :: Maybe String -> Either String a++-- | Should the parameter match against flags? If so, return @Just [flags]@+-- from this. If the param should be a value instead, return @Nothing@.+class ParamFlags a where+    paramFlags :: proxy a -> Maybe [String]+    paramFlags _ = Nothing++-- | Return a piece of help text describing what the parameter means.+class ParamHelp a where+    paramHelp  :: proxy a -> String+    paramHelp _ = ""++-- | given our @Fn out@ type, containing some function that will return @out@ on+-- successful execution, attempt to run the function by injecting a list of values+-- and a map of flags to it. This will either return a 'CommandError' denoting+-- what failed, or the output from running the function.+injectParams :: [String] -> Map String String -> Fn out -> Either CommandError out+injectParams vals flags fnWrapper = case fnWrapper of Fn fn -> injectParameters vals flags fn++type family FnOut fn where+    FnOut (a -> b) = FnOut b+    FnOut a = a++class FnOut fn ~ out => InjectParameters fn out where+    injectParameters :: [String] -> Map String String -> fn -> Either CommandError out++instance (IsParameter a, InjectParameters b out) => InjectParameters (a -> b) out where+    injectParameters vals flags fn = case paramFlags (Proxy :: Proxy a) of+        -- the thing looks like a flag, but doesnt actually have any!+        Just [] -> Left ErrParamHasNoFlags+        -- the thing does have flags.+        Just fs -> injectFlag fs+        -- the thing is a value.+        Nothing -> injectValue+      where+        injectFlag :: [String] -> Either CommandError out+        injectFlag fs = do+            let (flag, mVal)+                    = Maybe.fromMaybe (head fs, Nothing)+                    $ Maybe.listToMaybe+                    $ filter (Maybe.isJust . snd)+                    $ fmap (\f -> (f, Map.lookup f flags)) fs+            param <- mapLeft (ErrCastingFlag flag) $ toParam mVal+            injectParameters vals flags (fn param)+        injectValue :: Either CommandError out+        injectValue = do+            val <- toEither ErrNotEnoughValues $ Maybe.listToMaybe vals+            param <- mapLeft ErrCastingValue $ toParam (Just val)+            injectParameters (tail vals) flags (fn param)++instance {-# OVERLAPPABLE #-} FnOut out ~ out => InjectParameters out out where+    injectParameters [] _ output = Right output+    injectParameters vs _ _ = Left (ErrTooManyValues vs)++-- | A type containing information about a function parameter.+data Parameter = Parameter+    { parameterFlags :: Maybe [String]+    , parameterHelp  :: String+    } deriving (Show, Eq)++-- | Run against our @Fn out@ wrapped function, this will return a list of 'Parameter' details+-- for each parameter in the contained function.+extractParams :: Fn out -> [Parameter]+extractParams fnWrapper = case fnWrapper of Fn (_ :: a) -> extractParameters (Proxy :: Proxy a) (Proxy :: Proxy out)++class FnOut fn ~ out => ExtractParameters fn out where+    extractParameters :: proxy fn -> proxy out -> [Parameter]++instance (IsParameter a, ExtractParameters b out) => ExtractParameters (a -> b) out where+    extractParameters _ _ = param : extractParameters (Proxy :: Proxy b) (Proxy :: Proxy out)+      where param = Parameter (paramFlags proxya) (paramHelp proxya)+            proxya = Proxy :: Proxy a++instance {-# OVERLAPPABLE #-} FnOut out ~ out => ExtractParameters out out where+    extractParameters _ _ = []++-- | Our existential 'Fn' type is used for hiding away the details of some provided+-- function. Any function that satisfies the 'IsParameter' tuple of type classes can+-- be wrapped in this.+data Fn out = forall fn. (ExtractParameters fn out, InjectParameters fn out) => Fn fn++instance Show (Fn out) where+    show _ = "<<injectableFunc>>"++-- | This is the type returned from using the 'commands' function along with helpers like+-- 'command' and 'run' to build up a nested structure of commands. We can manually traverse+-- it by looking through the 'cmdChildren' Map to acess nested commands, or inspecting the+-- 'cmdHelp' and 'cmdFunc' properties of the current command. This makes it easy to do things+-- like autocomplete commands, or print out help etc.+data Command out = Command+    { cmdChildren :: Map String (Command out)+    , cmdHelp     :: String+    , cmdFunc     :: Maybe (Fn out)+    } deriving Show++-- | You probably won't ever need to interact with this type; it is just a @State@ monad on our+-- 'Command' type in order that we can use monadic notation to build up our nested structure.+type Commands out = State.State (Command out)++-- $attachingvalues+--+-- These functions allow us to build up our nested command structure.+--++emptyCommand :: Command out+emptyCommand = Command Map.empty "" Nothing++-- | Given a 'Commands' type as its only argument, this resolves it to a 'Command' object, ready+-- to make use of. This is basically the entry point to defining our commands, inside which we+-- can use the functions below to populate our structure.+commands :: Commands out () -> Command out+commands m = State.execState m emptyCommand++-- | Nest a command with some name inside the current command.+command :: String -> Commands out () -> Commands out ()+command name m = State.modify $ \c -> c { cmdChildren = Map.insert name (commands m) (cmdChildren c) }++-- | Attach help to the current command.+help :: String -> Commands out ()+help txt = State.modify $ \c -> c { cmdHelp = txt }++-- | Attach a function which will be tried if the current command is matched. The parameters+-- to the function must satisfy the 'IsParameter' typeclasses, which will automatically make+-- the function satisfy the @ExtractParameters@ and @InjectParameters@ typeclasses.+run :: (ExtractParameters fn out, InjectParameters fn out) => fn -> Commands out ()+run fn = State.modify $ \c -> c { cmdFunc = Just (Fn fn) }++-- $runningcommands+--+-- The below are helpers for simpler interaction with our 'Command' object.+--++-- | Attempt to run a function inside a 'Command' object, using the first argument (a+-- list of strings) to first navigate to the relevant subcommand and then have any+-- remainder used as values to be passed to the command, and the second argument as+-- a map of flags to be passed to the command.+evalCommand :: [String] -> Map String String -> Command out -> Either CommandError out+evalCommand path flags cmd = eval+  where+    -- eval cmd, trying to do nav step if fails:+    eval = case cmdFunc cmd of+        Nothing -> nav+        Just fn -> injectParams path flags fn `catchEither` nav+    -- navigate, complaining if we can't:+    nav = do+        (newPath, newCmd) <- stepIntoCommand path cmd+        evalCommand newPath flags newCmd++-- | Attempt to get hold of the nested 'Command' at the path provided inside a provided+-- 'Command' object.+getCommand :: [String] -> Command out -> Either CommandError (Command out)+getCommand [] cmd = Right cmd+getCommand path cmd = do+    (newPath, newCmd) <- stepIntoCommand path cmd+    getCommand newPath newCmd++stepIntoCommand :: [String] -> Command out -> Either CommandError ([String],Command out)+stepIntoCommand path cmd = do+    crumb <- toEither (ErrNotEnoughPath childKeys) $ Maybe.listToMaybe path+    newCmd <- toEither (ErrPathNotFound childKeys crumb) $ Map.lookup crumb children+    return (tail path, newCmd)+  where+    children = cmdChildren cmd+    childKeys = Map.keys children++-- | A collection of the errors that can be encountered upon trying to get and run+-- a 'Command'+data CommandError+    -- | If a parameter's 'ParamFlags' instance returns @Just []@, complain:+    = ErrParamHasNoFlags+    -- | More input values are provided than the function requires. Provides the list+    -- of remaining values.+    | ErrTooManyValues [String]+    -- | Not enough input values are provided to the function, so it can't run.+    | ErrNotEnoughValues+    -- | We didn't find any function with the given path. Provides the possible+    -- path pieces that could have been supplied to go one level deeper.+    | ErrNotEnoughPath [String]+    -- | We didn't find a path corresponding to some string. Returns the possible+    -- paths that could have been taken from that location, and the failing string.+    | ErrPathNotFound [String] String+    -- | We tried converting the flag (provided as the first param) to the type asked+    -- for, and failed for some reason (provided as the second param).+    | ErrCastingFlag String String+    -- | We tried converting some value to the type asked and failed with the reason+    -- provided.+    | ErrCastingValue String+    deriving (Eq,Show)++--+-- Util bits for internal use+--++toEither :: a -> Maybe b -> Either a b+toEither _ (Just b) = Right b+toEither a Nothing = Left a++mapLeft :: (a -> c) -> Either a b -> Either c b+mapLeft fn (Left a)  = Left (fn a)+mapLeft _ (Right b) = Right b++catchEither :: Either a b -> Either a b -> Either a b+catchEither (Left a) (Left _) = Left a+catchEither (Left _) b = b+catchEither a _ = a++-- $creatingcommands+--+-- These types and functions are involved in building up a @Command out@ object, where @out@ is+-- the output type of the functions attached to the different command paths.+--++-- $functionparameters+--+-- Functions are wrapped up inside an existential 'Fn' type in order that we can hide away their+-- implementation details and satisfy the type system. In order for a function to be wrappable+-- inside this type, you need only actually satisfy the 'IsParameter' tuple of typeclasses+-- for the types of any of the arguments to the function. Of these, only the 'ToParam'+-- class is actually mandatory.+--

+ src/Commander/Params.hs view

@@ -0,0 +1,98 @@+-- |+-- Module: Commander.Params+--+-- This module provides a couple of basic function parameter types to be+-- used in 'Commander.Commands' function definitions. By implementing the+-- same typeclasses, one can create their own custom types to use instead+-- (or as well as) if they prefer.+--+{-# LANGUAGE+    KindSignatures,+    DataKinds,+    TypeOperators,+    FlexibleInstances,+    UndecidableInstances,+    ScopedTypeVariables #-}++module Commander.Params (++    -- * Function Parameter Types+    Flag(..),+    Value(..),++    -- * Casting from String+    FromString(..)++) where++import Data.Proxy (Proxy(..))+import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)+import Text.Read (readMaybe)+import Commander.Commands (ToParam(..), ParamFlags(..), ParamHelp(..))++-- | Use this type in a function embedded in a 'Command' in order to+-- require a flag. The type signature for this lists the flags that we+-- want to match against, the associated help text, and the output type+-- we want the flag to be cast to.+--+-- @Flag@s of @Maybe@ or @Bool@ types have special handling:+-- if the flag doesnt exist for either of these types, we'll be+-- handed back a @False@/@Nothing@ rather than get an error,+-- else if the flag does exist we'll get back a @True@/@Just val@.+-- @Bool@ flags are expected to be provided an empty string as the value;+-- if you care about the value but want it to be optional, use @Maybe@.+data Flag (flags :: [Symbol]) (help :: Symbol) a = Flag a++instance FromString a => ToParam (Flag flags help (Maybe a)) where+    toParam (Just str) = fmap (Flag . Just) (fromString str)+    toParam Nothing = Right (Flag Nothing)+instance ToParam (Flag flags help Bool) where+    toParam (Just "") = Right (Flag True)+    toParam (Just _) = Left "boolean string does not expect to have a value"+    toParam Nothing = Right (Flag False)+instance {-# OVERLAPPABLE #-} FromString a => ToParam (Flag flags help a) where+    toParam (Just str) = fmap Flag (fromString str)+    toParam Nothing = Left "flag expected but not found"+instance KnownSymbols flags => ParamFlags (Flag flags help a) where+    paramFlags _ = Just $ symbolVals (Proxy :: Proxy flags)+instance KnownSymbol help => ParamHelp (Flag flags help a) where+    paramHelp _ = symbolVal (Proxy :: Proxy help)++-- | Use this type in a function embedded in a 'Command' in order to+-- require a value. The type signature for this contains the associated+-- help text for the command, and the type we expect the value to be cast+-- to.+data Value (help :: Symbol) a = Value a++instance FromString a => ToParam (Value help a) where+    toParam (Just str) = fmap Value (fromString str)+    toParam Nothing = Left "value expected but none found"+instance ParamFlags (Value help a) where+    paramFlags _ = Nothing+instance KnownSymbol help => ParamHelp (Value help a) where+    paramHelp _ = symbolVal (Proxy :: Proxy help)++-- | Typeclass used by 'Flag' and 'Value' to convert the provided string to+-- the desired haskell type. Anything that satisfies @Read@ will satisfy this,+-- but we can override the @Read@ behaviour as we see fit on a per type basis+-- by explicitly implementing this.+class FromString a where+    fromString :: String -> Either String a++instance FromString String where+    fromString = Right++instance {-# OVERLAPPABLE #-} Read a => FromString a where+    fromString str = case readMaybe str of+        Nothing -> Left "string could not be cast to required type"+        Just a  -> Right a++--+-- Extract array of strings from [Symbol]+--+class KnownSymbols (s :: [Symbol]) where+    symbolVals :: proxy s -> [String]+instance (KnownSymbol s, KnownSymbols ss) => KnownSymbols (s ': ss) where+    symbolVals _ = symbolVal (Proxy :: Proxy s) : symbolVals (Proxy :: Proxy ss)+instance KnownSymbols '[] where+    symbolVals _ = []

+ test/Spec.hs view

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"