cli/Hcompta/CLI/Args.hs

   1 {-# LANGUAGE TupleSections #-}
   2 module Hcompta.CLI.Args where
   3
   4 import           Control.Monad (Monad(..), liftM)
   5 import           Data.List (map, foldl')
   6 import           Data.String (String)
   7 import           Prelude (($), (.), IO)
   8 import qualified Data.Text.Lazy as TL
   9 import           System.Console.GetOpt
  10                   ( getOpt
  11                   , ArgOrder(..)
  12                   , OptDescr(..)
  13                   )
  14
  15 import           Hcompta.CLI.Context (Context)
  16 import qualified Hcompta.CLI.Write as Write
  17 import           Hcompta.Lib.Leijen ((<>))
  18 import qualified Hcompta.Lib.Leijen as W
  19
  20 type Options context
  21  = [OptDescr (Context -> context -> IO context)]
  22
  23 parse
  24  :: Context
  25  -> (IO String)
  26  -> Options context
  27  ->    (context, [String])
  28  -> IO (context, [String])
  29 parse context usage options (ctx, args) =
  30         case getOpt RequireOrder options args of
  31          (parsers, cmds, []) -> do
  32                 liftM (, cmds) $
  33                         Data.List.foldl' (\acc parser -> acc >>= parser context) (return ctx) parsers
  34          (_, _, errs) -> do
  35                 usage >>= Write.fatal context .
  36                         (W.vsep (map (W.text .TL.pack) errs) <>) .
  37                         W.text . TL.pack