console-program 0.3.1.4 → 0.3.2.0

raw patch · 7 files changed

+65/−58 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Examples/Full.hs +2/−2
• Examples/Simple.hs +1/−1
• console-program.cabal +1/−1
• src/System/Console/Command.hs +24/−21
• src/System/Console/ConfigFile.hs +12/−11
• src/System/Console/Internal.hs +7/−6
• src/System/Console/Program.hs +18/−16

@@ -12,7 +12,7 @@ main :: IO () main = single myCommands -myCommands :: Commands+myCommands :: Commands IO myCommands = Node   (Command "count" "A program for counting" . io $ putStrLn "No command given; try \"count help\".")   [@@ -21,7 +21,7 @@   , Node help []   ] -countUp,countDown,help :: Command+countUp,countDown,help :: Command IO countUp = Command   {     name        = "up"

@@ -5,7 +5,7 @@ import System.Console.Program (single)  -myCommands :: Commands+myCommands :: Commands IO myCommands = Node   (Command "say" "" . io $ putStrLn "No command given.")   [

@@ -1,5 +1,5 @@ Name:            console-program-Version:         0.3.1.4+Version:         0.3.2.0 Cabal-Version:   >= 1.6 License:         BSD3 Author:          Arie Peterson

@@ -29,41 +29,44 @@   ) import qualified System.Console.Argument as Argument +import           Control.Monad.IO.Class (MonadIO,liftIO) import qualified Data.Map                as Map import qualified Data.Tree               as Tree-import           System.Exit (exitFailure)+import           System.Exit            (exitFailure)  --- | @Commands s@ is a tree of commands. It represents the whole set of--- possible commands of a program.-type Commands-  = Tree.Tree Command+-- | @Commands m@ is a tree of commands (with action in the monad @m@).+-- It represents the whole set of possible commands of a program.+type Commands m+  = Tree.Tree (Command m)   -- | A simple action, taking no argument, and having no options.-io :: IO () -> Action+io :: (MonadIO m) => m () -> Action m io h = Action r [] [] [] where   r []   _ = h-  r rest _ = putStrLn e >> exitFailure where+  r rest _ = liftIO $ putStrLn e >> exitFailure where     e = "Error: unused non-option or unrecognised command: " ++ unwords rest  -- | Create an action that takes an argument (non-option). --  -- The type of argument is specified by the first parameter; such values can -- be obtained from the module "System.Console.Argument".-withNonOption :: Argument.Type x -> (x -> Action) -> Action-withNonOption at f = Action+withNonOption :: (MonadIO m) => Argument.Type x -> (x -> Action m) -> Action m+withNonOption argumentType f = Action   {     run = \ nonOpts opts -> case nonOpts of-      (x : xs) -> either-        ((>> exitFailure) . putStrLn) -- Show errors and exit.-        (\ y -> run (f y) xs opts)    -- Argument parsing succeeded; run the action.-        (Argument.parser at x)-      []       -> maybe-        (putStrLn ("Error: missing argument of type " ++ Argument.name at) >> exitFailure)-        (\ y -> run (f y) [] opts)-        (Argument.defaultValue at)-  , nonOptions = Argument.name at : nonOptions (f undefined)+      (x : xs) -> case Argument.parser argumentType x of+        Left e  -> liftIO $ do -- Show errors and exit.+          putStrLn e+          exitFailure+        Right y -> run (f y) xs opts -- Argument parsing succeeded; run the action.+      []       -> case Argument.defaultValue argumentType of+        Nothing -> liftIO $ do+          putStrLn $ "Error: missing argument of type " ++ Argument.name argumentType+          exitFailure+        Just y  -> run (f y) [] opts+  , nonOptions = Argument.name argumentType : nonOptions (f undefined)   , options = options (f undefined)   , ignoringOptions = ignoringOptions (f undefined)   }@@ -72,11 +75,11 @@ --  -- The first parameter is a description of the option; such a value can be -- constructed using 'System.Console.Argument.option'.-withOption :: Option a -> (a -> Action) -> Action+withOption :: (MonadIO m) => Option a -> (a -> Action m) -> Action m withOption (Option identifier optDescr def p) f = Action   {     run = \ nonOpts opts -> case maybe (Right def) p $ Map.lookup identifier opts of-      Left e  -> putStrLn e >> exitFailure+      Left e  -> liftIO $ putStrLn e >> exitFailure       Right a -> run (f a) nonOpts opts   , nonOptions = nonOptions (f undefined)   , options = optDescr : options (f undefined)@@ -88,7 +91,7 @@ -- This is especially useful if this option is given in the configuration -- file, but is meant for other commands; then this action will not give an -- error message about an unrecognised option.-ignoreOption :: Option a -> Action -> Action+ignoreOption :: Option a -> Action m -> Action m ignoreOption (Option _ g _ _) a = a   {     ignoringOptions = g : ignoringOptions a

@@ -7,24 +7,25 @@ import System.Console.Command import System.Console.Internal (name) -import           Control.Applicative ((<$>))-import           Control.Exception   (tryJust)-import           Control.Monad       (guard)-import           Data.List           (isPrefixOf,concat)-import           Data.List.Split     (Splitter,split,whenElt,keepDelimsR)+import           Control.Applicative    ((<$>))+import           Control.Exception      (tryJust)+import           Control.Monad          (guard)+import           Control.Monad.IO.Class (MonadIO,liftIO)+import           Data.List              (isPrefixOf,concat)+import           Data.List.Split        (Splitter,split,whenElt,keepDelimsR) import qualified Data.Map      as Map-import           Data.Map            (Map)-import           Data.Maybe          (isJust)+import           Data.Map               (Map)+import           Data.Maybe             (isJust) import qualified Data.Tree     as Tree import qualified Fez.Data.Conf as Fez-import           System.Directory    (getAppUserDataDirectory)-import           System.IO.Error     (isDoesNotExistError)+import           System.Directory       (getAppUserDataDirectory)+import           System.IO.Error        (isDoesNotExistError)   type UserCommand = [String] -readFromFile :: Commands -> UserCommand -> IO [String]-readFromFile commands command = do+readFromFile :: (MonadIO m) => Commands m -> UserCommand -> m [String]+readFromFile commands command = liftIO $ do   dataDir <- getAppUserDataDirectory $ name (Tree.rootLabel commands)   let configFile = dataDir ++ "/" ++ "config"   fileContents <- either (const "") id <$> tryJust (guard . isDoesNotExistError) (readFile configFile)

@@ -5,12 +5,12 @@ import qualified System.Console.GetOpt  as GetOpt  --- | An @Action@ is an @IO@ action, which may take arguments+-- | An @Action m@ is an action (in the monad @m@), which may take arguments -- (\"non-options\") and options from the command line.-data Action+data Action m   = Action   {-    run             :: [String] -> Map Identifier (Maybe String) -> IO ()+    run             :: [String] -> Map Identifier (Maybe String) -> m ()   , nonOptions      :: [String]   , options         :: [GetOpt.OptDescr (Identifier,Maybe String)]   , ignoringOptions :: [GetOpt.OptDescr (Identifier,Maybe String)]@@ -28,8 +28,9 @@   (Maybe String -> Either String a)  --- | A @Command@ is an action, together with some descriptive information.-data Command+-- | A @Command m@ is an action (in the monad @m@), together with some+-- descriptive information.+data Command m   = Command     {       -- | This determines which command is executed.@@ -37,5 +38,5 @@       -- | For usage info.     , description :: String       -- | The actual action performed by this command.-    , action :: Action+    , action :: Action m     }

@@ -20,9 +20,10 @@ import           System.Console.ConfigFile (readFromFile) import           System.Console.Internal   (run,options,nonOptions,ignoringOptions,action,description,name) -import           Control.Applicative       ((<|>),(*>))+import           Control.Applicative       (Applicative,(<|>),(*>)) import           Control.Arrow             ((&&&),second) import           Control.Monad             (when,void)+import           Control.Monad.IO.Class    (MonadIO,liftIO) import           Control.Monad.Trans.Class (lift) import qualified Data.Map                     as Map import           Data.Traversable          (traverse)@@ -39,7 +40,7 @@  -- $configfile -- The configuration file is assumed to be in the user's home directory, and--- to be named \".foobar\", where \"foobar\" is the name of the+-- to be named \".foobar/config\", where \"foobar\" is the name of the -- root of the command tree (usually the name of the program). --  -- Settings in this file are of the form@@ -59,7 +60,7 @@   -- Parse the given list of strings into a command, non-options and options.-parse :: Commands -> [String] -> IO ()+parse :: (MonadIO m,Applicative m) => Commands m -> [String] -> m () parse commands args = do   let (commandString,command,restArgs) = select commands args   fileArgs <- readFromFile commands commandString@@ -68,11 +69,11 @@         (options (action command) ++ ignoringOptions (action command))         (fileArgs ++ restArgs)   when (not $ null errors) . void $-    traverse putStrLn errors+    traverse (liftIO . putStrLn) errors   run (action command) nonOpts $ Map.fromList opts  -- Select the right command from the command tree, and return the rest of the command line.-select :: Commands -> [String] -> ([String],Command,[String])+select :: Commands m -> [String] -> ([String],Command m,[String]) select (Tree.Node root _     ) []       = ([],root,[]) select (Tree.Node root subs)   (x : xs) = case lookup x $ map (name . Tree.rootLabel &&& id) subs of   Nothing -> ([],root,x : xs)@@ -82,23 +83,24 @@ -- the command line. Settings on the command line override the configuration -- file. -- --- You may use this function, applied to your tree of available commands, as your @main@ function.-single :: Commands -> IO ()-single commands = parse commands =<< getArgs+-- You may use this function, applied to your tree of available commands,+-- as your @main@ function.+single :: (MonadIO m,Applicative m) => Commands m -> m ()+single commands = parse commands =<< liftIO getArgs  -- | Start an interactive session. Arguments to the program are ignored; -- instead, the user may repeatedly enter a command, possibly with options, -- which will be executed.-interactive :: Commands -> IO ()+interactive :: (MonadIO m,Haskeline.MonadException m,Applicative m) => Commands m -> m () interactive commands = do   Haskeline.runInputT Haskeline.defaultSettings $ sequence_ . repeat $ one  where   one = getLine' >>= \ line -> case words' line of-    Left e   -> lift $ putStrLn e+    Left e   -> liftIO $ putStrLn e     Right ws -> lift $ parse commands ws   getLine' = do-    lift . putStrBold $ name (Tree.rootLabel commands)-    maybe (lift exitSuccess) return =<< Haskeline.getInputLine ": "+    putStrBold $ name (Tree.rootLabel commands)+    maybe (liftIO exitSuccess) return =<< Haskeline.getInputLine ": "  words' :: String -> Either String [String] words' = either (Left . show) Right . P.parse p "" where@@ -111,15 +113,15 @@   escape = P.char '\\'   escaped x = escape *> x -putStrBold :: String -> IO ()-putStrBold x = do+putStrBold :: (MonadIO m) => String -> m ()+putStrBold x = liftIO $ do   ANSI.setSGR [ANSI.SetConsoleIntensity ANSI.BoldIntensity]   putStr x   ANSI.setSGR [ANSI.Reset]  -- | Print usage info for the program to stdout.-showUsage :: Commands -> IO ()-showUsage = PP.putDoc . usage+showUsage :: (MonadIO m) => Commands n -> m ()+showUsage = liftIO . PP.putDoc . usage  where   usage (Tree.Node c ns) = (PP.<> PP.line) . subcs ns . (PP.<> PP.line) . opts c . descr c . nonOpts c $ PP.bold (PP.text $ name c)   descr c = flip (PP.<$>) $ PP.string (description c)