-------------------------------------------------------------------
--
-- Module      :   an example for a command line argument setup 
--                  is a Main and starts with convenience
-- for information see https://github.com/pcapriotti/optparse-applicative
-- change the getAttr function to return Text
--------------------------------------------------------------------
    {-# LANGUAGE
    MultiParamTypeClasses
    , TypeSynonymInstances
    , FlexibleInstances
    , FlexibleContexts
    , ScopedTypeVariables
    , OverloadedStrings 
    , TypeFamilies

    #-}

module CmdLineArgsExample where

-- import Test.Framework ( makeTestSuite, TestSuite )
import UniformBase
import UniformBase
import Uniform.CmdLineArgs  

progTitle :: Text
progTitle = Text
"example for command line argument processing" :: Text

main :: IO ()
main :: IO ()
main = forall a. Show a => Text -> ErrIO a -> IO ()
startProg
  Text
progTitle
  (do
    Inputs
inp :: Inputs <- Text -> Text -> Text -> ErrIO Inputs
parseArgs2input
      Text
"makeReport.txt"  -- the default filename 
      ([Text] -> Text
unlinesT
        [ Text
"a flag, a flag (characters), a filename"
        , Text
"all value default, nothing enforced"
        ]
      )
      Text
"dir relative to home"
    forall {m :: * -> *} {a}. (MonadIO m, Show a) => a -> m ()
mainExample Inputs
inp
  )
  
-- | the command line arguments raw 
--  number of args must correspond in order and number with the 
--  command arguments described in the parser
data LitArgs = LitArgs
  { LitArgs -> Bool
argSwitch1 :: Bool -- ^ l - a swtich
  , LitArgs -> String
argFlag1 :: String -- ^ b - a string option
  , LitArgs -> String
argInFile1  ::  String  -- ^ g - an otpional filename
   } deriving (Int -> LitArgs -> ShowS
[LitArgs] -> ShowS
LitArgs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LitArgs] -> ShowS
$cshowList :: [LitArgs] -> ShowS
show :: LitArgs -> String
$cshow :: LitArgs -> String
showsPrec :: Int -> LitArgs -> ShowS
$cshowsPrec :: Int -> LitArgs -> ShowS
Show)

cmdArgs :: Parser LitArgs
-- | strings which have no default result in enforced arguments
-- order and type of arguments must correspod to LitArgs
cmdArgs :: Parser LitArgs
cmdArgs =
  Bool -> String -> String -> LitArgs
LitArgs
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch
          (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"lswitch"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l'
          -- <> value True  -- default False, if not set
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"switch (default False) "
          )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"flag1"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'b'
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"Medium"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"metavar flag needed."
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"flag (default Medium)"
          )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"file1 (optional)"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'g'
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"File1"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
""
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"filename (default homeDir)"
          )

-- | the arguments in the program usable format
data Inputs = Inputs
        { Inputs -> String
inFile1 :: FilePath 
        , Inputs -> Text
flag1 :: Text
        , Inputs -> Bool
switch1 :: Bool
        } deriving (Int -> Inputs -> ShowS
[Inputs] -> ShowS
Inputs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inputs] -> ShowS
$cshowList :: [Inputs] -> ShowS
show :: Inputs -> String
$cshow :: Inputs -> String
showsPrec :: Int -> Inputs -> ShowS
$cshowsPrec :: Int -> Inputs -> ShowS
Show, ReadPrec [Inputs]
ReadPrec Inputs
Int -> ReadS Inputs
ReadS [Inputs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Inputs]
$creadListPrec :: ReadPrec [Inputs]
readPrec :: ReadPrec Inputs
$creadPrec :: ReadPrec Inputs
readList :: ReadS [Inputs]
$creadList :: ReadS [Inputs]
readsPrec :: Int -> ReadS Inputs
$creadsPrec :: Int -> ReadS Inputs
Read, Inputs -> Inputs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Inputs -> Inputs -> Bool
$c/= :: Inputs -> Inputs -> Bool
== :: Inputs -> Inputs -> Bool
$c== :: Inputs -> Inputs -> Bool
Eq)

mainExample :: a -> m ()
mainExample a
inp = do
  forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"example for Command Line Argument processing"]

  forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"inputs on command line:", forall {a}. Show a => a -> Text
showT a
inp]
  forall (m :: * -> *) a. Monad m => a -> m a
return ()

parseArgs2input :: Text -> Text -> Text -> ErrIO Inputs
-- getting cmd line arguments, produces the input in the usable form
--  with a default value for the file name
-- the two text arguments are used in the cmd arg parse
-- is specific to the parser (and thus to the cmd line arguments

parseArgs2input :: Text -> Text -> Text -> ErrIO Inputs
parseArgs2input Text
filenameDefault Text
t1 Text
t2 = do
  LitArgs
args1 <- Text -> Text -> ErrIO LitArgs
getArgsParsed Text
t1 Text
t2
  forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"parseArgs2input: args found", forall {a}. Show a => a -> Text
showT LitArgs
args1]

  --    let server = selectServer args :: ServerFlag
  Path Abs Dir
homeDir :: Path Abs Dir <- ErrIO (Path Abs Dir)
homeDir2
  let inFile1 :: Text
inFile1 = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. LitArgs -> String
argInFile1 forall a b. (a -> b) -> a -> b
$ LitArgs
args1

  let filename1 :: FileResultT (Path Abs Dir) (Path Rel File)
filename1 = if forall z. (Zeros z, Eq z) => z -> Bool
isZero Text
inFile1
        then forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
addFileName Path Abs Dir
homeDir (Text -> Path Rel File
makeRelFileT Text
filenameDefault)
        else forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
addFileName Path Abs Dir
homeDir (Text -> Path Rel File
makeRelFileT Text
inFile1) :: Path Abs File

  let inputs1 :: Inputs
inputs1 = Inputs { inFile1 :: String
inFile1 = forall b t. Path b t -> String
toFilePath FileResultT (Path Abs Dir) (Path Rel File)
filename1
                       , flag1 :: Text
flag1   = String -> Text
s2t forall a b. (a -> b) -> a -> b
$ LitArgs -> String
argFlag1 LitArgs
args1
                       , switch1 :: Bool
switch1 = LitArgs -> Bool
argSwitch1 LitArgs
args1
                       }

  forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"parseArgs2input:  inputs ", forall {a}. Show a => a -> Text
showT Inputs
inputs1]
  forall (m :: * -> *) a. Monad m => a -> m a
return Inputs
inputs1


getArgsParsed :: Text -> Text -> ErrIO LitArgs
getArgsParsed :: Text -> Text -> ErrIO LitArgs
getArgsParsed Text
t1 Text
t2 = do
  LitArgs
args <- forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ forall a. ParserInfo a -> IO a
execParser ParserInfo LitArgs
opts
  forall (m :: * -> *) a. Monad m => a -> m a
return LitArgs
args
 where
  opts :: ParserInfo LitArgs
opts = forall a. Parser a -> InfoMod a -> ParserInfo a
info (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LitArgs
cmdArgs)
              (forall a. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<> (forall a. String -> InfoMod a
progDesc forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
t2s forall a b. (a -> b) -> a -> b
$ Text
t1) forall a. Semigroup a => a -> a -> a
<> (forall a. String -> InfoMod a
header forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
t2s forall a b. (a -> b) -> a -> b
$ Text
t2))