cli (empty) → 0.0.1
raw patch · 8 files changed
+430/−0 lines, 8 filesdep +basedep +clidep +containerssetup-changed
Dependencies added: base, cli, containers
Files
- Application/CLI.hs +116/−0
- Application/CLI/Class.hs +38/−0
- Application/CLI/Types.hs +181/−0
- LICENSE +27/−0
- README.md +6/−0
- Setup.hs +2/−0
- cli.cabal +40/−0
- example/Main.hs +20/−0
+ Application/CLI.hs view
@@ -0,0 +1,116 @@+-- |+-- Module : Application.CLI+-- License : BSD-Style+-- Copyright : Copyright © 2014 Nicolas DI PRIMA+--+-- Maintainer : Nicolas DI PRIMA <nicolas@di-prima.fr>+-- Stability : experimental+-- Portability : unknown+--+module Application.CLI+ ( -- * Default Main+ defaultMain++ -- * CLI+ , CLI(..)+ , OptHelp(..)+ -- ** Default CLIs+ , Usage+ , printUsage++ , Help(..)+ , printHelp++ -- * Commands+ , CLIContext+ , getHeader+ , getDefault+ , initialize+ , with+ ) where++import Application.CLI.Class+import Application.CLI.Types+import System.Environment+import System.Exit++-- | Default usage Command Interface+data Usage = Usage+instance CLI Usage where+ name _ = ""+ desc _ = ""+ options _ = []+ action _ ctx opts = do+ progName <- getProgName+ usage (printUsage " " progName ctx) opts++usage :: String+ -> [String]+ -> IO ()+usage list msgs = do+ mapM_ (\str -> putStrLn str) msgs+ putStrLn list+ exitFailure++data Help = Help+instance CLI Help where+ name _ = "help"+ desc _ = "show help message"+ options _ = []+ action _ ctx _ = do+ progName <- getProgName+ putStrLn $ printHelp " " progName ctx++-------------------------------------------------------------------------------+-- Commands --+-------------------------------------------------------------------------------++-- | Add a new Command into a collection of commands+with :: CLI cli+ => cli -- ^ A new Command Interface+ -> CLIContext -- ^ The original Collection of commands+ -> CLIContext+with c l = insertCommand (cliToCommand c) l++-- | Initialize a collection of commands+initialize :: CLI cliDefault+ => Maybe cliDefault -- ^ The command to execute if no option is given+ -> String -- ^ CLI Description+ -> CLIContext+initialize defaultCli description =+ case defaultCli of+ Nothing -> cmdMap+ Just cmd -> insertDefault (cliToCommand cmd) cmdMap+ where+ cmdMap :: CLIContext+ cmdMap = createContext (cliToCommand Usage) description++-------------------------------------------------------------------------------+-- Default Main --+-------------------------------------------------------------------------------++defaultMain :: CLIContext -- ^ A collection of commands+ -> IO ()+defaultMain cmdMap = do+ args <- getArgs+ case args of+ [] -> tryDefault+ (x:xs) -> tryCommand x xs+ where+ raiseHelper :: String+ -> IO ()+ raiseHelper what =+ cmdAction (getHelper cmdMap) cmdMap [what]+ tryDefault :: IO ()+ tryDefault = do+ progName <- getProgName+ case getDefault cmdMap of+ Nothing -> raiseHelper $ progName ++ " does not provide default command"+ Just cmd -> cmdAction cmd cmdMap []+ tryCommand :: String+ -> [String]+ -> IO ()+ tryCommand cmdstr opts =+ case lookupCommand cmdstr cmdMap of+ Nothing -> raiseHelper $ cmdstr ++ ": command does not exist"+ Just cmd -> cmdAction cmd cmdMap opts
+ Application/CLI/Class.hs view
@@ -0,0 +1,38 @@+-- |+-- Module : Application.CLI.Class+-- License : BSD-Style+-- Copyright : Copyright © 2014 Nicolas DI PRIMA+--+-- Maintainer : Nicolas DI PRIMA <nicolas@di-prima.fr>+-- Stability : experimental+-- Portability : unknown+--+module Application.CLI.Class+ ( CLI (..)+ , cliToCommand+ ) where++import Application.CLI.Types++class CLI cli where+ name :: cli+ -> String+ desc :: cli+ -> String+ options :: cli+ -> [OptHelp]+ action :: cli+ -> CLIContext+ -> [String]+ -> IO ()++cliToCommand :: CLI cli+ => cli+ -> Command+cliToCommand cli =+ Command+ { cmdName = name cli+ , cmdDesc = desc cli+ , cmdOptions = options cli+ , cmdAction = action cli+ }
+ Application/CLI/Types.hs view
@@ -0,0 +1,181 @@+-- |+-- Module : Application.CLI.Types+-- License : BSD-Style+-- Copyright : Copyright © 2014 Nicolas DI PRIMA+--+-- Maintainer : Nicolas DI PRIMA <nicolas@di-prima.fr>+-- Stability : experimental+-- Portability : unknown+--+module Application.CLI.Types+ ( -- * Types+ CLIContext+ , Command(..)+ , OptHelp(..)+ + -- * Commands+ -- ** Getter/Setter+ , createContext+ , getHeader+ , getHelper+ , insertDefault+ , getDefault+ , insertCommand+ -- ** Lookup+ , lookupCommand++ -- * pretty printer+ , printUsage+ , printHelp+ , printOptHelp+ ) where++import Data.Map.Strict (Map)+import qualified Data.Map.Strict as M++-------------------------------------------------------------------------------+-- Commands --+-------------------------------------------------------------------------------++data CLIContext = CLIContext+ { getCommands :: Map String Command+ , getDefault :: Maybe Command+ , getHeader :: String+ , getHelper :: Command+ } deriving (Show, Eq)++-- | Create a CLIContext+createContext :: Command -- ^ the helper command+ -> String -- ^ a description about the program+ -> CLIContext+createContext helper header =+ CLIContext+ { getCommands = M.empty+ , getDefault = Nothing+ , getHelper = helper+ , getHeader = header+ }++insertCommand :: Command -> CLIContext -> CLIContext+insertCommand cmd cmdMap = cmdMap { getCommands = M.insert (cmdName cmd) cmd (getCommands cmdMap) }++insertDefault :: Command -> CLIContext -> CLIContext+insertDefault cmd cmdMap =+ insertCommand cmd $cmdMap { getDefault = Just cmd }++lookupCommand :: String -> CLIContext -> Maybe Command+lookupCommand k cmdMap = M.lookup k (getCommands cmdMap)++-------------------------------------------------------------------------------+-- Command --+-------------------------------------------------------------------------------++data Command =+ Command+ { cmdName :: String+ , cmdDesc :: String+ , cmdOptions :: [OptHelp]+ , cmdAction :: CLIContext -> [String] -> IO ()+ }++instance Eq Command where+ (==) a b = eqname && eqdesc && eqopts+ where+ eqname = cmdName a == cmdName b+ eqdesc = cmdDesc a == cmdDesc b+ eqopts = cmdOptions a == cmdOptions b++instance Show Command where+ show c =+ "Command { " ++ "name: " ++ (cmdName c) ++ ", "+ ++ "desc: " ++ (cmdDesc c) ++ ", "+ ++ "opts: " ++ (show $ cmdOptions c) ++ " }"++printCommandHelp :: String -- ^ indentation+ -> Command+ -> String+printCommandHelp prefix cmd =+ prefix ++ cmdName cmd ++ ": " ++ cmdDesc cmd ++ "\n"+ ++ (foldr (\c acc -> "\n" ++ prefix ++ prefix ++ (printOptHelp c) ++ acc) "" (cmdOptions cmd))++-------------------------------------------------------------------------------+-- Option helps --+-------------------------------------------------------------------------------++data OptHelp = OptHelp+ { optSymbols :: [String]+ , optArgument :: Maybe String+ , optDescription :: String+ } deriving (Eq, Show)++printOptHelp :: OptHelp -> String+printOptHelp opthelp =+ (printSymbols $ optSymbols opthelp)+ ++ (printArgument $ optArgument opthelp)+ ++ (optDescription opthelp)+ where+ printSymbols :: [String] -> String+ printSymbols [] = ""+ printSymbols [x] = x ++ " "+ printSymbols (x:xs) = x ++ printSymbols xs++ printArgument :: Maybe String -> String+ printArgument Nothing = ""+ printArgument (Just a) = "<" ++ a ++ ">"++-------------------------------------------------------------------------------+-- Pretty printers --+-------------------------------------------------------------------------------++printHelp :: String -- ^ indentation+ -> String -- ^ program name+ -> CLIContext -- ^ command list+ -> String+printHelp prefix name cmdMap =+ (defaultUsage prefix name $ getDefault cmdMap)+ ++ "\n"+ ++ (listCommands prefix cmdMap)++listCommands :: String+ -> CLIContext+ -> String+listCommands prefix cmdMap =+ "Available commands:\n"+ ++ (foldr (\c acc -> "\n" ++ (printCommandHelp listPrefix c) ++ acc) "" (M.elems $ getCommands cmdMap))+ where+ listPrefix :: String+ listPrefix = prefix++-- | Pretty printer: list the available commands+printUsage :: String -- ^ indentation+ -> String -- ^ program name+ -> CLIContext -- ^ the command to print+ -> String+printUsage prefix name cmdMap =+ (defaultUsage prefix name $ getDefault cmdMap)+ ++ "\n"+ ++ (listDescriptions prefix cmdMap)++defaultUsage :: String -- ^ prefix+ -> String -- ^ program name+ -> Maybe Command+ -> String+defaultUsage _ _ Nothing = ""+defaultUsage prefix name (Just cmd) =+ prefix ++ "Usage: " ++ name ++ " [" ++ (cmdName cmd) ++ "]\n"++listDescriptions :: String -- ^ prefix+ -> CLIContext+ -> String+listDescriptions prefix cmdMap =+ "Available commands:\n"+ ++ (foldr (\c acc -> "\n" ++ (commandDescription listPrefix c) ++ acc) "" (M.elems $ getCommands cmdMap))+ where+ listPrefix :: String+ listPrefix = prefix++commandDescription :: String+ -> Command+ -> String+commandDescription prefix cmd =+ prefix ++ cmdName cmd ++ ": " ++ cmdDesc cmd ++ "\n"
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2014 Nicolas DI PRIMA <nicolas@di-prima.fr>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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,6 @@+# CLI++[](http://en.wikipedia.org/wiki/BSD_licenses)+[](http://haskell.org)++Documentation: [cli on hackage](http://hackage.haskell.org/package/cli)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cli.cabal view
@@ -0,0 +1,40 @@+Name: cli+Version: 0.0.1+Synopsis: Simple Command Line Interface Library+Description:+ This package provides a simple Command Line Library+License: BSD3+License-file: LICENSE+Copyright: Nicolas DI PRIMA <nicolas@di-prima.fr>+Author: Nicolas DI PRIMA <nicolas@di-prima.fr>+Maintainer: Nicolas DI PRIMA <nicolas@di-prima.fr>+Category: Application+Stability: experimental+Build-Type: Simple+Homepage: https://github.com/NicolasDP/hs-cli+Cabal-Version: >=1.10+extra-source-files: README.md++Library+ Exposed-modules: Application.CLI+ Other-modules: Application.CLI.Types+ , Application.CLI.Class+ Build-depends: base >= 4 && < 5+ , containers+ ghc-options: -Wall -fwarn-tabs+ Default-Language: Haskell2010++source-repository head+ type: git+ location: https://github.com/NicolasDP/hs-cli++Flag executable++Executable Example+ Main-Is: Main.hs+ hs-source-dirs: example+ ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures+ Default-Language: Haskell2010+ if flag(executable)+ Build-depends: base >= 4 && < 5+ , cli
+ example/Main.hs view
@@ -0,0 +1,20 @@+-- |+-- Module : Main+-- License : BSD-Style+-- Copyright : Copyright © 2014 Nicolas DI PRIMA+--+-- Maintainer : Nicolas DI PRIMA <nicolas@di-prima.fr>+-- Stability : experimental+-- Portability : unknown+--+module Main+ ( main+ ) where++import Application.CLI++main :: IO ()+main =+ defaultMain+ $ with Help+ $ initialize (Nothing :: Maybe Help) "Example of use of CLI Library"