{-# 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"