module Parser(-- * Argument parsers

              Args(..), args, opts) where

import Options.Applicative

data Args = Args {    -- ^ Structure for accepting arguments

    Args -> Bool
list :: Bool,     -- ^ @\-l@ flag (show files as a table)

    Args -> Bool
size :: Bool,     -- ^ @\-s@ flag (show file sizes), implies @-l@

    Args -> Bool
dots :: Bool,     -- ^ @\-x@ flag (show dotfiles and directories)

    Args -> Bool
perm :: Bool,     -- ^ @\-p@ flag (display file permissions), implies @-l@

    Args -> Bool
nums :: Bool,     -- ^ @\-n@ flag (display line numbers), implies @-l@

    Args -> Bool
time :: Bool,     -- ^ @\-t@ flag (display last modification time), implies @-l@

    Args -> Bool
afl  :: Bool,     -- ^ @\-a@ flag (equivalent to -lapsnt)

    Args -> String
path :: String    -- ^ path to the directory to list

} deriving (Int -> Args -> ShowS
[Args] -> ShowS
Args -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Args] -> ShowS
$cshowList :: [Args] -> ShowS
show :: Args -> String
$cshow :: Args -> String
showsPrec :: Int -> Args -> ShowS
$cshowsPrec :: Int -> Args -> ShowS
Show, Args -> Args -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Args -> Args -> Bool
$c/= :: Args -> Args -> Bool
== :: Args -> Args -> Bool
$c== :: Args -> Args -> Bool
Eq)

-- | Argument parser using @optparse-applicative@

args :: Parser Args
args :: Parser Args
args = Bool
-> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> String -> Args
Args 
    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
"list" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l' forall a. Semigroup a => a -> a -> a
<>
        forall (f :: * -> *) a. String -> Mod f a
help String
"Wheter to display each file on a new line"
    )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (
        forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"filesize" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's' forall a. Semigroup a => a -> a -> a
<>
        forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to display file sizes (implies -l)"
    )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (
        forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"extra"   forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'x' forall a. Semigroup a => a -> a -> a
<>
        forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to display dotfiles/hidden files"
    )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (
        forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"perms"  forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' forall a. Semigroup a => a -> a -> a
<>
        forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to display file permissions (implies -l)"
    )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (
        forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"line-numbers" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n' forall a. Semigroup a => a -> a -> a
<>
        forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to display line numbers in listing (implies -l)"
    )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (
        forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"mod-times" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't' forall a. Semigroup a => a -> a -> a
<>
        forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to display last modification times in listing (implies -l)"
    )   
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (
        forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"all" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'a' forall a. Semigroup a => a -> a -> a
<>
        forall (f :: * -> *) a. String -> Mod f a
help String
"Equivalent to -lapsnt"
    )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument forall s. IsString s => ReadM s
str (
        forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIR" forall a. Semigroup a => a -> a -> a
<>
        forall (f :: * -> *) a. String -> Mod f a
help String
"Directory to list" forall a. Semigroup a => a -> a -> a
<>
        forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"."
    )

-- | expanded version to be actually executed by @lsh@ 

opts :: ParserInfo Args
opts :: ParserInfo Args
opts = forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Args
args forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper) (
            forall a. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<>
            forall a. String -> InfoMod a
progDesc String
"List files in a directory" forall a. Semigroup a => a -> a -> a
<>
            forall a. String -> InfoMod a
header String
"lsh - list your files with style"
            )