    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE StandaloneDeriving #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE TemplateHaskell #-}

    module UI.Butcher.Monadic.Internal.Types
      ( CommandDesc (..)
      , cmd_mParent
      , cmd_help
      , cmd_synopsis
      , cmd_parts
      , cmd_out
      , cmd_children
      , cmd_visibility
      , emptyCommandDesc
      , CmdParserF (..)
      , CmdParser
      , PartDesc (..)
      , Input (..)
      , ParsingError (..)
      , addSuggestion
      , ManyUpperBound (..)
      , Visibility (..)
      , CompletionItem (..)
      )
    where

    #include "prelude.inc"
    import           Control.Monad.Free
    import qualified Control.Monad.Trans.MultiState.Strict as MultiStateS

    import qualified Lens.Micro.TH as LensTH

    import qualified Text.PrettyPrint as PP

    -- | Butcher supports two input modi: @String@ and @[String]@. Program
    -- arguments have the latter form, while parsing interactive command input
    -- (e.g. when you implement a terminal of sorts) is easier when you can
    -- process the full @String@ without having to wordify it first by some
    -- means (and List.words is not the right approach in many situations.)
    data Input = InputString String | InputArgs [String]
      deriving (Int -> Input -> ShowS
    [Input] -> ShowS
    Input -> String
    (Int -> Input -> ShowS)
    -> (Input -> String) -> ([Input] -> ShowS) -> Show Input
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Input] -> ShowS
    $cshowList :: [Input] -> ShowS
    show :: Input -> String
    $cshow :: Input -> String
    showsPrec :: Int -> Input -> ShowS
    $cshowsPrec :: Int -> Input -> ShowS
    Show, Input -> Input -> Bool
    (Input -> Input -> Bool) -> (Input -> Input -> Bool) -> Eq Input
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Input -> Input -> Bool
    $c/= :: Input -> Input -> Bool
    == :: Input -> Input -> Bool
    $c== :: Input -> Input -> Bool
    Eq)

    -- | Information about an error that occured when trying to parse some @Input@
    -- using some @CmdParser@.
    data ParsingError = ParsingError
      { ParsingError -> [String]
    _pe_messages  :: [String]
      , ParsingError -> Input
    _pe_remaining :: Input
      }
      deriving (Int -> ParsingError -> ShowS
    [ParsingError] -> ShowS
    ParsingError -> String
    (Int -> ParsingError -> ShowS)
    -> (ParsingError -> String)
    -> ([ParsingError] -> ShowS)
    -> Show ParsingError
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [ParsingError] -> ShowS
    $cshowList :: [ParsingError] -> ShowS
    show :: ParsingError -> String
    $cshow :: ParsingError -> String
    showsPrec :: Int -> ParsingError -> ShowS
    $cshowsPrec :: Int -> ParsingError -> ShowS
    Show, ParsingError -> ParsingError -> Bool
    (ParsingError -> ParsingError -> Bool)
    -> (ParsingError -> ParsingError -> Bool) -> Eq ParsingError
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: ParsingError -> ParsingError -> Bool
    $c/= :: ParsingError -> ParsingError -> Bool
    == :: ParsingError -> ParsingError -> Bool
    $c== :: ParsingError -> ParsingError -> Bool
    Eq)

    -- | Specifies whether we accept 0-1 or 0-n for @CmdParserPart@s.
    data ManyUpperBound
      = ManyUpperBound1
      | ManyUpperBoundN

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

    data CmdParserF f out a
      =                          CmdParserHelp PP.Doc a
      |                          CmdParserSynopsis String a
      |                          CmdParserPeekDesc (CommandDesc () -> a)
      |                          CmdParserPeekInput (String -> a)
      -- TODO: we can clean up this duplication by providing
      -- a function (String -> Maybe (p, String)) -> (Input -> Maybe (p, Input)).
      | forall p . Typeable p => CmdParserPart PartDesc (String -> Maybe (p, String)) (p -> f ()) (p -> a)
      | forall p . Typeable p => CmdParserPartMany ManyUpperBound PartDesc (String -> Maybe (p, String)) (p -> f ()) ([p] -> a)
      | forall p . Typeable p => CmdParserPartInp PartDesc (Input -> Maybe (p, Input)) (p -> f ()) (p -> a)
      | forall p . Typeable p => CmdParserPartManyInp ManyUpperBound PartDesc (Input -> Maybe (p, Input)) (p -> f ()) ([p] -> a)
      |                          CmdParserChild (Maybe String) Visibility (CmdParser f out ()) (f ()) a
      |                          CmdParserImpl  out                                a
      |                          CmdParserReorderStart                             a
      |                          CmdParserReorderStop                              a
      |                          CmdParserGrouped String                           a
      |                          CmdParserGroupEnd                                 a
      | forall p . Typeable p => CmdParserAlternatives PartDesc [((String -> Bool), CmdParser f out p)] (p -> a)

    -- | The CmdParser monad type. It is a free monad over some functor but users
    -- of butcher don't need to know more than that 'CmdParser' is a 'Monad'.
    type CmdParser f out = Free (CmdParserF f out)

    -- type CmdParser a = CmdParserM a a

    -- data CmdPartParserF a
    --   = CmdPartParserHelp String a
    --   | forall p . CmdPartParserCore (String -> Maybe (p, String)) -- parser
    --                                  (Maybe p) -- optional default value
    --                                  (p -> a)
    --   | forall p . CmdPartParserOptional (CmdPartParser p)
    --                                      (Maybe p -> a)
    --   -- the idea here was to allow adding some dynamic data to each "node" of
    --   -- the output CommandDesc so the user can potentially add custom additional
    --   -- information, and write a custom pretty-printer for e.g. help output
    --   -- from that dynamically-enriched CommandDesc structure.
    --   -- disabled for now, because i am not sure what exactly "adding to every
    --   -- node" involves, because the mapping from Functor to Desc is nontrivial.
    --   -- (and because i don't have a direct use-case at the moment..)
    --   -- | CmdPartParserCustom Dynamic a
    --
    -- type CmdPartParser = Free CmdPartParserF

    ---------

    -- | A representation/description of a command parser built via the
    -- 'CmdParser' monad. Can be transformed into a pretty Doc to display
    -- as usage/help via 'UI.Butcher.Monadic.Pretty.ppUsage' and related functions.
    --
    -- Note that there is the '_cmd_out' accessor that contains @Maybe out@ which
    -- might be useful after successful parsing.
    data CommandDesc out = CommandDesc
      { CommandDesc out -> Maybe (Maybe String, CommandDesc out)
    _cmd_mParent  :: Maybe (Maybe String, CommandDesc out)
      , CommandDesc out -> Maybe Doc
    _cmd_synopsis :: Maybe PP.Doc
      , CommandDesc out -> Maybe Doc
    _cmd_help     :: Maybe PP.Doc
      , CommandDesc out -> [PartDesc]
    _cmd_parts    :: [PartDesc]
      , CommandDesc out -> Maybe out
    _cmd_out      :: Maybe out
      , CommandDesc out -> Deque (Maybe String, CommandDesc out)
    _cmd_children :: Deque (Maybe String, CommandDesc out)
                         -- we don't use a Map here because we'd like to
                         -- retain the order.
      , CommandDesc out -> Visibility
    _cmd_visibility :: Visibility
      }

    -- type PartSeqDesc = [PartDesc]

    -- | A representation/description of a command's parts, i.e. flags or params.
    -- As a butcher user, the higher-level pretty-printing functions for
    -- 'CommandDesc' are probably sufficient.
    data PartDesc
      = PartLiteral String -- expect a literal string, like "--dry-run"
      | PartVariable String -- expect some user-provided input. The
                                   -- string represents the name for the variable
                                   -- used in the documentation, e.g. "FILE"
      | PartOptional PartDesc
      | PartAlts [PartDesc]
      | PartSeq [PartDesc]
      | PartDefault String -- default representation
                    PartDesc
      | PartSuggestion [CompletionItem] PartDesc
      | PartRedirect String -- name for the redirection
                     PartDesc
      | PartReorder [PartDesc]
      | PartMany PartDesc
      | PartWithHelp PP.Doc PartDesc
      | PartHidden PartDesc
      deriving Int -> PartDesc -> ShowS
    [PartDesc] -> ShowS
    PartDesc -> String
    (Int -> PartDesc -> ShowS)
    -> (PartDesc -> String) -> ([PartDesc] -> ShowS) -> Show PartDesc
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [PartDesc] -> ShowS
    $cshowList :: [PartDesc] -> ShowS
    show :: PartDesc -> String
    $cshow :: PartDesc -> String
    showsPrec :: Int -> PartDesc -> ShowS
    $cshowsPrec :: Int -> PartDesc -> ShowS
    Show

    addSuggestion :: Maybe [CompletionItem] -> PartDesc -> PartDesc
    addSuggestion :: Maybe [CompletionItem] -> PartDesc -> PartDesc
    addSuggestion Nothing     = PartDesc -> PartDesc
    forall a. a -> a
    id
    addSuggestion (Just sugs :: [CompletionItem]
    sugs) = [CompletionItem] -> PartDesc -> PartDesc
    PartSuggestion [CompletionItem]
    sugs

    data CompletionItem
      = CompletionString String
      | CompletionDirectory
      | CompletionFile
      deriving Int -> CompletionItem -> ShowS
    [CompletionItem] -> ShowS
    CompletionItem -> String
    (Int -> CompletionItem -> ShowS)
    -> (CompletionItem -> String)
    -> ([CompletionItem] -> ShowS)
    -> Show CompletionItem
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [CompletionItem] -> ShowS
    $cshowList :: [CompletionItem] -> ShowS
    show :: CompletionItem -> String
    $cshow :: CompletionItem -> String
    showsPrec :: Int -> CompletionItem -> ShowS
    $cshowsPrec :: Int -> CompletionItem -> ShowS
    Show

    {-
    command documentation structure
    1. terminals. e.g. "--dry-run"
    2. non-terminals, e.g. "FILES"
    3. sequences, e.g. "<program> FLAGS NUMBER PATH"
    -- 4. alternatives, e.g. "--date=(relative|local|iso|rfc|..)"
    5. sub-commands: git (init|commit|push|clone|..)
       compared to 4, the subcommands have their own flags and params;
       they essentially "take over".
    6. optional, e.g. "cabal run [COMPONENT]"
    7. default, e.g. "-O(LEVEL=1)"
    8. indirection, e.g. "cabal COMMAND\n\nCOMMAND: ..."
    -}

    --

    deriving instance Functor (CmdParserF f out)
    deriving instance Functor CommandDesc

    --

    -- | Empty 'CommandDesc' value. Mostly for butcher-internal usage.
    emptyCommandDesc :: CommandDesc out
    emptyCommandDesc :: CommandDesc out
    emptyCommandDesc =
      Maybe (Maybe String, CommandDesc out)
    -> Maybe Doc
    -> Maybe Doc
    -> [PartDesc]
    -> Maybe out
    -> Deque (Maybe String, CommandDesc out)
    -> Visibility
    -> CommandDesc out
    forall out.
    Maybe (Maybe String, CommandDesc out)
    -> Maybe Doc
    -> Maybe Doc
    -> [PartDesc]
    -> Maybe out
    -> Deque (Maybe String, CommandDesc out)
    -> Visibility
    -> CommandDesc out
    CommandDesc Maybe (Maybe String, CommandDesc out)
    forall a. Maybe a
    Nothing Maybe Doc
    forall a. Maybe a
    Nothing Maybe Doc
    forall a. Maybe a
    Nothing [] Maybe out
    forall a. Maybe a
    Nothing Deque (Maybe String, CommandDesc out)
    forall a. Monoid a => a
    mempty Visibility
    Visible

    instance Show (CommandDesc out) where
      show :: CommandDesc out -> String
    show c :: CommandDesc out
    c = "Command help=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Maybe Doc -> String
    forall a. Show a => a -> String
    show (CommandDesc out -> Maybe Doc
    forall out. CommandDesc out -> Maybe Doc
    _cmd_help CommandDesc out
    c)
            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " synopsis=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Maybe Doc -> String
    forall a. Show a => a -> String
    show (CommandDesc out -> Maybe Doc
    forall out. CommandDesc out -> Maybe Doc
    _cmd_synopsis CommandDesc out
    c)
            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " mParent=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Maybe (Maybe String) -> String
    forall a. Show a => a -> String
    show ((Maybe String, CommandDesc out) -> Maybe String
    forall a b. (a, b) -> a
    fst ((Maybe String, CommandDesc out) -> Maybe String)
    -> Maybe (Maybe String, CommandDesc out) -> Maybe (Maybe String)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CommandDesc out -> Maybe (Maybe String, CommandDesc out)
    forall out.
    CommandDesc out -> Maybe (Maybe String, CommandDesc out)
    _cmd_mParent CommandDesc out
    c)
            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " out=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String -> (out -> String) -> Maybe out -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "(none)" (\_ -> "(smth)") (CommandDesc out -> Maybe out
    forall out. CommandDesc out -> Maybe out
    _cmd_out CommandDesc out
    c)
            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " parts.length=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show ([PartDesc] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([PartDesc] -> Int) -> [PartDesc] -> Int
    forall a b. (a -> b) -> a -> b
    $ CommandDesc out -> [PartDesc]
    forall out. CommandDesc out -> [PartDesc]
    _cmd_parts CommandDesc out
    c)
            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " parts=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [PartDesc] -> String
    forall a. Show a => a -> String
    show (CommandDesc out -> [PartDesc]
    forall out. CommandDesc out -> [PartDesc]
    _cmd_parts CommandDesc out
    c)
            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " children=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Deque (Maybe String) -> String
    forall a. Show a => a -> String
    show ((Maybe String, CommandDesc out) -> Maybe String
    forall a b. (a, b) -> a
    fst ((Maybe String, CommandDesc out) -> Maybe String)
    -> Deque (Maybe String, CommandDesc out) -> Deque (Maybe String)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CommandDesc out -> Deque (Maybe String, CommandDesc out)
    forall out.
    CommandDesc out -> Deque (Maybe String, CommandDesc out)
    _cmd_children CommandDesc out
    c)

    --

    LensTH.makeLenses ''CommandDesc
    LensTH.makeLenses ''PartDesc

    --

    -- instance Show FlagDesc where
    --   show (FlagDesc _ short long helpM params) = show (short, long, helpM, params) -- TODO: improve

    -- class Typeable a => IsParam a where
    --   paramParse :: String -> Maybe (a, String, String) -- value, representation, rest
    --   paramStaticDef :: a

    -- emptyParamDesc :: ParamDesc a
    -- emptyParamDesc = ParamDesc Nothing Nothing

    -- deriving instance Show a => Show (ParamDesc a)

    -- instance Show a => Show (CmdParserF out a) where
    --   show (CmdParserHelp s x) = "(CmdParserHelp " ++ show s ++ " " ++ show x ++ ")"
    --   show (CmdParserFlag shorts longs _ _) = "(CmdParserFlag -" ++ shorts ++ " " ++ show longs ++ ")"
    --   show (CmdParserParam s _ _) = "(CmdParserParam " ++ s ++ ")"
    --   show (CmdParserChild s _ _) = "(CmdParserChild " ++ s ++ ")"
    --   show (CmdParserRun _) = "CmdParserRun"