{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-} module UI.Butcher.Applicative.Types where #include "prelude.inc" import Control.Applicative.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 (Show, Eq) -- | Information about an error that occured when trying to parse some @Input@ -- using some @CmdParser@. data ParsingError = ParsingError { _pe_messages :: [String] , _pe_remaining :: Input } deriving (Show, Eq) -- | Specifies whether we accept 0-1 or 0-n for @CmdParserPart@s. data ManyUpperBound = ManyUpperBound1 | ManyUpperBoundN data Visibility = Visible | Hidden deriving (Show, Eq) data CmdParserF 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 -> a) | forall p . Typeable p => CmdParserPartMany ManyUpperBound PartDesc (String -> Maybe (p, String)) ([p] -> a) | forall p . Typeable p => CmdParserPartInp PartDesc (Input -> Maybe (p, Input)) (p -> a) | forall p . Typeable p => CmdParserPartManyInp ManyUpperBound PartDesc (Input -> Maybe (p, Input)) ([p] -> a) | CmdParserChild String (CmdParser out out) a | CmdParserReorderStart a | CmdParserReorderStop a -- | CmdParserGrouped String a -- | CmdParserGroupEnd a type CmdParser out = Ap (CmdParserF out) --------- -- | 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 = CommandDesc { _cmd_mParent :: Maybe (Maybe String, CommandDesc) , _cmd_synopsis :: Maybe PP.Doc , _cmd_help :: Maybe PP.Doc , _cmd_parts :: [PartDesc] , _cmd_children :: [(String, CommandDesc)] , _cmd_visibility :: Visibility } deriving Show -- 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 Show data CompletionItem = CompletionString String | CompletionDirectory | CompletionFile deriving Show data Cover = Bare | Wrap type family Wear cover f a where Wear 'Bare Identity a = a Wear 'Wrap f a = f a class Covered c where wrap :: c 'Bare Identity -> c 'Wrap Identity unwrap :: c 'Wrap Identity -> c 'Bare Identity class CTraversable ctx c where cTraverse :: Proxy ctx -> (forall a . ctx a => f a -> m (g a)) -> c f -> m (c g)