{-# LANGUAGE DeriveLift#-}
module System.Console.Docopt.Types
    where

import           Data.Char (isUpper)
import           Data.List (nub)
import           Data.Map (Map)
import qualified Data.Map as M
import Language.Haskell.TH.Syntax (Lift)

-- * Usage expression Types

type Name = String

data Pattern a = Sequence [Pattern a]
               | OneOf [Pattern a]
               | Unordered [Pattern a]
               | Optional (Pattern a)
               | Repeated (Pattern a)
               | Atom a
               deriving (Int -> Pattern a -> ShowS
[Pattern a] -> ShowS
Pattern a -> String
(Int -> Pattern a -> ShowS)
-> (Pattern a -> String)
-> ([Pattern a] -> ShowS)
-> Show (Pattern a)
forall a. Show a => Int -> Pattern a -> ShowS
forall a. Show a => [Pattern a] -> ShowS
forall a. Show a => Pattern a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pattern a] -> ShowS
$cshowList :: forall a. Show a => [Pattern a] -> ShowS
show :: Pattern a -> String
$cshow :: forall a. Show a => Pattern a -> String
showsPrec :: Int -> Pattern a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Pattern a -> ShowS
Show, Pattern a -> Pattern a -> Bool
(Pattern a -> Pattern a -> Bool)
-> (Pattern a -> Pattern a -> Bool) -> Eq (Pattern a)
forall a. Eq a => Pattern a -> Pattern a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pattern a -> Pattern a -> Bool
$c/= :: forall a. Eq a => Pattern a -> Pattern a -> Bool
== :: Pattern a -> Pattern a -> Bool
$c== :: forall a. Eq a => Pattern a -> Pattern a -> Bool
Eq, Pattern a -> Q Exp
Pattern a -> Q (TExp (Pattern a))
(Pattern a -> Q Exp)
-> (Pattern a -> Q (TExp (Pattern a))) -> Lift (Pattern a)
forall a. Lift a => Pattern a -> Q Exp
forall a. Lift a => Pattern a -> Q (TExp (Pattern a))
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Pattern a -> Q (TExp (Pattern a))
$cliftTyped :: forall a. Lift a => Pattern a -> Q (TExp (Pattern a))
lift :: Pattern a -> Q Exp
$clift :: forall a. Lift a => Pattern a -> Q Exp
Lift)

atoms :: Eq a => Pattern a -> [a]
atoms :: Pattern a -> [a]
atoms (Sequence [Pattern a]
ps)  = (Pattern a -> [a]) -> [Pattern a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pattern a -> [a]
forall a. Eq a => Pattern a -> [a]
atoms [Pattern a]
ps
atoms (OneOf [Pattern a]
ps)     = (Pattern a -> [a]) -> [Pattern a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pattern a -> [a]
forall a. Eq a => Pattern a -> [a]
atoms ([Pattern a] -> [a]) -> [Pattern a] -> [a]
forall a b. (a -> b) -> a -> b
$ [Pattern a] -> [Pattern a]
forall a. Eq a => [a] -> [a]
nub [Pattern a]
ps
atoms (Unordered [Pattern a]
ps) = (Pattern a -> [a]) -> [Pattern a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pattern a -> [a]
forall a. Eq a => Pattern a -> [a]
atoms ([Pattern a] -> [a]) -> [Pattern a] -> [a]
forall a b. (a -> b) -> a -> b
$ [Pattern a] -> [Pattern a]
forall a. Eq a => [a] -> [a]
nub [Pattern a]
ps
atoms (Optional Pattern a
p)   = Pattern a -> [a]
forall a. Eq a => Pattern a -> [a]
atoms Pattern a
p
atoms (Repeated Pattern a
p)   = Pattern a -> [a]
forall a. Eq a => Pattern a -> [a]
atoms Pattern a
p
atoms (Atom a
a)       = [a
a]

-- | A named leaf node of the usage pattern tree
data Option = LongOption Name
            | ShortOption Char
            | Command Name
            | Argument Name
            | AnyOption
            deriving (Int -> Option -> ShowS
[Option] -> ShowS
Option -> String
(Int -> Option -> ShowS)
-> (Option -> String) -> ([Option] -> ShowS) -> Show Option
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Option] -> ShowS
$cshowList :: [Option] -> ShowS
show :: Option -> String
$cshow :: Option -> String
showsPrec :: Int -> Option -> ShowS
$cshowsPrec :: Int -> Option -> ShowS
Show, Option -> Option -> Bool
(Option -> Option -> Bool)
-> (Option -> Option -> Bool) -> Eq Option
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Option -> Option -> Bool
$c/= :: Option -> Option -> Bool
== :: Option -> Option -> Bool
$c== :: Option -> Option -> Bool
Eq, Eq Option
Eq Option
-> (Option -> Option -> Ordering)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Option)
-> (Option -> Option -> Option)
-> Ord Option
Option -> Option -> Bool
Option -> Option -> Ordering
Option -> Option -> Option
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Option -> Option -> Option
$cmin :: Option -> Option -> Option
max :: Option -> Option -> Option
$cmax :: Option -> Option -> Option
>= :: Option -> Option -> Bool
$c>= :: Option -> Option -> Bool
> :: Option -> Option -> Bool
$c> :: Option -> Option -> Bool
<= :: Option -> Option -> Bool
$c<= :: Option -> Option -> Bool
< :: Option -> Option -> Bool
$c< :: Option -> Option -> Bool
compare :: Option -> Option -> Ordering
$ccompare :: Option -> Option -> Ordering
$cp1Ord :: Eq Option
Ord, Option -> Q Exp
Option -> Q (TExp Option)
(Option -> Q Exp) -> (Option -> Q (TExp Option)) -> Lift Option
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Option -> Q (TExp Option)
$cliftTyped :: Option -> Q (TExp Option)
lift :: Option -> Q Exp
$clift :: Option -> Q Exp
Lift)

type OptPattern = Pattern Option

humanize :: Option -> String
humanize :: Option -> String
humanize Option
opt = case Option
opt of
  Command String
name    -> String
name
  Argument String
name   -> if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isUpper String
name
                         then String
name
                         else String
"<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
  LongOption String
name -> String
"--"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
name
  ShortOption Char
c   -> [Char
'-',Char
c]
  Option
AnyOption       -> String
"[options]"

-- | Used when parsing through the available option descriptions.
--   Holds a list of synonymous options, Maybe a default value (if specified),
--   an expectsVal :: Bool that indicates whether this option is a flag (--flag)
--   or an option that needs an argument (--opt=arg), and isRepeated :: Bool
--   that indicates whether this option is always single or needs to be accumulated
data OptionInfo = OptionInfo
                  { OptionInfo -> [Option]
synonyms :: [Option]
                  , OptionInfo -> Maybe String
defaultVal :: Maybe String
                  , OptionInfo -> Bool
expectsVal :: Bool
                  , OptionInfo -> Bool
isRepeated :: Bool
                  } deriving (Int -> OptionInfo -> ShowS
[OptionInfo] -> ShowS
OptionInfo -> String
(Int -> OptionInfo -> ShowS)
-> (OptionInfo -> String)
-> ([OptionInfo] -> ShowS)
-> Show OptionInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionInfo] -> ShowS
$cshowList :: [OptionInfo] -> ShowS
show :: OptionInfo -> String
$cshow :: OptionInfo -> String
showsPrec :: Int -> OptionInfo -> ShowS
$cshowsPrec :: Int -> OptionInfo -> ShowS
Show, OptionInfo -> OptionInfo -> Bool
(OptionInfo -> OptionInfo -> Bool)
-> (OptionInfo -> OptionInfo -> Bool) -> Eq OptionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptionInfo -> OptionInfo -> Bool
$c/= :: OptionInfo -> OptionInfo -> Bool
== :: OptionInfo -> OptionInfo -> Bool
$c== :: OptionInfo -> OptionInfo -> Bool
Eq, OptionInfo -> Q Exp
OptionInfo -> Q (TExp OptionInfo)
(OptionInfo -> Q Exp)
-> (OptionInfo -> Q (TExp OptionInfo)) -> Lift OptionInfo
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: OptionInfo -> Q (TExp OptionInfo)
$cliftTyped :: OptionInfo -> Q (TExp OptionInfo)
lift :: OptionInfo -> Q Exp
$clift :: OptionInfo -> Q Exp
Lift)

fromSynList :: [Option] -> OptionInfo
fromSynList :: [Option] -> OptionInfo
fromSynList [Option]
opts = OptionInfo :: [Option] -> Maybe String -> Bool -> Bool -> OptionInfo
OptionInfo { synonyms :: [Option]
synonyms = [Option]
opts
                              , defaultVal :: Maybe String
defaultVal = Maybe String
forall a. Maybe a
Nothing
                              , expectsVal :: Bool
expectsVal = Bool
False
                              , isRepeated :: Bool
isRepeated = Bool
False }

-- | Maps each available option to a OptionInfo entry
--   (each synonymous option gets its own separate entry, for easy lookup)
type OptInfoMap = Map Option OptionInfo

-- | Contains all the relevant information parsed out of a usage string.
--   Used to build the actual command-line arg parser.
type OptFormat = (OptPattern, OptInfoMap)

-- |
data OptParserState = OptParserState
                      { OptParserState -> OptInfoMap
optInfoMap :: OptInfoMap
                      , OptParserState -> Arguments
parsedArgs :: Arguments
                      , OptParserState -> Bool
inShortOptStack :: Bool
                      , OptParserState -> Bool
inTopLevelSequence :: Bool
                      } deriving (Int -> OptParserState -> ShowS
[OptParserState] -> ShowS
OptParserState -> String
(Int -> OptParserState -> ShowS)
-> (OptParserState -> String)
-> ([OptParserState] -> ShowS)
-> Show OptParserState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptParserState] -> ShowS
$cshowList :: [OptParserState] -> ShowS
show :: OptParserState -> String
$cshow :: OptParserState -> String
showsPrec :: Int -> OptParserState -> ShowS
$cshowsPrec :: Int -> OptParserState -> ShowS
Show)

fromOptInfoMap :: OptInfoMap -> OptParserState
fromOptInfoMap :: OptInfoMap -> OptParserState
fromOptInfoMap OptInfoMap
m = OptParserState :: OptInfoMap -> Arguments -> Bool -> Bool -> OptParserState
OptParserState { optInfoMap :: OptInfoMap
optInfoMap = OptInfoMap
m
                                  , parsedArgs :: Arguments
parsedArgs = Arguments
forall k a. Map k a
M.empty
                                  , inShortOptStack :: Bool
inShortOptStack = Bool
False
                                  , inTopLevelSequence :: Bool
inTopLevelSequence = Bool
True }


data ArgValue = MultiValue [String]
              | Value String
              | NoValue
              | Counted Int
              | Present
              | NotPresent
              deriving (Int -> ArgValue -> ShowS
[ArgValue] -> ShowS
ArgValue -> String
(Int -> ArgValue -> ShowS)
-> (ArgValue -> String) -> ([ArgValue] -> ShowS) -> Show ArgValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArgValue] -> ShowS
$cshowList :: [ArgValue] -> ShowS
show :: ArgValue -> String
$cshow :: ArgValue -> String
showsPrec :: Int -> ArgValue -> ShowS
$cshowsPrec :: Int -> ArgValue -> ShowS
Show, ArgValue -> ArgValue -> Bool
(ArgValue -> ArgValue -> Bool)
-> (ArgValue -> ArgValue -> Bool) -> Eq ArgValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgValue -> ArgValue -> Bool
$c/= :: ArgValue -> ArgValue -> Bool
== :: ArgValue -> ArgValue -> Bool
$c== :: ArgValue -> ArgValue -> Bool
Eq, Eq ArgValue
Eq ArgValue
-> (ArgValue -> ArgValue -> Ordering)
-> (ArgValue -> ArgValue -> Bool)
-> (ArgValue -> ArgValue -> Bool)
-> (ArgValue -> ArgValue -> Bool)
-> (ArgValue -> ArgValue -> Bool)
-> (ArgValue -> ArgValue -> ArgValue)
-> (ArgValue -> ArgValue -> ArgValue)
-> Ord ArgValue
ArgValue -> ArgValue -> Bool
ArgValue -> ArgValue -> Ordering
ArgValue -> ArgValue -> ArgValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArgValue -> ArgValue -> ArgValue
$cmin :: ArgValue -> ArgValue -> ArgValue
max :: ArgValue -> ArgValue -> ArgValue
$cmax :: ArgValue -> ArgValue -> ArgValue
>= :: ArgValue -> ArgValue -> Bool
$c>= :: ArgValue -> ArgValue -> Bool
> :: ArgValue -> ArgValue -> Bool
$c> :: ArgValue -> ArgValue -> Bool
<= :: ArgValue -> ArgValue -> Bool
$c<= :: ArgValue -> ArgValue -> Bool
< :: ArgValue -> ArgValue -> Bool
$c< :: ArgValue -> ArgValue -> Bool
compare :: ArgValue -> ArgValue -> Ordering
$ccompare :: ArgValue -> ArgValue -> Ordering
$cp1Ord :: Eq ArgValue
Ord)

-- | Maps each Option to all of the valued parsed from the command line
--   (in order of last to first, if multiple values encountered)
type Arguments = Map Option ArgValue

-- | An abstract data type which represents Docopt usage patterns.
data Docopt = Docopt { Docopt -> OptFormat
optFormat :: OptFormat
                     -- | Retrieve the original usage string.
                     , Docopt -> String
usage :: String
                     }