commander-cli 0.10.1.2 → 0.10.1.3

raw patch · 8 files changed

+256/−14 lines, 8 filesdep +directorydep +processdep ~commandertnew-component:exe:task-managerPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: directory, process

Dependency ranges changed: commandert

API changes (from Hackage documentation)

Files

• README.md +26/−0
• app/Main.hs +18/−0
• app/Task.hs +10/−0
• app/Task/CLI.hs +78/−0
• app/Task/Codec.hs +31/−0
• app/Task/IO.hs +45/−0
• commander-cli.cabal +24/−2
• src/Options/Commander.hs +24/−12

@@ -315,3 +315,29 @@ which is something like a free backtracking monad. Users should not have to make instances of this class, as the common CLI elements are already defined as instances. Of course, you can if you want to, and it can be profitable to do so.++## Similar Projects++### Recommended Alternatives+- [cmdargs](https://hackage.haskell.org/package/cmdargs) Command line argument processing+- [docopt](https://hackage.haskell.org/package/docopt) A command-line interface parser that will make you smile+- [getopt-generics](https://hackage.haskell.org/package/getopt-generics) Create command line interfaces with ease+- [optparse-applicative](https://hackage.haskell.org/package/optparse-applicative) Utilities and combinators for parsing command line options++### Other CLI Packages+- [ReadArgs](https://hackage.haskell.org/package/ReadArgs) Simple command line argument parsing+- [argparser](https://hackage.haskell.org/package/argparser) Command line parsing framework for console applications+- [cli-extras](https://hackage.haskell.org/package/cli-extras) Miscellaneous utilities for building and working with command line interfaces+- [cli](https://hackage.haskell.org/package/cli) CLI+- [cmdtheline](https://hackage.haskell.org/package/cmdtheline) Declarative command-line option parsing and documentation library.+- [configifier](https://hackage.haskell.org/package/configifier) parser for config files, shell variables, command line args.+- [configuration-tools](https://hackage.haskell.org/package/configuration-tools) Tools for specifying and parsing configurations+- [console-program](https://hackage.haskell.org/package/console-program) Interpret the command line and a config file as commands and options+- [hflags](https://hackage.haskell.org/package/hflags) Command line flag parser, very similar to Google's gflags+- [multiarg](https://hackage.haskell.org/package/multiarg) Command lines for options that take multiple arguments+- [options](https://hackage.haskell.org/package/options) A powerful and easy-to-use command-line option parser.+- [parseargs](https://hackage.haskell.org/package/parseargs) Parse command-line arguments+- [quickterm](https://hackage.haskell.org/package/quickterm) An interface for describing and executing terminal applications+- [shell-utility](https://hackage.haskell.org/package/shell-utility) Utility functions for writing command-line programs+- [symantic-cli](https://hackage.haskell.org/package/symantic-cli) Symantics for parsing and documenting a CLI+

@@ -0,0 +1,18 @@+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+module Main where++import Options.Commander+import Task.CLI+ +main :: IO ()+main = command_ taskManager

@@ -0,0 +1,10 @@+module Task where++data Context = Context+  { home :: FilePath+  , tasks :: [String] }++data Task = Task+  { name :: String+  , priorities :: [(String, String)]+  }

@@ -0,0 +1,78 @@+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DataKinds #-}+module Task.CLI where++import Options.Commander+import GHC.TypeLits (AppendSymbol)+import System.Directory+import Task+import Task.IO+import Task.Codec+import System.Process+import Control.Monad++type TaskManager+  = Named "task-manager"+  & Annotated "the directory in which we keep our task files" (Env 'Optional "TASK_DIRECTORY" FilePath)+    & ("help"+      & Description "Displays this help text."+      & Raw+     + TaskProgram "edit" "Edits an already existing task. Fails if the task does not exist."+     + TaskProgram "open" "Opens a new task for editing. Fails if the task exists already."+     + TaskProgram "close" "Closes a task. Fails if there are remaining priorities within the task."+     + TasklessProgram "tasks" "Lists current tasks."+     + TasklessProgram "priorities" "Lists priorities for every task."+     + Raw+    )++type TaskProgram x desc = x & Description desc & Annotated ("the task we're going to " `AppendSymbol` x) (Arg "task-name" String) & Raw++type TasklessProgram x desc = x & Description desc & Raw+  +taskManager :: ProgramT TaskManager IO ()+taskManager = named @"task-manager" . annotated . envOptDef @"TASK_DIRECTORY" "tasks" $ \tasksFilePath -> +      sub @"help" (description $ usage @TaskManager)+  <+> sub @"edit" (description $ editTask tasksFilePath) +  <+> sub @"open" (description $ newTask tasksFilePath)+  <+> sub @"close" (description $ closeTask tasksFilePath)+  <+> sub @"tasks" (description $ listTasks tasksFilePath)+  <+> sub @"priorities" (description $ listPriorities tasksFilePath)+  <+> usage @TaskManager++editTask tasksFilePath = annotated $ arg @"task-name" $ \taskName -> raw +  $ withTask tasksFilePath taskName $ \Context{home} task -> callProcess "vim" [home ++ "/" <> tasksFilePath <> "/" ++ taskName ++ ".task"]++newTask tasksFilePath = annotated $ arg @"task-name" $ \taskName -> raw $ do+  Context{home, tasks} <- initializeOrFetch tasksFilePath+  if not (taskName `elem` tasks)+    then do+      let path = home ++ "/" <> tasksFilePath <> "/" ++ taskName ++ ".task"+      callProcess "touch" [path]+      appendFile path (renderPriorities $ [])+      callProcess "vim" [path]+    else putStrLn $ "task " ++ taskName ++ " already exists."++closeTask tasksFilePath = annotated $ arg @"task-name" $ \taskName -> raw +  $ withTask tasksFilePath taskName $ \Context{home, tasks} mtask ->+    case mtask of+      Just Task{priorities} ->+        if priorities == [] +          then removeFile (home ++ "/" <> tasksFilePath <> "/" ++ taskName ++ ".task")+          else putStrLn $ "task " ++ taskName ++ " has remaining priorities."+      Nothing -> putStrLn "task is corrupted"++listTasks tasksFilePath = raw $ do+  Context{tasks} <- initializeOrFetch tasksFilePath+  mapM_ putStrLn tasks++listPriorities tasksFilePath = raw $ do+  Context{tasks} <- initializeOrFetch tasksFilePath+  forM_ tasks $ \taskName -> withTask tasksFilePath taskName $ \_ mtask -> +    case mtask of+      Just Task{name, priorities} -> do+        putStrLn $ name ++ ": "+        putStrLn $ renderPriorities priorities+      Nothing -> putStrLn $ "Corruption! Task " ++ taskName ++ " is the culprint" 

@@ -0,0 +1,31 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE LambdaCase #-}+module Task.Codec where++import Data.Either+import Task++renderPriorities :: [(String, String)] -> String+renderPriorities = concat . map (\(x, y) -> ("#" ++ x ++ "\n" ++ unlines (map ("  " ++) $ lines y)))++trimWhitespace :: String -> String+trimWhitespace = reverse . dropWhile (== ' ') . reverse . dropWhile (== ' ')++parseTask :: String -> String -> Maybe Task+parseTask taskName+  = sectionByPriority+      . dropWhile isRight+      . map (\case+      ('#': (trimWhitespace -> xs)) -> Left xs+      xs -> Right xs)+      . lines+    where+      sectionByPriority :: [Either String String] -> Maybe Task+      sectionByPriority = \case+        Left priority : xs -> do+          let (concat . map (fromRight undefined) -> description, xs') = span isRight xs+          Task{priorities} <- sectionByPriority xs'+          Just $ Task taskName ((priority, description) : priorities)+        Right _ : xs -> Nothing+        [] -> Just $ Task taskName []

@@ -0,0 +1,45 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+module Task.IO where++import System.Directory+import Data.List+import Task+import Task.Codec+import System.Exit++initializeOrFetch :: FilePath -> IO Context+initializeOrFetch tasksFilePath = do+  home <- getHomeDirectory >>= makeAbsolute+  withCurrentDirectory home $ do+    doesDirectoryExist tasksFilePath >>= \case+      True -> Context home . map (takeWhile (/= '.')) . filter (".task" `isSuffixOf`) <$> listDirectory tasksFilePath+      False -> Context home [] <$ createDirectory tasksFilePath++readTask :: FilePath -> String -> IO (Maybe Task)+readTask tasksFilePath taskName = do+  Context{home, tasks} <- initializeOrFetch tasksFilePath+  if taskName `elem` tasks+    then do+      let path = home ++ "/" <> tasksFilePath <> "/" ++ taskName ++ ".task"+      stringTask <- readFile path+      return $ parseTask taskName stringTask+    else do+      putStrLn $ "task " ++ taskName ++ " does not exist."+      exitSuccess++writeTask :: FilePath -> Task -> IO ()+writeTask tasksFilePath Task{name, priorities} = do+  Context{home} <- initializeOrFetch tasksFilePath+  let path = home ++ "/" <> tasksFilePath <> "/" ++ name ++ ".task"+  writeFile path $ renderPriorities priorities++withTask :: FilePath -> String -> (Context -> Maybe Task -> IO ()) -> IO ()+withTask tasksFilePath taskName action = do+  c@Context{tasks} <- initializeOrFetch tasksFilePath+  if taskName `elem` tasks +    then do+      readTask tasksFilePath taskName >>= \case+        Just task -> action c (Just task)+        Nothing -> action c Nothing+    else putStrLn $ "task " ++ taskName ++ " does not exist."

@@ -1,7 +1,7 @@ cabal-version:       2.4  name:                commander-cli-version:             0.10.1.2+version:             0.10.1.3 synopsis:            A command line argument/option parser library description:         A command line argument/option parser library. homepage:            https://github.com/SamuelSchlesinger/commander-cli@@ -46,9 +46,31 @@                        mtl >=2.2 && <3,                        text >=1.2 && <2,                        unordered-containers >=0.2 && < 1,-                       commandert >=0.1,+                       commandert >=0.1.0.1,                        containers >=0.1   hs-source-dirs:      src+  default-language:    Haskell2010++executable task-manager+  main-is:             Main.hs+  other-modules:       Task, Task.IO, Task.CLI, Task.Codec+  other-extensions:    TypeFamilies,+                       ViewPatterns,+                       ScopedTypeVariables,+                       NamedFieldPuns,+                       RecordWildCards,+                       LambdaCase,+                       DataKinds,+                       TypeApplications,+                       TypeOperators+  build-depends:       base >=4.12 && < 5,+                       mtl >=2.2 && <3,+                       text >=1.2 && < 2,+                       directory >= 1.3 && < 2,+                       process >= 1.6 && < 2,+                       commandert >=0.1.0.1,+                       commander-cli+  hs-source-dirs:      app   default-language:    Haskell2010  test-suite test-commander

@@ -445,7 +445,8 @@ -- | 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.-command_ :: HasProgram p +command_ :: forall p a.+            HasProgram p           => ProgramT p IO a           -> IO () command_ prog = void $ initialState >>= runCommanderT (run prog)@@ -454,25 +455,29 @@ -- 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 +command :: forall p a.+           HasProgram p          => ProgramT p IO a          -> IO (Maybe a) command prog = initialState >>= runCommanderT (run prog)  -- | Required environment variable combinator-env :: KnownSymbol name+env :: forall name p x m a.+     KnownSymbol name   => (x -> ProgramT p m a)   -> ProgramT (Env 'Required name x & p) m a env = EnvProgramT'Required  -- | Optional environment variable combinator-envOpt :: KnownSymbol name+envOpt :: forall name x p m a.+     KnownSymbol name   => (Maybe x -> ProgramT p m a)   -> ProgramT (Env 'Optional name x & p) m a envOpt = flip EnvProgramT'Optional Nothing  -- | Optional environment variable combinator with default-envOptDef :: KnownSymbol name+envOptDef :: forall name x p m a.+     KnownSymbol name   => x   -> (x -> ProgramT p m a)   -> ProgramT (Env 'Optional name x & p) m a@@ -481,31 +486,36 @@ -- | Environment   -- | Argument combinator-arg :: KnownSymbol name+arg :: forall name x p m a.+       KnownSymbol name     => (x -> ProgramT p m a)      -> ProgramT (Arg name x & p) m a  arg = ArgProgramT  -- | Option combinator-opt :: (KnownSymbol option, KnownSymbol name)+opt :: forall option name x p m a.+       (KnownSymbol option, KnownSymbol name)     => (Maybe x -> ProgramT p m a)      -> ProgramT (Opt option name x & p) m a opt = flip OptProgramT Nothing  -- | Option combinator with default-optDef :: (KnownSymbol option, KnownSymbol name)+optDef :: forall option name x p m a.+     (KnownSymbol option, KnownSymbol name)   => x   -> (x -> ProgramT p m a)   -> ProgramT (Opt option name x & p) m a optDef x f = OptProgramT { unOptDefault = Just x, unOptProgramT = \case { Just x -> f x; Nothing -> error "Violated invariant of optDef" } }  -- | Raw monadic combinator-raw :: m a +raw :: forall m a.+       m a      -> ProgramT Raw m a raw = RawProgramT  -- | Subcommand combinator-sub :: KnownSymbol s +sub :: forall s p m a.+       KnownSymbol s      => ProgramT p m a      -> ProgramT (s & p) m a sub = SubProgramT@@ -513,13 +523,15 @@ -- | Named command combinator, useful at the top level for naming -- a program. Typically, the name will be the name or alias of the -- executable you expect to produce.-named :: KnownSymbol s +named :: forall s p m a.+         KnownSymbol s        => ProgramT p m a        -> ProgramT (Named s & p) m a named = NamedProgramT  -- | Boolean flag combinator-flag :: KnownSymbol f +flag :: forall f p m a.+        KnownSymbol f       => (Bool -> ProgramT p m a)       -> ProgramT (Flag f & p) m a flag = FlagProgramT