{-# 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
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)
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)
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)
| 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)
type CmdParser f out = Free (CmdParserF f out)
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)
, CommandDesc out -> Visibility
_cmd_visibility :: Visibility
}
data PartDesc
= PartLiteral String
| PartVariable String
| PartOptional PartDesc
| PartAlts [PartDesc]
| PartSeq [PartDesc]
| PartDefault String
PartDesc
| PartSuggestion [CompletionItem] PartDesc
| PartRedirect String
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
deriving instance Functor (CmdParserF f out)
deriving instance Functor CommandDesc
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