cli 0.0.2 → 0.0.3

raw patch · 5 files changed

+259/−31 lines, 5 filesdep +directoryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: directory

API changes (from Hackage documentation)

Files

• Application/CLI.hs +128/−8
• Application/CLI/Class.hs +17/−2
• Application/CLI/Types.hs +64/−19
• cli.cabal +6/−1
• example/Main.hs +44/−1

@@ -7,6 +7,33 @@ -- Stability   : experimental -- Portability : unknown --+-- This module aimes to provide an easy and low-dependencies Command Line+-- configuration options.+--+-- You can create a new command for your program by creating an object+-- And creating an instance of CLI of this object+--+-- @+--   data MyEchoCommand = MyEchoCommand+--   instance CLI MyCommand where+--      name _ = "cmd"+--      desc _ = "just echo the given arguments"+--      options _ = [ ]+--      action _ _ opts = mapM_ putStrLn opts+-- @+--+-- And to create you application, you need 2 functions (initialize, with and defaultMain).+-- * @initialize@: only create the default CLIContext with a default Help command+--   and a default Usage function+-- * @with@: insert the Command into the CLIContext+-- * @defaultMain@: will trigger the right command+--+-- @+--   main :: IO ()+--   main = defaultMain $ with MyEchoCommand $ initialize "a message header in case the help command is triggered"+-- @+--+ module Application.CLI     ( -- * Default Main       defaultMain@@ -21,14 +48,22 @@       -- * Commands     , CLIContext     , getHeader-    , getDefault     , initialize     , initializeWithDefault     , with++      -- * Options+    , Options+    , withStr+    , withOptionalStr+    , withParameterStr+    , withOptionalParameterStr+    , withFlag     ) where  import Application.CLI.Class import Application.CLI.Types+import Data.List import System.Environment import System.Exit @@ -50,16 +85,34 @@     putStrLn list     exitFailure +-- | This is the default help command+--+-- It is triggered by the command "help" and also provides+-- an option to print a specific command options data Help = Help instance CLI Help where     name    _  = "help"     desc    _  = "show help message"-    options _  = []-    action  _ ctx _ = do-        progName <- getProgName-        putStrLn $ progName ++ ": " ++ getHeader ctx-        putStrLn $ printHelp "    " progName ctx+    options _  = [ OptHelp [] (Just "command") "print the help message for a specific command"+                 ]+    action  _ ctx =+        withOptionalStr $ \mcommand _ -> do+            case mcommand of+                Nothing -> printStdHelp+                Just c  -> printCmdHelp c+      where+        printCmdHelp :: String -> IO ()+        printCmdHelp cmd = do+            case lookupCommand cmd ctx of+                Nothing -> error $ "command '" ++ cmd ++ "' does not exist"+                Just c  -> putStrLn $ printCommandHelp "   " c +        printStdHelp :: IO ()+        printStdHelp = do+            progName <- getProgName+            putStrLn $ progName ++ ": " ++ getHeader ctx+            putStrLn $ printHelp "    " progName ctx+ ------------------------------------------------------------------------------- --                               Commands                                    -- -------------------------------------------------------------------------------@@ -79,8 +132,7 @@ initializeWithDefault defaultCli description =     insertDefault (cliToCommand defaultCli) cmdMap   where-    cmdMap :: CLIContext-    cmdMap = createContext (cliToCommand Usage) description+    cmdMap = initialize description  -- | Initialize a collection of command initialize :: String     -- ^ CLI Description@@ -89,9 +141,77 @@     createContext (cliToCommand Usage) description  -------------------------------------------------------------------------------+--                             Options                                       --+-------------------------------------------------------------------------------++-- | This function is to expect an argument at the Head of the @Options@+-- if the command is not found at the head, the program fails and the description+-- message is printed+withStr :: String  -- ^ a description of what is expected+        -> (String -> Options -> IO a)+        -> Options+        -> IO a+withStr what _ []     = error $ "expecting <" ++ what ++ ">"+withStr _    f (x:xs) = f x xs++-- | This function is to expect an optional argument+-- of the command is not found at the Head of the @Options@+-- the function will be executed with Nothing, otherwise it will be executed+-- with (Just @String@)+withOptionalStr :: (Maybe String -> Options -> IO a)+                -> Options+                -> IO a+withOptionalStr f []     = f Nothing  []+withOptionalStr f (x:xs) = f (Just x) xs++-- | Look for a parameterized option+-- The given list of flags are the potential list of flags that can be use to+-- find the position of the options+--+-- This parameter can be found anywhere in the Options list and the argument+-- of the function will be the string following one of this Flags+-- The parameter and its value are removed from the options before being use+-- into the function.+withParameterStr :: [String] -- ^ the reference flag+                 -> (String -> Options -> IO a)+                 -> Options+                 -> IO a+withParameterStr flags f l =+    case break (flip elem flags) l of+        (_  , [])      -> error $ "expecting parameter " ++ intercalate ", " flags ++ " <value>"+        (_  , _:[])    -> error $ "parameter " ++ intercalate ", " flags ++ " is expection an argument"+        (xs1, _:p:xs2) -> f p (xs1 ++ xs2)++-- | idem as @withParameterStr@ but it is an optional parameter+withOptionalParameterStr :: [String] -- ^ the reference flag+                         -> (Maybe String -> Options -> IO a)+                         -> Options+                         -> IO a+withOptionalParameterStr flags f l =+    case break (flip elem flags) l of+        (xs1, [])      -> f Nothing xs1+        (_  , _:[])    -> error $ "parameter " ++ intercalate ", " flags ++ " is expecting an argument"+        (xs1, _:p:xs2) -> f (Just p) (xs1 ++ xs2)++-- | This function is to expect Flag in the Options+-- it will look into all the options and will remove the string+-- from the Options+withFlag :: [String]                   -- ^ the flag to lookup+         -> (Bool -> Options -> IO a)  -- ^ the function to execute+         -> Options                    -- ^ the options+         -> IO a+withFlag flags f l =+    case break (flip elem flags) l of+        (xs1, [])    -> f False xs1+        (xs1, _:xs2) -> f True  (xs1 ++ xs2)++------------------------------------------------------------------------------- --                             Default Main                                  -- ------------------------------------------------------------------------------- +-- | The default Main+-- It will analyze the program's parameters and will trigger the+-- right command. defaultMain :: CLIContext -- ^ A collection of commands             -> IO () defaultMain cmdMap = do

@@ -14,18 +14,33 @@  import Application.CLI.Types +-- | This is the CLI Class+-- All command you want to add into the CLIContext must be an instance of this+-- class. class CLI cli where+    -- | This is the name of the command. It is also the command line option+    -- the action will be triggered every time this string is found to be the+    -- first argument of the program     name    :: cli             -> String+    -- | A description of this command+    -- Will be use in the default Usage and the Help function     desc    :: cli             -> String+    -- | The list of Options+    -- It is only for printing, the parser won't use this to parse the command+    -- parameters.     options :: cli             -> [OptHelp]+    -- | The action to perfom every time the @name@ is found to be the first+    -- string of the program parameters     action  :: cli-            -> CLIContext-            -> [String]+            -> CLIContext -- ^ This could be use in order to know all the different available commands etc...+            -> Options    -- ^ The Command Parameters             -> IO () +-- | Make the transformation of a CLI instance to a Command+-- object cliToCommand :: CLI cli              => cli              -> Command

@@ -12,6 +12,7 @@       CLIContext     , Command(..)     , OptHelp(..)+    , Options            -- * Commands       -- ** Getter/Setter@@ -28,6 +29,7 @@     , printUsage     , printHelp     , printOptHelp+    , printCommandHelp     ) where  import           Data.Map.Strict (Map)@@ -37,15 +39,21 @@ --                               Commands                                    -- ------------------------------------------------------------------------------- +-- | This is the Command Line Context+-- This object embeds:+-- * the commands to trigger+-- * a default command in case no command is given+-- * a program description+-- * a Helper Command: the command to trigger in case of a wrong command (example: Usage) data CLIContext = CLIContext     { getCommands :: Map String Command-    , getDefault  :: Maybe Command-    , getHeader   :: String-    , getHelper   :: Command+    , getDefault  :: Maybe Command -- ^ get the default command (if any)+    , getHeader   :: String  -- ^ Program's description+    , getHelper   :: Command -- ^ get the program's help function (usage)     } deriving (Show, Eq)  -- | Create a CLIContext-createContext :: Command -- ^ the helper command+createContext :: Command -- ^ the command helper (example: the Usage)               -> String  -- ^ a description about the program               -> CLIContext createContext helper header =@@ -56,26 +64,49 @@         , getHeader   = header         } -insertCommand :: Command -> CLIContext -> CLIContext+-- | Insert a command into the CLIContext+--+-- If the command with the same name is already present, the old one will be+-- removed and the new one will take place+insertCommand :: Command    -- ^ the command to insert+              -> CLIContext -- ^ the CLIContext to update+              -> CLIContext insertCommand cmd cmdMap = cmdMap { getCommands = M.insert (cmdName cmd) cmd (getCommands cmdMap) } -insertDefault :: Command -> CLIContext -> CLIContext+-- | Insert a default Command into the CLI+--+-- This command won't be added into the command to trigger+-- If there was already a Default Command this command will replace the old one+insertDefault :: Command    -- ^ The Default Command+              -> CLIContext+              -> CLIContext insertDefault cmd cmdMap =     insertCommand cmd $cmdMap { getDefault  = Just cmd } -lookupCommand :: String -> CLIContext -> Maybe Command+-- | Lookup a command by its command's name+lookupCommand :: String     -- ^ the command's name+              -> CLIContext -- ^ the commands to look up into+              -> Maybe (Command) lookupCommand k cmdMap = M.lookup k (getCommands cmdMap)  -------------------------------------------------------------------------------+--                                  Options                                  --+-------------------------------------------------------------------------------++-- | The Command Options parameter+type Options = [String]++------------------------------------------------------------------------------- --                                  Command                                  -- ------------------------------------------------------------------------------- +-- | A command data Command =       Command         { cmdName :: String         , cmdDesc :: String         , cmdOptions :: [OptHelp]-        , cmdAction  :: CLIContext -> [String] -> IO ()+        , cmdAction  :: CLIContext -> Options -> IO ()         }  instance Eq Command where@@ -91,24 +122,33 @@                      ++ "desc: " ++ (cmdDesc c) ++ ", "                      ++ "opts: " ++ (show $ cmdOptions c) ++ " }" +-- | Pretty print a command printCommandHelp :: String  -- ^ indentation-                 -> Command+                 -> Command -- ^ the command to pretty print                  -> String printCommandHelp prefix cmd =     prefix ++ cmdName cmd ++ ": " ++ cmdDesc cmd ++ "\n"-    ++ (foldr (\c acc -> "\n" ++ prefix ++ prefix ++ (printOptHelp c) ++ acc) "" (cmdOptions cmd))+    ++ (foldr (\c acc -> prefix ++ prefix ++ (printOptHelp c) ++ "\n" ++ acc) "" (cmdOptions cmd))  ------------------------------------------------------------------------------- --                         Option helps                                      -- ------------------------------------------------------------------------------- +-- | Option help+--+-- It describes the Command parameters data OptHelp = OptHelp-    { optSymbols     :: [String]-    , optArgument    :: Maybe String-    , optDescription :: String+    { -- | an option can have multiple symbols, mainly a short option and a long option+      -- for example [ "-h", "--help" ]+      optSymbols     :: [String]+    , -- | an option can have an argument, or not+      optArgument    :: Maybe String+    , optDescription :: String -- ^ option description     } deriving (Eq, Show) -printOptHelp :: OptHelp -> String+-- | This function is a helper to print an OptHelp+printOptHelp :: OptHelp+             -> String printOptHelp opthelp =     (printSymbols $ optSymbols opthelp)     ++ (printArgument $ optArgument opthelp)@@ -117,16 +157,17 @@     printSymbols :: [String] -> String     printSymbols []     = ""     printSymbols [x]    = x ++ " "-    printSymbols (x:xs) = x ++ printSymbols xs+    printSymbols (x:xs) = x ++ ", " ++ printSymbols xs      printArgument :: Maybe String -> String     printArgument Nothing  = ""-    printArgument (Just a) = "<" ++ a ++ ">"+    printArgument (Just x) = "<" ++ x ++ "> "  ------------------------------------------------------------------------------- --                          Pretty printers                                  -- ------------------------------------------------------------------------------- +-- | Print all the Command's Option help printHelp :: String   -- ^ indentation           -> String   -- ^ program name           -> CLIContext -- ^ command list@@ -136,6 +177,7 @@     ++ "\n"     ++ (listCommands prefix cmdMap) +-- | Print the all the commands helps listCommands :: String              -> CLIContext              -> String@@ -156,16 +198,18 @@     ++ "\n"     ++ (listDescriptions prefix cmdMap) +-- | Print the defaul usage (if any) defaultUsage :: String -- ^ prefix              -> String -- ^ program name-             -> Maybe Command+             -> Maybe (Command)              -> String defaultUsage _      _    Nothing    = "" defaultUsage prefix name (Just cmd) =     prefix ++ "Usage: " ++ name ++ " [" ++ (cmdName cmd) ++ "]\n" -listDescriptions :: String   -- ^ prefix-                 -> CLIContext+-- | will list all the description's commands present in the CLI Context+listDescriptions :: String     -- ^ prefix+                 -> CLIContext -- ^ the context                  -> String listDescriptions prefix cmdMap =     "Available commands:\n"@@ -174,6 +218,7 @@     listPrefix :: String     listPrefix = prefix +-- | print a command's description commandDescription :: String                    -> Command                    -> String

@@ -1,5 +1,5 @@ Name:                cli-Version:             0.0.2+Version:             0.0.3 Synopsis:            Simple Command Line Interface Library Description:     This package provides a simple Command Line Library@@ -29,6 +29,7 @@   location: https://github.com/NicolasDP/hs-cli  Flag executable+    default: False  Executable Example   Main-Is:           Main.hs@@ -38,3 +39,7 @@   if flag(executable)     Build-depends:   base >= 4 && < 5                    , cli+                   , directory+    buildable: True+  else+    buildable: False

@@ -12,9 +12,52 @@     ) where  import Application.CLI+import Control.Applicative+import Data.List+import System.Directory +data CLIls = CLIls FilePath+instance CLI CLIls where+    name _ = "ls"+    desc _ = "list file in the current directory"+    options _ = [ OptHelp ["-a", "--all"] Nothing "include hidden files"+                , OptHelp ["-s", "--separator"] (Just "string") "a separator to put between the found files (default is \" \")"+                , OptHelp [] (Just "directory") "specify a directory to list the content from"+                ]+    action (CLIls dir) _ =+        withOptionalParameterStr ["-s", "--separator"] $ \mseparator ->+        withFlag ["-a", "--all"] $ \withHidden ->+        withOptionalStr $ \mdir _ -> do+            let separator = maybe " " id mseparator+            list <- getDirectoryContents $ maybe dir id $ mdir+            if withHidden+                then putStrLn $ intercalate separator list+                else putStrLn $ intercalate separator $ filter (not . isHiddenFile) list+      where+        isHiddenFile :: FilePath -> Bool+        isHiddenFile [] = True+        isHiddenFile ('.':_) = True+        isHiddenFile _ = False++data CLIla = CLIla+instance CLI CLIla where+    name _ = "la"+    desc _ = "list file in the current directory -- plus hidden one"+    options _ = [ OptHelp [] (Just "directory") "the directory to list the content from (mandatory)"+                , OptHelp ["-p", "--prefix"] (Just "string") "a prefix to the output"+                ]+    action _ _ =+        withOptionalParameterStr ["-p", "--prefix"] $ \mprefix ->+        withStr "directory" $ \dir _ -> do+            let prefix = maybe "" id mprefix+            list <- filter (not . flip elem [ ".", ".." ]) <$> getDirectoryContents dir+            mapM_ putStrLn $ map ((++) prefix) list+ main :: IO ()-main =+main = do+    dir <- getCurrentDirectory     defaultMain         $ with Help+        $ with CLIla+        $ with (CLIls dir)         $ initialize "Example of use of CLI Library"