{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
module UI.Butcher.Monadic.Internal.Core
( addCmdSynopsis
, addCmdHelp
, addCmdHelpStr
, peekCmdDesc
, peekInput
, addCmdPart
, addCmdPartA
, addCmdPartMany
, addCmdPartManyA
, addCmdPartInp
, addCmdPartInpA
, addCmdPartManyInp
, addCmdPartManyInpA
, addCmd
, addCmdHidden
, addNullCmd
, addCmdImpl
, addAlternatives
, reorderStart
, reorderStop
, checkCmdParser
, runCmdParser
, runCmdParserExt
, runCmdParserA
, runCmdParserAExt
, mapOut
, varPartDesc
)
where
#include "prelude.inc"
import Control.Monad.Free
import qualified Control.Monad.Trans.MultiRWS.Strict
as MultiRWSS
import qualified Control.Monad.Trans.MultiState.Strict
as MultiStateS
import qualified Lens.Micro as Lens
import Lens.Micro ( (%~)
, (.~)
)
import qualified Text.PrettyPrint as PP
import Text.PrettyPrint ( (<+>)
, ($$)
, ($+$)
)
import Data.HList.ContainsType
import Data.Dynamic
import UI.Butcher.Monadic.Internal.Types
mModify :: MonadMultiState s m => (s -> s) -> m ()
mModify :: forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify s -> s
f = m s
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet m s -> (s -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (s -> m ()) -> (s -> s) -> s -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
f
(.=+) :: MonadMultiState s m => Lens.ASetter s s a b -> b -> m ()
ASetter s s a b
l .=+ :: forall s (m :: * -> *) a b.
MonadMultiState s m =>
ASetter s s a b -> b -> m ()
.=+ b
b = (s -> s) -> m ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify ((s -> s) -> m ()) -> (s -> s) -> m ()
forall a b. (a -> b) -> a -> b
$ ASetter s s a b
l ASetter s s a b -> b -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
b
(%=+) :: MonadMultiState s m => Lens.ASetter s s a b -> (a -> b) -> m ()
ASetter s s a b
l %=+ :: forall s (m :: * -> *) a b.
MonadMultiState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=+ a -> b
f = (s -> s) -> m ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify (ASetter s s a b
l ASetter s s a b -> (a -> b) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ a -> b
f)
addCmdSynopsis :: String -> CmdParser f out ()
addCmdSynopsis :: forall (f :: * -> *) out. String -> CmdParser f out ()
addCmdSynopsis String
s = CmdParserF f out () -> Free (CmdParserF f out) ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out () -> Free (CmdParserF f out) ())
-> CmdParserF f out () -> Free (CmdParserF f out) ()
forall a b. (a -> b) -> a -> b
$ String -> () -> CmdParserF f out ()
forall (f :: * -> *) out a. String -> a -> CmdParserF f out a
CmdParserSynopsis String
s ()
addCmdHelp :: PP.Doc -> CmdParser f out ()
addCmdHelp :: forall (f :: * -> *) out. Doc -> CmdParser f out ()
addCmdHelp Doc
s = CmdParserF f out () -> Free (CmdParserF f out) ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out () -> Free (CmdParserF f out) ())
-> CmdParserF f out () -> Free (CmdParserF f out) ()
forall a b. (a -> b) -> a -> b
$ Doc -> () -> CmdParserF f out ()
forall (f :: * -> *) out a. Doc -> a -> CmdParserF f out a
CmdParserHelp Doc
s ()
addCmdHelpStr :: String -> CmdParser f out ()
addCmdHelpStr :: forall (f :: * -> *) out. String -> CmdParser f out ()
addCmdHelpStr String
s = CmdParserF f out () -> Free (CmdParserF f out) ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out () -> Free (CmdParserF f out) ())
-> CmdParserF f out () -> Free (CmdParserF f out) ()
forall a b. (a -> b) -> a -> b
$ Doc -> () -> CmdParserF f out ()
forall (f :: * -> *) out a. Doc -> a -> CmdParserF f out a
CmdParserHelp (String -> Doc
PP.text String
s) ()
peekCmdDesc :: CmdParser f out (CommandDesc ())
peekCmdDesc :: forall (f :: * -> *) out. CmdParser f out (CommandDesc ())
peekCmdDesc = CmdParserF f out (CommandDesc ())
-> Free (CmdParserF f out) (CommandDesc ())
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out (CommandDesc ())
-> Free (CmdParserF f out) (CommandDesc ()))
-> CmdParserF f out (CommandDesc ())
-> Free (CmdParserF f out) (CommandDesc ())
forall a b. (a -> b) -> a -> b
$ (CommandDesc () -> CommandDesc ())
-> CmdParserF f out (CommandDesc ())
forall (f :: * -> *) out a.
(CommandDesc () -> a) -> CmdParserF f out a
CmdParserPeekDesc CommandDesc () -> CommandDesc ()
forall a. a -> a
id
peekInput :: CmdParser f out String
peekInput :: forall (f :: * -> *) out. CmdParser f out String
peekInput = CmdParserF f out String -> Free (CmdParserF f out) String
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out String -> Free (CmdParserF f out) String)
-> CmdParserF f out String -> Free (CmdParserF f out) String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> CmdParserF f out String
forall (f :: * -> *) out a. (String -> a) -> CmdParserF f out a
CmdParserPeekInput String -> String
forall a. a -> a
id
addCmdPart
:: (Applicative f, Typeable p)
=> PartDesc
-> (String -> Maybe (p, String))
-> CmdParser f out p
addCmdPart :: forall (f :: * -> *) p out.
(Applicative f, Typeable p) =>
PartDesc -> (String -> Maybe (p, String)) -> CmdParser f out p
addCmdPart PartDesc
p String -> Maybe (p, String)
f = CmdParserF f out p -> Free (CmdParserF f out) p
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out p -> Free (CmdParserF f out) p)
-> CmdParserF f out p -> Free (CmdParserF f out) p
forall a b. (a -> b) -> a -> b
$ PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> (p -> p)
-> CmdParserF f out p
forall (f :: * -> *) out a p.
Typeable p =>
PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> (p -> a)
-> CmdParserF f out a
CmdParserPart PartDesc
p String -> Maybe (p, String)
f (\p
_ -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) p -> p
forall a. a -> a
id
addCmdPartA
:: (Typeable p)
=> PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> CmdParser f out p
addCmdPartA :: forall p (f :: * -> *) out.
Typeable p =>
PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> CmdParser f out p
addCmdPartA PartDesc
p String -> Maybe (p, String)
f p -> f ()
a = CmdParserF f out p -> Free (CmdParserF f out) p
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out p -> Free (CmdParserF f out) p)
-> CmdParserF f out p -> Free (CmdParserF f out) p
forall a b. (a -> b) -> a -> b
$ PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> (p -> p)
-> CmdParserF f out p
forall (f :: * -> *) out a p.
Typeable p =>
PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> (p -> a)
-> CmdParserF f out a
CmdParserPart PartDesc
p String -> Maybe (p, String)
f p -> f ()
a p -> p
forall a. a -> a
id
addCmdPartMany
:: (Applicative f, Typeable p)
=> ManyUpperBound
-> PartDesc
-> (String -> Maybe (p, String))
-> CmdParser f out [p]
addCmdPartMany :: forall (f :: * -> *) p out.
(Applicative f, Typeable p) =>
ManyUpperBound
-> PartDesc -> (String -> Maybe (p, String)) -> CmdParser f out [p]
addCmdPartMany ManyUpperBound
b PartDesc
p String -> Maybe (p, String)
f = CmdParserF f out [p] -> Free (CmdParserF f out) [p]
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out [p] -> Free (CmdParserF f out) [p])
-> CmdParserF f out [p] -> Free (CmdParserF f out) [p]
forall a b. (a -> b) -> a -> b
$ ManyUpperBound
-> PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> ([p] -> [p])
-> CmdParserF f out [p]
forall (f :: * -> *) out a p.
Typeable p =>
ManyUpperBound
-> PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> ([p] -> a)
-> CmdParserF f out a
CmdParserPartMany ManyUpperBound
b PartDesc
p String -> Maybe (p, String)
f (\p
_ -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) [p] -> [p]
forall a. a -> a
id
addCmdPartManyA
:: (Typeable p)
=> ManyUpperBound
-> PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> CmdParser f out [p]
addCmdPartManyA :: forall p (f :: * -> *) out.
Typeable p =>
ManyUpperBound
-> PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> CmdParser f out [p]
addCmdPartManyA ManyUpperBound
b PartDesc
p String -> Maybe (p, String)
f p -> f ()
a = CmdParserF f out [p] -> Free (CmdParserF f out) [p]
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out [p] -> Free (CmdParserF f out) [p])
-> CmdParserF f out [p] -> Free (CmdParserF f out) [p]
forall a b. (a -> b) -> a -> b
$ ManyUpperBound
-> PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> ([p] -> [p])
-> CmdParserF f out [p]
forall (f :: * -> *) out a p.
Typeable p =>
ManyUpperBound
-> PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> ([p] -> a)
-> CmdParserF f out a
CmdParserPartMany ManyUpperBound
b PartDesc
p String -> Maybe (p, String)
f p -> f ()
a [p] -> [p]
forall a. a -> a
id
addCmdPartInp
:: (Applicative f, Typeable p)
=> PartDesc
-> (Input -> Maybe (p, Input))
-> CmdParser f out p
addCmdPartInp :: forall (f :: * -> *) p out.
(Applicative f, Typeable p) =>
PartDesc -> (Input -> Maybe (p, Input)) -> CmdParser f out p
addCmdPartInp PartDesc
p Input -> Maybe (p, Input)
f = CmdParserF f out p -> Free (CmdParserF f out) p
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out p -> Free (CmdParserF f out) p)
-> CmdParserF f out p -> Free (CmdParserF f out) p
forall a b. (a -> b) -> a -> b
$ PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> (p -> p)
-> CmdParserF f out p
forall (f :: * -> *) out a p.
Typeable p =>
PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> (p -> a)
-> CmdParserF f out a
CmdParserPartInp PartDesc
p Input -> Maybe (p, Input)
f (\p
_ -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) p -> p
forall a. a -> a
id
addCmdPartInpA
:: (Typeable p)
=> PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> CmdParser f out p
addCmdPartInpA :: forall p (f :: * -> *) out.
Typeable p =>
PartDesc
-> (Input -> Maybe (p, Input)) -> (p -> f ()) -> CmdParser f out p
addCmdPartInpA PartDesc
p Input -> Maybe (p, Input)
f p -> f ()
a = CmdParserF f out p -> Free (CmdParserF f out) p
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out p -> Free (CmdParserF f out) p)
-> CmdParserF f out p -> Free (CmdParserF f out) p
forall a b. (a -> b) -> a -> b
$ PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> (p -> p)
-> CmdParserF f out p
forall (f :: * -> *) out a p.
Typeable p =>
PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> (p -> a)
-> CmdParserF f out a
CmdParserPartInp PartDesc
p Input -> Maybe (p, Input)
f p -> f ()
a p -> p
forall a. a -> a
id
addCmdPartManyInp
:: (Applicative f, Typeable p)
=> ManyUpperBound
-> PartDesc
-> (Input -> Maybe (p, Input))
-> CmdParser f out [p]
addCmdPartManyInp :: forall (f :: * -> *) p out.
(Applicative f, Typeable p) =>
ManyUpperBound
-> PartDesc -> (Input -> Maybe (p, Input)) -> CmdParser f out [p]
addCmdPartManyInp ManyUpperBound
b PartDesc
p Input -> Maybe (p, Input)
f = CmdParserF f out [p] -> Free (CmdParserF f out) [p]
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out [p] -> Free (CmdParserF f out) [p])
-> CmdParserF f out [p] -> Free (CmdParserF f out) [p]
forall a b. (a -> b) -> a -> b
$ ManyUpperBound
-> PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> ([p] -> [p])
-> CmdParserF f out [p]
forall (f :: * -> *) out a p.
Typeable p =>
ManyUpperBound
-> PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> ([p] -> a)
-> CmdParserF f out a
CmdParserPartManyInp ManyUpperBound
b PartDesc
p Input -> Maybe (p, Input)
f (\p
_ -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) [p] -> [p]
forall a. a -> a
id
addCmdPartManyInpA
:: (Typeable p)
=> ManyUpperBound
-> PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> CmdParser f out [p]
addCmdPartManyInpA :: forall p (f :: * -> *) out.
Typeable p =>
ManyUpperBound
-> PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> CmdParser f out [p]
addCmdPartManyInpA ManyUpperBound
b PartDesc
p Input -> Maybe (p, Input)
f p -> f ()
a = CmdParserF f out [p] -> Free (CmdParserF f out) [p]
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out [p] -> Free (CmdParserF f out) [p])
-> CmdParserF f out [p] -> Free (CmdParserF f out) [p]
forall a b. (a -> b) -> a -> b
$ ManyUpperBound
-> PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> ([p] -> [p])
-> CmdParserF f out [p]
forall (f :: * -> *) out a p.
Typeable p =>
ManyUpperBound
-> PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> ([p] -> a)
-> CmdParserF f out a
CmdParserPartManyInp ManyUpperBound
b PartDesc
p Input -> Maybe (p, Input)
f p -> f ()
a [p] -> [p]
forall a. a -> a
id
addCmd
:: Applicative f
=> String
-> CmdParser f out ()
-> CmdParser f out ()
addCmd :: forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
addCmd String
str CmdParser f out ()
sub = CmdParserF f out () -> CmdParser f out ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out () -> CmdParser f out ())
-> CmdParserF f out () -> CmdParser f out ()
forall a b. (a -> b) -> a -> b
$ Maybe String
-> Visibility
-> CmdParser f out ()
-> f ()
-> ()
-> CmdParserF f out ()
forall (f :: * -> *) out a.
Maybe String
-> Visibility
-> CmdParser f out ()
-> f ()
-> a
-> CmdParserF f out a
CmdParserChild (String -> Maybe String
forall a. a -> Maybe a
Just String
str) Visibility
Visible CmdParser f out ()
sub (() -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ()
addCmdHidden
:: Applicative f
=> String
-> CmdParser f out ()
-> CmdParser f out ()
addCmdHidden :: forall (f :: * -> *) out.
Applicative f =>
String -> CmdParser f out () -> CmdParser f out ()
addCmdHidden String
str CmdParser f out ()
sub =
CmdParserF f out () -> CmdParser f out ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out () -> CmdParser f out ())
-> CmdParserF f out () -> CmdParser f out ()
forall a b. (a -> b) -> a -> b
$ Maybe String
-> Visibility
-> CmdParser f out ()
-> f ()
-> ()
-> CmdParserF f out ()
forall (f :: * -> *) out a.
Maybe String
-> Visibility
-> CmdParser f out ()
-> f ()
-> a
-> CmdParserF f out a
CmdParserChild (String -> Maybe String
forall a. a -> Maybe a
Just String
str) Visibility
Hidden CmdParser f out ()
sub (() -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ()
addAlternatives
:: Typeable p
=> [(String, String -> Bool, CmdParser f out p)]
-> CmdParser f out p
addAlternatives :: forall p (f :: * -> *) out.
Typeable p =>
[(String, String -> Bool, CmdParser f out p)] -> CmdParser f out p
addAlternatives [(String, String -> Bool, CmdParser f out p)]
elems = CmdParserF f out p -> CmdParser f out p
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out p -> CmdParser f out p)
-> CmdParserF f out p -> CmdParser f out p
forall a b. (a -> b) -> a -> b
$ PartDesc
-> [(String -> Bool, CmdParser f out p)]
-> (p -> p)
-> CmdParserF f out p
forall (f :: * -> *) out a p.
Typeable p =>
PartDesc
-> [(String -> Bool, CmdParser f out p)]
-> (p -> a)
-> CmdParserF f out a
CmdParserAlternatives PartDesc
desc [(String -> Bool, CmdParser f out p)]
alts p -> p
forall a. a -> a
id
where
desc :: PartDesc
desc = [PartDesc] -> PartDesc
PartAlts ([PartDesc] -> PartDesc) -> [PartDesc] -> PartDesc
forall a b. (a -> b) -> a -> b
$ [String -> PartDesc
PartVariable String
s | (String
s, String -> Bool
_, CmdParser f out p
_) <- [(String, String -> Bool, CmdParser f out p)]
elems]
alts :: [(String -> Bool, CmdParser f out p)]
alts = [(String -> Bool
a, CmdParser f out p
b) | (String
_, String -> Bool
a, CmdParser f out p
b) <- [(String, String -> Bool, CmdParser f out p)]
elems]
varPartDesc :: String -> PartDesc
varPartDesc :: String -> PartDesc
varPartDesc = String -> PartDesc
PartVariable
addNullCmd :: Applicative f => CmdParser f out () -> CmdParser f out ()
addNullCmd :: forall (f :: * -> *) out.
Applicative f =>
CmdParser f out () -> CmdParser f out ()
addNullCmd CmdParser f out ()
sub = CmdParserF f out () -> CmdParser f out ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out () -> CmdParser f out ())
-> CmdParserF f out () -> CmdParser f out ()
forall a b. (a -> b) -> a -> b
$ Maybe String
-> Visibility
-> CmdParser f out ()
-> f ()
-> ()
-> CmdParserF f out ()
forall (f :: * -> *) out a.
Maybe String
-> Visibility
-> CmdParser f out ()
-> f ()
-> a
-> CmdParserF f out a
CmdParserChild Maybe String
forall a. Maybe a
Nothing Visibility
Hidden CmdParser f out ()
sub (() -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ()
addCmdImpl :: out -> CmdParser f out ()
addCmdImpl :: forall out (f :: * -> *). out -> CmdParser f out ()
addCmdImpl out
o = CmdParserF f out () -> Free (CmdParserF f out) ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out () -> Free (CmdParserF f out) ())
-> CmdParserF f out () -> Free (CmdParserF f out) ()
forall a b. (a -> b) -> a -> b
$ out -> () -> CmdParserF f out ()
forall (f :: * -> *) out a. out -> a -> CmdParserF f out a
CmdParserImpl out
o ()
reorderStart :: CmdParser f out ()
reorderStart :: forall (f :: * -> *) out. CmdParser f out ()
reorderStart = CmdParserF f out () -> Free (CmdParserF f out) ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out () -> Free (CmdParserF f out) ())
-> CmdParserF f out () -> Free (CmdParserF f out) ()
forall a b. (a -> b) -> a -> b
$ () -> CmdParserF f out ()
forall (f :: * -> *) out a. a -> CmdParserF f out a
CmdParserReorderStart ()
reorderStop :: CmdParser f out ()
reorderStop :: forall (f :: * -> *) out. CmdParser f out ()
reorderStop = CmdParserF f out () -> Free (CmdParserF f out) ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (CmdParserF f out () -> Free (CmdParserF f out) ())
-> CmdParserF f out () -> Free (CmdParserF f out) ()
forall a b. (a -> b) -> a -> b
$ () -> CmdParserF f out ()
forall (f :: * -> *) out a. a -> CmdParserF f out a
CmdParserReorderStop ()
data PartGatherData f
= forall p . Typeable p => PartGatherData
{ forall (f :: * -> *). PartGatherData f -> Int
_pgd_id :: Int
, forall (f :: * -> *). PartGatherData f -> PartDesc
_pgd_desc :: PartDesc
, ()
_pgd_parseF :: Either (String -> Maybe (p, String))
(Input -> Maybe (p, Input))
, ()
_pgd_act :: p -> f ()
, forall (f :: * -> *). PartGatherData f -> Bool
_pgd_many :: Bool
}
data ChildGather f out =
ChildGather (Maybe String) Visibility (CmdParser f out ()) (f ())
type PartParsedData = Map Int [Dynamic]
data CmdDescStack = StackBottom (Deque PartDesc)
| StackLayer (Deque PartDesc) String CmdDescStack
deriving Int -> CmdDescStack -> String -> String
[CmdDescStack] -> String -> String
CmdDescStack -> String
(Int -> CmdDescStack -> String -> String)
-> (CmdDescStack -> String)
-> ([CmdDescStack] -> String -> String)
-> Show CmdDescStack
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CmdDescStack] -> String -> String
$cshowList :: [CmdDescStack] -> String -> String
show :: CmdDescStack -> String
$cshow :: CmdDescStack -> String
showsPrec :: Int -> CmdDescStack -> String -> String
$cshowsPrec :: Int -> CmdDescStack -> String -> String
Show
descStackAdd :: PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd :: PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd PartDesc
d = \case
StackBottom Deque PartDesc
l -> Deque PartDesc -> CmdDescStack
StackBottom (Deque PartDesc -> CmdDescStack) -> Deque PartDesc -> CmdDescStack
forall a b. (a -> b) -> a -> b
$ PartDesc -> Deque PartDesc -> Deque PartDesc
forall a. a -> Deque a -> Deque a
Deque.snoc PartDesc
d Deque PartDesc
l
StackLayer Deque PartDesc
l String
s CmdDescStack
u -> Deque PartDesc -> String -> CmdDescStack -> CmdDescStack
StackLayer (PartDesc -> Deque PartDesc -> Deque PartDesc
forall a. a -> Deque a -> Deque a
Deque.snoc PartDesc
d Deque PartDesc
l) String
s CmdDescStack
u
checkCmdParser
:: forall f out
. Maybe String
-> CmdParser f out ()
-> Either String (CommandDesc ())
checkCmdParser :: forall (f :: * -> *) out.
Maybe String
-> CmdParser f out () -> Either String (CommandDesc ())
checkCmdParser Maybe String
mTopLevel CmdParser f out ()
cmdParser =
(Either String (CommandDesc out, CmdDescStack)
-> ((CommandDesc out, CmdDescStack)
-> Either String (CommandDesc ()))
-> Either String (CommandDesc ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CommandDesc out, CmdDescStack) -> Either String (CommandDesc ())
final)
(Either String (CommandDesc out, CmdDescStack)
-> Either String (CommandDesc ()))
-> Either String (CommandDesc out, CmdDescStack)
-> Either String (CommandDesc ())
forall a b. (a -> b) -> a -> b
$ MultiRWST
'[] '[] '[] (Either String) (CommandDesc out, CmdDescStack)
-> Either String (CommandDesc out, CmdDescStack)
forall (m :: * -> *) a. Monad m => MultiRWST '[] '[] '[] m a -> m a
MultiRWSS.runMultiRWSTNil
(MultiRWST
'[] '[] '[] (Either String) (CommandDesc out, CmdDescStack)
-> Either String (CommandDesc out, CmdDescStack))
-> MultiRWST
'[] '[] '[] (Either String) (CommandDesc out, CmdDescStack)
-> Either String (CommandDesc out, CmdDescStack)
forall a b. (a -> b) -> a -> b
$ CmdDescStack
-> MultiRWST
'[] '[] '[CmdDescStack] (Either String) (CommandDesc out)
-> MultiRWST
'[] '[] '[] (Either String) (CommandDesc out, CmdDescStack)
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m (a, s)
MultiRWSS.withMultiStateAS (Deque PartDesc -> CmdDescStack
StackBottom Deque PartDesc
forall a. Monoid a => a
mempty)
(MultiRWST
'[] '[] '[CmdDescStack] (Either String) (CommandDesc out)
-> MultiRWST
'[] '[] '[] (Either String) (CommandDesc out, CmdDescStack))
-> MultiRWST
'[] '[] '[CmdDescStack] (Either String) (CommandDesc out)
-> MultiRWST
'[] '[] '[] (Either String) (CommandDesc out, CmdDescStack)
forall a b. (a -> b) -> a -> b
$ CommandDesc out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
-> MultiRWST
'[] '[] '[CmdDescStack] (Either String) (CommandDesc out)
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m s
MultiRWSS.withMultiStateS CommandDesc out
forall out. CommandDesc out
emptyCommandDesc
(MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
-> MultiRWST
'[] '[] '[CmdDescStack] (Either String) (CommandDesc out))
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
-> MultiRWST
'[] '[] '[CmdDescStack] (Either String) (CommandDesc out)
forall a b. (a -> b) -> a -> b
$ CmdParser f out ()
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain CmdParser f out ()
cmdParser
where
final :: (CommandDesc out, CmdDescStack) -> Either String (CommandDesc ())
final :: (CommandDesc out, CmdDescStack) -> Either String (CommandDesc ())
final (CommandDesc out
desc, CmdDescStack
stack) = case CmdDescStack
stack of
StackBottom Deque PartDesc
descs ->
CommandDesc () -> Either String (CommandDesc ())
forall a b. b -> Either a b
Right
(CommandDesc () -> Either String (CommandDesc ()))
-> CommandDesc () -> Either String (CommandDesc ())
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe String, CommandDesc ())
-> CommandDesc () -> CommandDesc ()
forall a.
Maybe (Maybe String, CommandDesc a)
-> CommandDesc a -> CommandDesc a
descFixParentsWithTopM
(Maybe String
mTopLevel Maybe String
-> (String -> (Maybe String, CommandDesc ()))
-> Maybe (Maybe String, CommandDesc ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \String
n -> (String -> Maybe String
forall a. a -> Maybe a
Just String
n, CommandDesc ()
forall out. CommandDesc out
emptyCommandDesc))
(CommandDesc () -> CommandDesc ())
-> CommandDesc () -> CommandDesc ()
forall a b. (a -> b) -> a -> b
$ ()
() -> CommandDesc out -> CommandDesc ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CommandDesc out
desc { _cmd_parts :: [PartDesc]
_cmd_parts = Deque PartDesc -> [PartDesc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Deque PartDesc
descs }
StackLayer Deque PartDesc
_ String
_ CmdDescStack
_ -> String -> Either String (CommandDesc ())
forall a b. a -> Either a b
Left String
"unclosed ReorderStart or GroupStart"
processMain
:: CmdParser f out a
-> MultiRWSS.MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
a
processMain :: forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain = \case
Pure a
x -> a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
Free (CmdParserHelp Doc
h CmdParser f out a
next) -> do
CommandDesc out
cmd :: CommandDesc out <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
(CommandDesc out)
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CommandDesc out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CommandDesc out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> CommandDesc out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ CommandDesc out
cmd { _cmd_help :: Maybe Doc
_cmd_help = Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
h }
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain CmdParser f out a
next
Free (CmdParserSynopsis String
s CmdParser f out a
next) -> do
CommandDesc out
cmd :: CommandDesc out <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
(CommandDesc out)
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CommandDesc out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet
(CommandDesc out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> CommandDesc out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ CommandDesc out
cmd { _cmd_synopsis :: Maybe Doc
_cmd_synopsis = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
PP.fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
PP.text ([String] -> [Doc]) -> [String] -> [Doc]
forall a b. (a -> b) -> a -> b
$ String -> [String]
List.words String
s }
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain CmdParser f out a
next
Free (CmdParserPeekDesc CommandDesc () -> CmdParser f out a
nextF) -> do
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain (CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a)
-> CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a b. (a -> b) -> a -> b
$ CommandDesc () -> CmdParser f out a
nextF CommandDesc ()
forall a. a
monadMisuseError
Free (CmdParserPeekInput String -> CmdParser f out a
nextF) -> do
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain (CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a)
-> CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a b. (a -> b) -> a -> b
$ String -> CmdParser f out a
nextF String
forall a. a
monadMisuseError
Free (CmdParserPart PartDesc
desc String -> Maybe (p, String)
_parseF p -> f ()
_act p -> CmdParser f out a
nextF) -> do
do
CmdDescStack
descStack <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd PartDesc
desc CmdDescStack
descStack
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain (CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a)
-> CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a b. (a -> b) -> a -> b
$ p -> CmdParser f out a
nextF p
forall a. a
monadMisuseError
Free (CmdParserPartInp PartDesc
desc Input -> Maybe (p, Input)
_parseF p -> f ()
_act p -> CmdParser f out a
nextF) -> do
do
CmdDescStack
descStack <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd PartDesc
desc CmdDescStack
descStack
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain (CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a)
-> CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a b. (a -> b) -> a -> b
$ p -> CmdParser f out a
nextF p
forall a. a
monadMisuseError
Free (CmdParserPartMany ManyUpperBound
bound PartDesc
desc String -> Maybe (p, String)
_parseF p -> f ()
_act [p] -> CmdParser f out a
nextF) -> do
do
CmdDescStack
descStack <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd (ManyUpperBound -> PartDesc -> PartDesc
wrapBoundDesc ManyUpperBound
bound PartDesc
desc) CmdDescStack
descStack
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain (CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a)
-> CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a b. (a -> b) -> a -> b
$ [p] -> CmdParser f out a
nextF [p]
forall a. a
monadMisuseError
Free (CmdParserPartManyInp ManyUpperBound
bound PartDesc
desc Input -> Maybe (p, Input)
_parseF p -> f ()
_act [p] -> CmdParser f out a
nextF) -> do
do
CmdDescStack
descStack <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd (ManyUpperBound -> PartDesc -> PartDesc
wrapBoundDesc ManyUpperBound
bound PartDesc
desc) CmdDescStack
descStack
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain (CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a)
-> CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a b. (a -> b) -> a -> b
$ [p] -> CmdParser f out a
nextF [p]
forall a. a
monadMisuseError
Free (CmdParserChild Maybe String
cmdStr Visibility
vis CmdParser f out ()
sub f ()
_act CmdParser f out a
next) -> do
Maybe (CommandDesc out)
mInitialDesc <- Maybe String
-> MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
(Maybe (CommandDesc out))
forall out (m :: * -> *).
MonadMultiState (CommandDesc out) m =>
Maybe String -> m (Maybe (CommandDesc out))
takeCommandChild Maybe String
cmdStr
CommandDesc out
cmd :: CommandDesc out <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
(CommandDesc out)
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CommandDesc out
subCmd <- do
CmdDescStack
stackCur :: CmdDescStack <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CommandDesc out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CommandDesc out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> CommandDesc out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ CommandDesc out -> Maybe (CommandDesc out) -> CommandDesc out
forall a. a -> Maybe a -> a
Maybe.fromMaybe (CommandDesc out
forall out. CommandDesc out
emptyCommandDesc :: CommandDesc out) Maybe (CommandDesc out)
mInitialDesc
CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ Deque PartDesc -> CmdDescStack
StackBottom Deque PartDesc
forall a. Monoid a => a
mempty
CmdParser f out ()
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain CmdParser f out ()
sub
CommandDesc out
c <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
(CommandDesc out)
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack
stackBelow <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CommandDesc out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet CommandDesc out
cmd
CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet CmdDescStack
stackCur
[PartDesc]
subParts <- case CmdDescStack
stackBelow of
StackBottom Deque PartDesc
descs -> [PartDesc]
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) [PartDesc]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PartDesc]
-> MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
[PartDesc])
-> [PartDesc]
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) [PartDesc]
forall a b. (a -> b) -> a -> b
$ Deque PartDesc -> [PartDesc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Deque PartDesc
descs
StackLayer Deque PartDesc
_ String
_ CmdDescStack
_ -> Either String [PartDesc]
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) [PartDesc]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String [PartDesc]
-> MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
[PartDesc])
-> Either String [PartDesc]
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) [PartDesc]
forall a b. (a -> b) -> a -> b
$ String -> Either String [PartDesc]
forall a b. a -> Either a b
Left String
"unclosed ReorderStart or GroupStart"
CommandDesc out
-> MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
(CommandDesc out)
forall (m :: * -> *) a. Monad m => a -> m a
return CommandDesc out
c { _cmd_parts :: [PartDesc]
_cmd_parts = [PartDesc]
subParts, _cmd_visibility :: Visibility
_cmd_visibility = Visibility
vis }
CommandDesc out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CommandDesc out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> CommandDesc out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ CommandDesc out
cmd
{ _cmd_children :: Deque (Maybe String, CommandDesc out)
_cmd_children = (Maybe String
cmdStr, CommandDesc out
subCmd) (Maybe String, CommandDesc out)
-> Deque (Maybe String, CommandDesc out)
-> Deque (Maybe String, CommandDesc out)
forall a. a -> Deque a -> Deque a
`Deque.snoc` CommandDesc out -> Deque (Maybe String, CommandDesc out)
forall out.
CommandDesc out -> Deque (Maybe String, CommandDesc out)
_cmd_children CommandDesc out
cmd
}
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain CmdParser f out a
next
Free (CmdParserImpl out
out CmdParser f out a
next) -> do
(Maybe out -> Identity (Maybe out))
-> CommandDesc out -> Identity (CommandDesc out)
forall out. Lens' (CommandDesc out) (Maybe out)
cmd_out ((Maybe out -> Identity (Maybe out))
-> CommandDesc out -> Identity (CommandDesc out))
-> Maybe out
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall s (m :: * -> *) a b.
MonadMultiState s m =>
ASetter s s a b -> b -> m ()
.=+ out -> Maybe out
forall a. a -> Maybe a
Just out
out
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain (CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a)
-> CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a b. (a -> b) -> a -> b
$ CmdParser f out a
next
Free (CmdParserGrouped String
groupName CmdParser f out a
next) -> do
CmdDescStack
stackCur <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ Deque PartDesc -> String -> CmdDescStack -> CmdDescStack
StackLayer Deque PartDesc
forall a. Monoid a => a
mempty String
groupName CmdDescStack
stackCur
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain (CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a)
-> CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a b. (a -> b) -> a -> b
$ CmdParser f out a
next
Free (CmdParserGroupEnd CmdParser f out a
next) -> do
CmdDescStack
stackCur <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
case CmdDescStack
stackCur of
StackBottom{} -> do
Either String a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a)
-> Either String a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"butcher interface error: group end without group start"
StackLayer Deque PartDesc
_descs String
"" CmdDescStack
_up -> do
Either String a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a)
-> Either String a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"GroupEnd found, but expected ReorderStop first"
StackLayer Deque PartDesc
descs String
groupName CmdDescStack
up -> do
CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd
(String -> PartDesc -> PartDesc
PartRedirect String
groupName ([PartDesc] -> PartDesc
PartSeq (Deque PartDesc -> [PartDesc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Deque PartDesc
descs)))
CmdDescStack
up
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain (CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a)
-> CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a b. (a -> b) -> a -> b
$ CmdParser f out a
next
Free (CmdParserReorderStop CmdParser f out a
next) -> do
CmdDescStack
stackCur <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
case CmdDescStack
stackCur of
StackBottom{} -> Either String ()
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String ()
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> Either String ()
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"ReorderStop without reorderStart"
StackLayer Deque PartDesc
descs String
"" CmdDescStack
up -> do
CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd ([PartDesc] -> PartDesc
PartReorder (Deque PartDesc -> [PartDesc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Deque PartDesc
descs)) CmdDescStack
up
StackLayer{} ->
Either String ()
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String ()
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> Either String ()
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"Found ReorderStop, but need GroupEnd first"
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain CmdParser f out a
next
Free (CmdParserReorderStart CmdParser f out a
next) -> do
CmdDescStack
stackCur <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ())
-> CmdDescStack
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall a b. (a -> b) -> a -> b
$ Deque PartDesc -> String -> CmdDescStack -> CmdDescStack
StackLayer Deque PartDesc
forall a. Monoid a => a
mempty String
"" CmdDescStack
stackCur
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain CmdParser f out a
next
Free (CmdParserAlternatives PartDesc
desc [(String -> Bool, CmdParser f out p)]
alts p -> CmdParser f out a
nextF) -> do
(CmdDescStack -> CmdDescStack)
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify (PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd PartDesc
desc)
HList '[CommandDesc out, CmdDescStack]
states <- MultiRWST
'[]
'[]
'[CommandDesc out, CmdDescStack]
(Either String)
(HList '[CommandDesc out, CmdDescStack])
forall (m :: * -> *) (r :: [*]) (w :: [*]) (s :: [*]).
Monad m =>
MultiRWST r w s m (HList s)
MultiRWSS.mGetRawS
let go
:: [(String -> Bool, CmdParser f out p)]
-> MultiRWSS.MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) p
go :: forall p.
[(String -> Bool, CmdParser f out p)]
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) p
go [] = Either String p
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) p
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String p
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) p)
-> Either String p
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) p
forall a b. (a -> b) -> a -> b
$ String -> Either String p
forall a b. a -> Either a b
Left (String -> Either String p) -> String -> Either String p
forall a b. (a -> b) -> a -> b
$ String
"Empty alternatives"
go [(String -> Bool
_, CmdParser f out p
alt)] = CmdParser f out p
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) p
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain CmdParser f out p
alt
go ((String -> Bool
_, CmdParser f out p
alt1):[(String -> Bool, CmdParser f out p)]
altr) = do
case MultiRWST
'[]
'[]
'[]
(Either String)
(p, HList '[CommandDesc out, CmdDescStack])
-> Either String (p, HList '[CommandDesc out, CmdDescStack])
forall (m :: * -> *) a. Monad m => MultiRWST '[] '[] '[] m a -> m a
MultiRWSS.runMultiRWSTNil (MultiRWST
'[]
'[]
'[]
(Either String)
(p, HList '[CommandDesc out, CmdDescStack])
-> Either String (p, HList '[CommandDesc out, CmdDescStack]))
-> MultiRWST
'[]
'[]
'[]
(Either String)
(p, HList '[CommandDesc out, CmdDescStack])
-> Either String (p, HList '[CommandDesc out, CmdDescStack])
forall a b. (a -> b) -> a -> b
$ HList '[CommandDesc out, CmdDescStack]
-> MultiRWST
'[]
'[]
(Append '[CommandDesc out, CmdDescStack] '[])
(Either String)
p
-> MultiRWST
'[]
'[]
'[]
(Either String)
(p, HList '[CommandDesc out, CmdDescStack])
forall (m :: * -> *) (s1 :: [*]) (r :: [*]) (w :: [*]) (s2 :: [*])
a.
Monad m =>
HList s1
-> MultiRWST r w (Append s1 s2) m a
-> MultiRWST r w s2 m (a, HList s1)
MultiRWSS.withMultiStates HList '[CommandDesc out, CmdDescStack]
states (CmdParser f out p
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) p
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain CmdParser f out p
alt1) of
Left{} -> [(String -> Bool, CmdParser f out p)]
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) p
forall p.
[(String -> Bool, CmdParser f out p)]
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) p
go [(String -> Bool, CmdParser f out p)]
altr
Right (p
p, HList '[CommandDesc out, CmdDescStack]
states') -> HList '[CommandDesc out, CmdDescStack]
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
forall (m :: * -> *) (s :: [*]) (r :: [*]) (w :: [*]).
Monad m =>
HList s -> MultiRWST r w s m ()
MultiRWSS.mPutRawS HList '[CommandDesc out, CmdDescStack]
states' MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) ()
-> p
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) p
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> p
p
p
p <- [(String -> Bool, CmdParser f out p)]
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) p
forall p.
[(String -> Bool, CmdParser f out p)]
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) p
go [(String -> Bool, CmdParser f out p)]
alts
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a.
CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
processMain (CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a)
-> CmdParser f out a
-> MultiRWST
'[] '[] '[CommandDesc out, CmdDescStack] (Either String) a
forall a b. (a -> b) -> a -> b
$ p -> CmdParser f out a
nextF p
p
monadMisuseError :: a
monadMisuseError :: forall a. a
monadMisuseError =
String -> a
forall a. HasCallStack => String -> a
error
(String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"CmdParser definition error -"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" used Monad powers where only Applicative/Arrow is allowed"
newtype PastCommandInput = PastCommandInput Input
runCmdParser
:: Maybe String
-> Input
-> CmdParser Identity out ()
-> (CommandDesc (), Either ParsingError (CommandDesc out))
runCmdParser :: forall out.
Maybe String
-> Input
-> CmdParser Identity out ()
-> (CommandDesc (), Either ParsingError (CommandDesc out))
runCmdParser Maybe String
mTopLevel Input
inputInitial CmdParser Identity out ()
cmdParser =
Identity (CommandDesc (), Either ParsingError (CommandDesc out))
-> (CommandDesc (), Either ParsingError (CommandDesc out))
forall a. Identity a -> a
runIdentity (Identity (CommandDesc (), Either ParsingError (CommandDesc out))
-> (CommandDesc (), Either ParsingError (CommandDesc out)))
-> Identity (CommandDesc (), Either ParsingError (CommandDesc out))
-> (CommandDesc (), Either ParsingError (CommandDesc out))
forall a b. (a -> b) -> a -> b
$ Maybe String
-> Input
-> CmdParser Identity out ()
-> Identity (CommandDesc (), Either ParsingError (CommandDesc out))
forall (f :: * -> *) out.
Applicative f =>
Maybe String
-> Input
-> CmdParser f out ()
-> f (CommandDesc (), Either ParsingError (CommandDesc out))
runCmdParserA Maybe String
mTopLevel Input
inputInitial CmdParser Identity out ()
cmdParser
runCmdParserExt
:: Maybe String
-> Input
-> CmdParser Identity out ()
-> (CommandDesc (), Input, Either ParsingError (CommandDesc out))
runCmdParserExt :: forall out.
Maybe String
-> Input
-> CmdParser Identity out ()
-> (CommandDesc (), Input, Either ParsingError (CommandDesc out))
runCmdParserExt Maybe String
mTopLevel Input
inputInitial CmdParser Identity out ()
cmdParser =
Identity
(CommandDesc (), Input, Either ParsingError (CommandDesc out))
-> (CommandDesc (), Input, Either ParsingError (CommandDesc out))
forall a. Identity a -> a
runIdentity (Identity
(CommandDesc (), Input, Either ParsingError (CommandDesc out))
-> (CommandDesc (), Input, Either ParsingError (CommandDesc out)))
-> Identity
(CommandDesc (), Input, Either ParsingError (CommandDesc out))
-> (CommandDesc (), Input, Either ParsingError (CommandDesc out))
forall a b. (a -> b) -> a -> b
$ Maybe String
-> Input
-> CmdParser Identity out ()
-> Identity
(CommandDesc (), Input, Either ParsingError (CommandDesc out))
forall (f :: * -> *) out.
Applicative f =>
Maybe String
-> Input
-> CmdParser f out ()
-> f (CommandDesc (), Input, Either ParsingError (CommandDesc out))
runCmdParserAExt Maybe String
mTopLevel Input
inputInitial CmdParser Identity out ()
cmdParser
runCmdParserA
:: forall f out
. Applicative f
=> Maybe String
-> Input
-> CmdParser f out ()
-> f (CommandDesc (), Either ParsingError (CommandDesc out))
runCmdParserA :: forall (f :: * -> *) out.
Applicative f =>
Maybe String
-> Input
-> CmdParser f out ()
-> f (CommandDesc (), Either ParsingError (CommandDesc out))
runCmdParserA Maybe String
mTopLevel Input
inputInitial CmdParser f out ()
cmdParser =
(\(CommandDesc ()
x, Input
_, Either ParsingError (CommandDesc out)
z) -> (CommandDesc ()
x, Either ParsingError (CommandDesc out)
z)) ((CommandDesc (), Input, Either ParsingError (CommandDesc out))
-> (CommandDesc (), Either ParsingError (CommandDesc out)))
-> f (CommandDesc (), Input, Either ParsingError (CommandDesc out))
-> f (CommandDesc (), Either ParsingError (CommandDesc out))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> Input
-> CmdParser f out ()
-> f (CommandDesc (), Input, Either ParsingError (CommandDesc out))
forall (f :: * -> *) out.
Applicative f =>
Maybe String
-> Input
-> CmdParser f out ()
-> f (CommandDesc (), Input, Either ParsingError (CommandDesc out))
runCmdParserAExt Maybe String
mTopLevel Input
inputInitial CmdParser f out ()
cmdParser
runCmdParserAExt
:: forall f out
. Applicative f
=> Maybe String
-> Input
-> CmdParser f out ()
-> f
( CommandDesc ()
, Input
, Either ParsingError (CommandDesc out)
)
runCmdParserAExt :: forall (f :: * -> *) out.
Applicative f =>
Maybe String
-> Input
-> CmdParser f out ()
-> f (CommandDesc (), Input, Either ParsingError (CommandDesc out))
runCmdParserAExt Maybe String
mTopLevel Input
inputInitial CmdParser f out ()
cmdParser =
Identity
(f (CommandDesc (), Input, Either ParsingError (CommandDesc out)))
-> f (CommandDesc (), Input, Either ParsingError (CommandDesc out))
forall a. Identity a -> a
runIdentity
(Identity
(f (CommandDesc (), Input, Either ParsingError (CommandDesc out)))
-> f (CommandDesc (), Input,
Either ParsingError (CommandDesc out)))
-> Identity
(f (CommandDesc (), Input, Either ParsingError (CommandDesc out)))
-> f (CommandDesc (), Input, Either ParsingError (CommandDesc out))
forall a b. (a -> b) -> a -> b
$ MultiRWST
'[]
'[]
'[]
Identity
(f (CommandDesc (), Input, Either ParsingError (CommandDesc out)))
-> Identity
(f (CommandDesc (), Input, Either ParsingError (CommandDesc out)))
forall (m :: * -> *) a. Monad m => MultiRWST '[] '[] '[] m a -> m a
MultiRWSS.runMultiRWSTNil
(MultiRWST
'[]
'[]
'[]
Identity
(f (CommandDesc (), Input, Either ParsingError (CommandDesc out)))
-> Identity
(f (CommandDesc (), Input, Either ParsingError (CommandDesc out))))
-> MultiRWST
'[]
'[]
'[]
Identity
(f (CommandDesc (), Input, Either ParsingError (CommandDesc out)))
-> Identity
(f (CommandDesc (), Input, Either ParsingError (CommandDesc out)))
forall a b. (a -> b) -> a -> b
$ (MultiRWST
'[]
'[]
'[]
Identity
([String],
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ())))))
-> (([String],
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ())))))
-> f (CommandDesc (), Input,
Either ParsingError (CommandDesc out)))
-> MultiRWST
'[]
'[]
'[]
Identity
(f (CommandDesc (), Input, Either ParsingError (CommandDesc out)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([String],
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ())))))
-> f (CommandDesc (), Input, Either ParsingError (CommandDesc out))
captureFinal)
(MultiRWST
'[]
'[]
'[]
Identity
([String],
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ())))))
-> MultiRWST
'[]
'[]
'[]
Identity
(f (CommandDesc (), Input, Either ParsingError (CommandDesc out))))
-> MultiRWST
'[]
'[]
'[]
Identity
([String],
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ())))))
-> MultiRWST
'[]
'[]
'[]
Identity
(f (CommandDesc (), Input, Either ParsingError (CommandDesc out)))
forall a b. (a -> b) -> a -> b
$ MultiRWST
'[]
'[[String]]
'[]
Identity
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ()))))
-> MultiRWST
'[]
'[]
'[]
Identity
([String],
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ())))))
forall w (m :: * -> *) (r :: [*]) (ws :: [*]) (s :: [*]) a.
(Monoid w, Monad m) =>
MultiRWST r (w : ws) s m a -> MultiRWST r ws s m (w, a)
MultiRWSS.withMultiWriterWA
(MultiRWST
'[]
'[[String]]
'[]
Identity
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ()))))
-> MultiRWST
'[]
'[]
'[]
Identity
([String],
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ()))))))
-> MultiRWST
'[]
'[[String]]
'[]
Identity
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ()))))
-> MultiRWST
'[]
'[]
'[]
Identity
([String],
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ())))))
forall a b. (a -> b) -> a -> b
$ CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CmdParser f out ()]
Identity
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ()))))
-> MultiRWST
'[]
'[[String]]
'[]
Identity
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ()))))
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m a
MultiRWSS.withMultiStateA CmdParser f out ()
cmdParser
(MultiRWST
'[]
'[[String]]
'[CmdParser f out ()]
Identity
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ()))))
-> MultiRWST
'[]
'[[String]]
'[]
Identity
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ())))))
-> MultiRWST
'[]
'[[String]]
'[CmdParser f out ()]
Identity
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ()))))
-> MultiRWST
'[]
'[[String]]
'[]
Identity
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ()))))
forall a b. (a -> b) -> a -> b
$ CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CmdDescStack, CmdParser f out ()]
Identity
(Input, (PastCommandInput, (CommandDesc out, f ())))
-> MultiRWST
'[]
'[[String]]
'[CmdParser f out ()]
Identity
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ()))))
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m (s, a)
MultiRWSS.withMultiStateSA (Deque PartDesc -> CmdDescStack
StackBottom Deque PartDesc
forall a. Monoid a => a
mempty)
(MultiRWST
'[]
'[[String]]
'[CmdDescStack, CmdParser f out ()]
Identity
(Input, (PastCommandInput, (CommandDesc out, f ())))
-> MultiRWST
'[]
'[[String]]
'[CmdParser f out ()]
Identity
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ())))))
-> MultiRWST
'[]
'[[String]]
'[CmdDescStack, CmdParser f out ()]
Identity
(Input, (PastCommandInput, (CommandDesc out, f ())))
-> MultiRWST
'[]
'[[String]]
'[CmdParser f out ()]
Identity
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ()))))
forall a b. (a -> b) -> a -> b
$ Input
-> MultiRWST
'[]
'[[String]]
'[Input, CmdDescStack, CmdParser f out ()]
Identity
(PastCommandInput, (CommandDesc out, f ()))
-> MultiRWST
'[]
'[[String]]
'[CmdDescStack, CmdParser f out ()]
Identity
(Input, (PastCommandInput, (CommandDesc out, f ())))
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m (s, a)
MultiRWSS.withMultiStateSA Input
inputInitial
(MultiRWST
'[]
'[[String]]
'[Input, CmdDescStack, CmdParser f out ()]
Identity
(PastCommandInput, (CommandDesc out, f ()))
-> MultiRWST
'[]
'[[String]]
'[CmdDescStack, CmdParser f out ()]
Identity
(Input, (PastCommandInput, (CommandDesc out, f ()))))
-> MultiRWST
'[]
'[[String]]
'[Input, CmdDescStack, CmdParser f out ()]
Identity
(PastCommandInput, (CommandDesc out, f ()))
-> MultiRWST
'[]
'[[String]]
'[CmdDescStack, CmdParser f out ()]
Identity
(Input, (PastCommandInput, (CommandDesc out, f ())))
forall a b. (a -> b) -> a -> b
$ PastCommandInput
-> MultiRWST
'[]
'[[String]]
'[PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CommandDesc out, f ())
-> MultiRWST
'[]
'[[String]]
'[Input, CmdDescStack, CmdParser f out ()]
Identity
(PastCommandInput, (CommandDesc out, f ()))
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m (s, a)
MultiRWSS.withMultiStateSA (Input -> PastCommandInput
PastCommandInput Input
inputInitial)
(MultiRWST
'[]
'[[String]]
'[PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CommandDesc out, f ())
-> MultiRWST
'[]
'[[String]]
'[Input, CmdDescStack, CmdParser f out ()]
Identity
(PastCommandInput, (CommandDesc out, f ())))
-> MultiRWST
'[]
'[[String]]
'[PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CommandDesc out, f ())
-> MultiRWST
'[]
'[[String]]
'[Input, CmdDescStack, CmdParser f out ()]
Identity
(PastCommandInput, (CommandDesc out, f ()))
forall a b. (a -> b) -> a -> b
$ CommandDesc out
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
-> MultiRWST
'[]
'[[String]]
'[PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CommandDesc out, f ())
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m (s, a)
MultiRWSS.withMultiStateSA CommandDesc out
initialCommandDesc
(MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
-> MultiRWST
'[]
'[[String]]
'[PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CommandDesc out, f ()))
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
-> MultiRWST
'[]
'[[String]]
'[PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CommandDesc out, f ())
forall a b. (a -> b) -> a -> b
$ CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain CmdParser f out ()
cmdParser
where
initialCommandDesc :: CommandDesc out
initialCommandDesc = CommandDesc out
forall out. CommandDesc out
emptyCommandDesc
{ _cmd_mParent :: Maybe (Maybe String, CommandDesc out)
_cmd_mParent = Maybe String
mTopLevel Maybe String
-> (String -> (Maybe String, CommandDesc out))
-> Maybe (Maybe String, CommandDesc out)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \String
n -> (String -> Maybe String
forall a. a -> Maybe a
Just String
n, CommandDesc out
forall out. CommandDesc out
emptyCommandDesc)
}
captureFinal
:: ( [String]
, (CmdDescStack, (Input, (PastCommandInput, (CommandDesc out, f ()))))
)
-> f (CommandDesc (), Input, Either ParsingError (CommandDesc out))
captureFinal :: ([String],
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ())))))
-> f (CommandDesc (), Input, Either ParsingError (CommandDesc out))
captureFinal ([String],
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ())))))
tuple1 = f ()
act f ()
-> (CommandDesc (), Input, Either ParsingError (CommandDesc out))
-> f (CommandDesc (), Input, Either ParsingError (CommandDesc out))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (() () -> CommandDesc out -> CommandDesc ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CommandDesc out
cmd', Input
pastCmdInput, Either ParsingError (CommandDesc out)
res)
where
([String]
errs , (CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ()))))
tuple2) = ([String],
(CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ())))))
tuple1
(CmdDescStack
descStack , (Input, (PastCommandInput, (CommandDesc out, f ())))
tuple3) = (CmdDescStack,
(Input, (PastCommandInput, (CommandDesc out, f ()))))
tuple2
(Input
inputRest , (PastCommandInput, (CommandDesc out, f ()))
tuple4) = (Input, (PastCommandInput, (CommandDesc out, f ())))
tuple3
(PastCommandInput Input
pastCmdInput, (CommandDesc out, f ())
tuple5) = (PastCommandInput, (CommandDesc out, f ()))
tuple4
(CommandDesc out
cmd , f ()
act ) = (CommandDesc out, f ())
tuple5
errs' :: [String]
errs' = [String]
errs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
inputErrs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
stackErrs
inputErrs :: [String]
inputErrs = case Input
inputRest of
InputString String
s | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
Char.isSpace String
s -> []
InputString{} -> [String
"could not parse input/unprocessed input"]
InputArgs [] -> []
InputArgs{} -> [String
"could not parse input/unprocessed input"]
stackErrs :: [String]
stackErrs = case CmdDescStack
descStack of
StackBottom{} -> []
CmdDescStack
_ -> [String
"butcher interface error: unclosed group"]
cmd' :: CommandDesc out
cmd' = CmdDescStack -> CommandDesc out -> CommandDesc out
postProcessCmd CmdDescStack
descStack CommandDesc out
cmd
res :: Either ParsingError (CommandDesc out)
res =
if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs' then CommandDesc out -> Either ParsingError (CommandDesc out)
forall a b. b -> Either a b
Right CommandDesc out
cmd' else ParsingError -> Either ParsingError (CommandDesc out)
forall a b. a -> Either a b
Left (ParsingError -> Either ParsingError (CommandDesc out))
-> ParsingError -> Either ParsingError (CommandDesc out)
forall a b. (a -> b) -> a -> b
$ [String] -> Input -> ParsingError
ParsingError [String]
errs' Input
inputRest
processMain
::
CmdParser f out ()
-> MultiRWSS.MultiRWS
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack, CmdParser
f
out
()]
(f ())
processMain :: CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain = \case
Pure () -> f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall (m :: * -> *) a. Monad m => a -> m a
return (f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Free (CmdParserHelp Doc
h CmdParser f out ()
next) -> do
CommandDesc out
cmd :: CommandDesc out <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(CommandDesc out)
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CommandDesc out
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CommandDesc out
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> CommandDesc out
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ CommandDesc out
cmd { _cmd_help :: Maybe Doc
_cmd_help = Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
h }
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain CmdParser f out ()
next
Free (CmdParserSynopsis String
s CmdParser f out ()
next) -> do
CommandDesc out
cmd :: CommandDesc out <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(CommandDesc out)
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CommandDesc out
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet
(CommandDesc out
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> CommandDesc out
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ CommandDesc out
cmd { _cmd_synopsis :: Maybe Doc
_cmd_synopsis = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
PP.fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
PP.text ([String] -> [Doc]) -> [String] -> [Doc]
forall a b. (a -> b) -> a -> b
$ String -> [String]
List.words String
s }
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain CmdParser f out ()
next
Free (CmdParserPeekDesc CommandDesc () -> CmdParser f out ()
nextF) -> do
CmdParser f out ()
parser :: CmdParser f out () <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(CmdParser f out ())
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CommandDesc out
cmdCur :: CommandDesc out <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(CommandDesc out)
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
let (CommandDesc out
cmd :: CommandDesc out, CmdDescStack
stack) =
Identity (CommandDesc out, CmdDescStack)
-> (CommandDesc out, CmdDescStack)
forall a. Identity a -> a
runIdentity
(Identity (CommandDesc out, CmdDescStack)
-> (CommandDesc out, CmdDescStack))
-> Identity (CommandDesc out, CmdDescStack)
-> (CommandDesc out, CmdDescStack)
forall a b. (a -> b) -> a -> b
$ MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
-> Identity (CommandDesc out, CmdDescStack)
forall (m :: * -> *) a. Monad m => MultiRWST '[] '[] '[] m a -> m a
MultiRWSS.runMultiRWSTNil
(MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
-> Identity (CommandDesc out, CmdDescStack))
-> MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
-> Identity (CommandDesc out, CmdDescStack)
forall a b. (a -> b) -> a -> b
$ CommandDesc out
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
-> MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m (s, a)
MultiRWSS.withMultiStateSA CommandDesc out
forall out. CommandDesc out
emptyCommandDesc
{ _cmd_mParent :: Maybe (Maybe String, CommandDesc out)
_cmd_mParent = CommandDesc out -> Maybe (Maybe String, CommandDesc out)
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc out
cmdCur
}
(MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
-> MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack))
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
-> MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
forall a b. (a -> b) -> a -> b
$ CmdDescStack
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m s
MultiRWSS.withMultiStateS (Deque PartDesc -> CmdDescStack
StackBottom Deque PartDesc
forall a. Monoid a => a
mempty)
(MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack)
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
forall a b. (a -> b) -> a -> b
$ (CmdParserF
f
out
(MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ())
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ())
-> CmdParser f out ()
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
(f (m a) -> m a) -> Free f a -> m a
iterM CmdParserF
f
out
(MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ())
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
forall (m :: * -> *) a.
(MonadMultiState (CommandDesc out) m,
MonadMultiState CmdDescStack m) =>
CmdParserF f out (m a) -> m a
processCmdShallow
(CmdParser f out ()
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ())
-> CmdParser f out ()
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
forall a b. (a -> b) -> a -> b
$ CmdParser f out ()
parser
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ CommandDesc () -> CmdParser f out ()
nextF (CommandDesc () -> CmdParser f out ())
-> CommandDesc () -> CmdParser f out ()
forall a b. (a -> b) -> a -> b
$ () () -> CommandDesc out -> CommandDesc ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CmdDescStack -> CommandDesc out -> CommandDesc out
postProcessCmd CmdDescStack
stack CommandDesc out
cmd
Free (CmdParserPeekInput String -> CmdParser f out ()
nextF) -> do
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ String -> CmdParser f out ()
nextF (String -> CmdParser f out ()) -> String -> CmdParser f out ()
forall a b. (a -> b) -> a -> b
$ Input -> String
inputToString Input
inputInitial
Free (CmdParserPart PartDesc
desc String -> Maybe (p, String)
parseF p -> f ()
actF p -> CmdParser f out ()
nextF) -> do
do
CmdDescStack
descStack <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd PartDesc
desc CmdDescStack
descStack
Input
input <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
Input
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
case Input
input of
InputString String
str -> case String -> Maybe (p, String)
parseF String
str of
Just (p
x, String
rest) -> do
Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ String -> Input
InputString String
rest
f ()
actRest <- CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ p -> CmdParser f out ()
nextF p
x
f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall (m :: * -> *) a. Monad m => a -> m a
return (f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ p -> f ()
actF p
x f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
actRest
Maybe (p, String)
Nothing -> do
[String]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [String
"could not parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PartDesc -> String
getPartSeqDescPositionName PartDesc
desc]
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ p -> CmdParser f out ()
nextF p
forall a. a
monadMisuseError
InputArgs (String
str:[String]
strr) -> case String -> Maybe (p, String)
parseF String
str of
Just (p
x, String
"") -> do
Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ [String] -> Input
InputArgs [String]
strr
f ()
actRest <- CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ p -> CmdParser f out ()
nextF p
x
f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall (m :: * -> *) a. Monad m => a -> m a
return (f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ p -> f ()
actF p
x f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
actRest
Just (p
x, String
rest) | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
rest -> do
f ()
actRest <- CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ p -> CmdParser f out ()
nextF p
x
f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall (m :: * -> *) a. Monad m => a -> m a
return (f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ p -> f ()
actF p
x f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
actRest
Maybe (p, String)
_ -> do
[String]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [String
"could not parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PartDesc -> String
getPartSeqDescPositionName PartDesc
desc]
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ p -> CmdParser f out ()
nextF p
forall a. a
monadMisuseError
InputArgs [] -> do
[String]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [String
"could not parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PartDesc -> String
getPartSeqDescPositionName PartDesc
desc]
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ p -> CmdParser f out ()
nextF p
forall a. a
monadMisuseError
Free (CmdParserPartInp PartDesc
desc Input -> Maybe (p, Input)
parseF p -> f ()
actF p -> CmdParser f out ()
nextF) -> do
do
CmdDescStack
descStack <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd PartDesc
desc CmdDescStack
descStack
Input
input <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
Input
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
case Input -> Maybe (p, Input)
parseF Input
input of
Just (p
x, Input
rest) -> do
Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ Input
rest
f ()
actRest <- CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ p -> CmdParser f out ()
nextF p
x
f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall (m :: * -> *) a. Monad m => a -> m a
return (f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ p -> f ()
actF p
x f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
actRest
Maybe (p, Input)
Nothing -> do
[String]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [String
"could not parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PartDesc -> String
getPartSeqDescPositionName PartDesc
desc]
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ p -> CmdParser f out ()
nextF p
forall a. a
monadMisuseError
Free (CmdParserPartMany ManyUpperBound
bound PartDesc
desc String -> Maybe (p, String)
parseF p -> f ()
actF [p] -> CmdParser f out ()
nextF) -> do
do
CmdDescStack
descStack <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd (ManyUpperBound -> PartDesc -> PartDesc
wrapBoundDesc ManyUpperBound
bound PartDesc
desc) CmdDescStack
descStack
let proc :: MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
proc = do
MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall (m :: * -> *). MonadMultiState Input m => m ()
dropSpaces
Input
input <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
Input
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
case Input
input of
InputString String
str -> case String -> Maybe (p, String)
parseF String
str of
Just (p
x, String
r) -> do
Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ String -> Input
InputString String
r
[p]
xr <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
proc
[p]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
forall (m :: * -> *) a. Monad m => a -> m a
return ([p]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p])
-> [p]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
forall a b. (a -> b) -> a -> b
$ p
x p -> [p] -> [p]
forall a. a -> [a] -> [a]
: [p]
xr
Maybe (p, String)
Nothing -> [p]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
forall (m :: * -> *) a. Monad m => a -> m a
return []
InputArgs (String
str:[String]
strr) -> case String -> Maybe (p, String)
parseF String
str of
Just (p
x, String
"") -> do
Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ [String] -> Input
InputArgs [String]
strr
[p]
xr <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
proc
[p]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
forall (m :: * -> *) a. Monad m => a -> m a
return ([p]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p])
-> [p]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
forall a b. (a -> b) -> a -> b
$ p
x p -> [p] -> [p]
forall a. a -> [a] -> [a]
: [p]
xr
Maybe (p, String)
_ -> [p]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
forall (m :: * -> *) a. Monad m => a -> m a
return []
InputArgs [] -> [p]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[p]
r <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
proc
let act :: f [()]
act = (p -> f ()) -> [p] -> f [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse p -> f ()
actF [p]
r
(f [()]
act f [()] -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>) (f () -> f ())
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain ([p] -> CmdParser f out ()
nextF ([p] -> CmdParser f out ()) -> [p] -> CmdParser f out ()
forall a b. (a -> b) -> a -> b
$ [p]
r)
Free (CmdParserPartManyInp ManyUpperBound
bound PartDesc
desc Input -> Maybe (p, Input)
parseF p -> f ()
actF [p] -> CmdParser f out ()
nextF) -> do
do
CmdDescStack
descStack <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd (ManyUpperBound -> PartDesc -> PartDesc
wrapBoundDesc ManyUpperBound
bound PartDesc
desc) CmdDescStack
descStack
let proc :: MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
proc = do
MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall (m :: * -> *). MonadMultiState Input m => m ()
dropSpaces
Input
input <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
Input
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
case Input -> Maybe (p, Input)
parseF Input
input of
Just (p
x, Input
r) -> do
Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ Input
r
[p]
xr <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
proc
[p]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
forall (m :: * -> *) a. Monad m => a -> m a
return ([p]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p])
-> [p]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
forall a b. (a -> b) -> a -> b
$ p
x p -> [p] -> [p]
forall a. a -> [a] -> [a]
: [p]
xr
Maybe (p, Input)
Nothing -> [p]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[p]
r <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[p]
proc
let act :: f [()]
act = (p -> f ()) -> [p] -> f [()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse p -> f ()
actF [p]
r
(f [()]
act f [()] -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>) (f () -> f ())
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain ([p] -> CmdParser f out ()
nextF ([p] -> CmdParser f out ()) -> [p] -> CmdParser f out ()
forall a b. (a -> b) -> a -> b
$ [p]
r)
f :: CmdParser f out ()
f@(Free (CmdParserChild Maybe String
_ Visibility
_ CmdParser f out ()
_ f ()
_ CmdParser f out ()
_)) -> do
MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall (m :: * -> *). MonadMultiState Input m => m ()
dropSpaces
Input
input <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
Input
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
([ChildGather f out]
gatheredChildren :: [ChildGather f out], CmdParser f out ()
restCmdParser) <-
MultiRWST
'[]
'[[ChildGather f out], [String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(CmdParser f out ())
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
([ChildGather f out], CmdParser f out ())
forall w (m :: * -> *) (r :: [*]) (ws :: [*]) (s :: [*]) a.
(Monoid w, Monad m) =>
MultiRWST r (w : ws) s m a -> MultiRWST r ws s m (w, a)
MultiRWSS.withMultiWriterWA (MultiRWST
'[]
'[[ChildGather f out], [String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(CmdParser f out ())
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
([ChildGather f out], CmdParser f out ()))
-> MultiRWST
'[]
'[[ChildGather f out], [String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(CmdParser f out ())
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
([ChildGather f out], CmdParser f out ())
forall a b. (a -> b) -> a -> b
$ CmdParser f out ()
-> MultiRWST
'[]
'[[ChildGather f out], [String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(CmdParser f out ())
forall (m :: * -> *) a.
(MonadMultiWriter [ChildGather f out] m,
MonadMultiState (CmdParser f out ()) m,
MonadMultiState (CommandDesc out) m) =>
CmdParser f out a -> m (CmdParser f out a)
childrenGather CmdParser f out ()
f
let
child_fold
:: ( Deque (Maybe String)
, Map (Maybe String) (Visibility, CmdParser f out (), f ())
)
-> ChildGather f out
-> ( Deque (Maybe String)
, Map (Maybe String) (Visibility, CmdParser f out (), f ())
)
child_fold :: (Deque (Maybe String),
Map (Maybe String) (Visibility, CmdParser f out (), f ()))
-> ChildGather f out
-> (Deque (Maybe String),
Map (Maybe String) (Visibility, CmdParser f out (), f ()))
child_fold (Deque (Maybe String)
c_names, Map (Maybe String) (Visibility, CmdParser f out (), f ())
c_map) (ChildGather Maybe String
name Visibility
vis CmdParser f out ()
child f ()
act) =
case Maybe String
name Maybe String
-> Map (Maybe String) (Visibility, CmdParser f out (), f ())
-> Maybe (Visibility, CmdParser f out (), f ())
forall k a. Ord k => k -> Map k a -> Maybe a
`MapS.lookup` Map (Maybe String) (Visibility, CmdParser f out (), f ())
c_map of
Maybe (Visibility, CmdParser f out (), f ())
Nothing ->
( Maybe String -> Deque (Maybe String) -> Deque (Maybe String)
forall a. a -> Deque a -> Deque a
Deque.snoc Maybe String
name Deque (Maybe String)
c_names
, Maybe String
-> (Visibility, CmdParser f out (), f ())
-> Map (Maybe String) (Visibility, CmdParser f out (), f ())
-> Map (Maybe String) (Visibility, CmdParser f out (), f ())
forall k a. Ord k => k -> a -> Map k a -> Map k a
MapS.insert Maybe String
name (Visibility
vis, CmdParser f out ()
child, f ()
act) Map (Maybe String) (Visibility, CmdParser f out (), f ())
c_map
)
Just (Visibility
vis', CmdParser f out ()
child', f ()
act') ->
( Deque (Maybe String)
c_names
, Maybe String
-> (Visibility, CmdParser f out (), f ())
-> Map (Maybe String) (Visibility, CmdParser f out (), f ())
-> Map (Maybe String) (Visibility, CmdParser f out (), f ())
forall k a. Ord k => k -> a -> Map k a -> Map k a
MapS.insert Maybe String
name (Visibility
vis', CmdParser f out ()
child' CmdParser f out () -> CmdParser f out () -> CmdParser f out ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CmdParser f out ()
child, f ()
act') Map (Maybe String) (Visibility, CmdParser f out (), f ())
c_map
)
(Deque (Maybe String)
child_name_list, Map (Maybe String) (Visibility, CmdParser f out (), f ())
child_map) =
((Deque (Maybe String),
Map (Maybe String) (Visibility, CmdParser f out (), f ()))
-> ChildGather f out
-> (Deque (Maybe String),
Map (Maybe String) (Visibility, CmdParser f out (), f ())))
-> (Deque (Maybe String),
Map (Maybe String) (Visibility, CmdParser f out (), f ()))
-> [ChildGather f out]
-> (Deque (Maybe String),
Map (Maybe String) (Visibility, CmdParser f out (), f ()))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Deque (Maybe String),
Map (Maybe String) (Visibility, CmdParser f out (), f ()))
-> ChildGather f out
-> (Deque (Maybe String),
Map (Maybe String) (Visibility, CmdParser f out (), f ()))
child_fold (Deque (Maybe String)
forall a. Monoid a => a
mempty, Map (Maybe String) (Visibility, CmdParser f out (), f ())
forall k a. Map k a
MapS.empty) [ChildGather f out]
gatheredChildren
combined_child_list :: [(Maybe String, (Visibility, CmdParser f out (), f ()))]
combined_child_list =
Deque (Maybe String) -> [Maybe String]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Deque (Maybe String)
child_name_list [Maybe String]
-> (Maybe String
-> (Maybe String, (Visibility, CmdParser f out (), f ())))
-> [(Maybe String, (Visibility, CmdParser f out (), f ()))]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe String
n -> (Maybe String
n, Map (Maybe String) (Visibility, CmdParser f out (), f ())
child_map Map (Maybe String) (Visibility, CmdParser f out (), f ())
-> Maybe String -> (Visibility, CmdParser f out (), f ())
forall k a. Ord k => Map k a -> k -> a
MapS.! Maybe String
n)
let
mRest :: Maybe (Maybe String, Visibility, CmdParser f out (), f (), Input)
mRest = [Maybe (Maybe String, Visibility, CmdParser f out (), f (), Input)]
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input)]
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input))
-> [Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input)]
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input)
forall a b. (a -> b) -> a -> b
$ [(Maybe String, (Visibility, CmdParser f out (), f ()))]
combined_child_list [(Maybe String, (Visibility, CmdParser f out (), f ()))]
-> ((Maybe String, (Visibility, CmdParser f out (), f ()))
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input))
-> [Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Maybe String
mname, (Visibility
child, CmdParser f out ()
act, f ()
vis)) ->
case (Maybe String
mname, Input
input) of
(Just String
name, InputString String
str) | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
str ->
(Maybe String, Visibility, CmdParser f out (), f (), Input)
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input)
forall a. a -> Maybe a
Just ((Maybe String, Visibility, CmdParser f out (), f (), Input)
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input))
-> (Maybe String, Visibility, CmdParser f out (), f (), Input)
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input)
forall a b. (a -> b) -> a -> b
$ (String -> Maybe String
forall a. a -> Maybe a
Just String
name, Visibility
child, CmdParser f out ()
act, f ()
vis, String -> Input
InputString String
"")
(Just String
name, InputString String
str) | (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
str ->
(Maybe String, Visibility, CmdParser f out (), f (), Input)
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input)
forall a. a -> Maybe a
Just
((Maybe String, Visibility, CmdParser f out (), f (), Input)
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input))
-> (Maybe String, Visibility, CmdParser f out (), f (), Input)
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input)
forall a b. (a -> b) -> a -> b
$ ( String -> Maybe String
forall a. a -> Maybe a
Just String
name
, Visibility
child
, CmdParser f out ()
act
, f ()
vis
, String -> Input
InputString (String -> Input) -> String -> Input
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
name Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
str
)
(Just String
name, InputArgs (String
str:[String]
strr)) | String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
str ->
(Maybe String, Visibility, CmdParser f out (), f (), Input)
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input)
forall a. a -> Maybe a
Just ((Maybe String, Visibility, CmdParser f out (), f (), Input)
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input))
-> (Maybe String, Visibility, CmdParser f out (), f (), Input)
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input)
forall a b. (a -> b) -> a -> b
$ (String -> Maybe String
forall a. a -> Maybe a
Just String
name, Visibility
child, CmdParser f out ()
act, f ()
vis, [String] -> Input
InputArgs [String]
strr)
(Maybe String
Nothing, Input
_) -> (Maybe String, Visibility, CmdParser f out (), f (), Input)
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input)
forall a. a -> Maybe a
Just ((Maybe String, Visibility, CmdParser f out (), f (), Input)
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input))
-> (Maybe String, Visibility, CmdParser f out (), f (), Input)
-> Maybe
(Maybe String, Visibility, CmdParser f out (), f (), Input)
forall a b. (a -> b) -> a -> b
$ (Maybe String
forall a. Maybe a
Nothing, Visibility
child, CmdParser f out ()
act, f ()
vis, Input
input)
(Maybe String, Input)
_ -> Maybe (Maybe String, Visibility, CmdParser f out (), f (), Input)
forall a. Maybe a
Nothing
[(Maybe String, (Visibility, CmdParser f out (), f ()))]
combined_child_list [(Maybe String, (Visibility, CmdParser f out (), f ()))]
-> ((Maybe String, (Visibility, CmdParser f out (), f ()))
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` \(Maybe String
child_name, (Visibility
vis, CmdParser f out ()
child, f ()
_)) -> do
let CommandDesc out
initialDesc :: CommandDesc out = CommandDesc out
forall out. CommandDesc out
emptyCommandDesc
let (CommandDesc out
subCmd, CmdDescStack
subStack) =
Identity (CommandDesc out, CmdDescStack)
-> (CommandDesc out, CmdDescStack)
forall a. Identity a -> a
runIdentity
(Identity (CommandDesc out, CmdDescStack)
-> (CommandDesc out, CmdDescStack))
-> Identity (CommandDesc out, CmdDescStack)
-> (CommandDesc out, CmdDescStack)
forall a b. (a -> b) -> a -> b
$ MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
-> Identity (CommandDesc out, CmdDescStack)
forall (m :: * -> *) a. Monad m => MultiRWST '[] '[] '[] m a -> m a
MultiRWSS.runMultiRWSTNil
(MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
-> Identity (CommandDesc out, CmdDescStack))
-> MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
-> Identity (CommandDesc out, CmdDescStack)
forall a b. (a -> b) -> a -> b
$ CommandDesc out
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
-> MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m (s, a)
MultiRWSS.withMultiStateSA CommandDesc out
initialDesc
(MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
-> MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack))
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
-> MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
forall a b. (a -> b) -> a -> b
$ CmdDescStack
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m s
MultiRWSS.withMultiStateS (Deque PartDesc -> CmdDescStack
StackBottom Deque PartDesc
forall a. Monoid a => a
mempty)
(MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack)
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
forall a b. (a -> b) -> a -> b
$ (CmdParserF
f
out
(MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ())
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ())
-> CmdParser f out ()
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
(f (m a) -> m a) -> Free f a -> m a
iterM CmdParserF
f
out
(MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ())
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
forall (m :: * -> *) a.
(MonadMultiState (CommandDesc out) m,
MonadMultiState CmdDescStack m) =>
CmdParserF f out (m a) -> m a
processCmdShallow CmdParser f out ()
child
(Deque (Maybe String, CommandDesc out)
-> Identity (Deque (Maybe String, CommandDesc out)))
-> CommandDesc out -> Identity (CommandDesc out)
forall out.
Lens' (CommandDesc out) (Deque (Maybe String, CommandDesc out))
cmd_children ((Deque (Maybe String, CommandDesc out)
-> Identity (Deque (Maybe String, CommandDesc out)))
-> CommandDesc out -> Identity (CommandDesc out))
-> (Deque (Maybe String, CommandDesc out)
-> Deque (Maybe String, CommandDesc out))
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall s (m :: * -> *) a b.
MonadMultiState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=+ (Maybe String, CommandDesc out)
-> Deque (Maybe String, CommandDesc out)
-> Deque (Maybe String, CommandDesc out)
forall a. a -> Deque a -> Deque a
Deque.snoc
( Maybe String
child_name
, CmdDescStack -> CommandDesc out -> CommandDesc out
postProcessCmd CmdDescStack
subStack CommandDesc out
subCmd { _cmd_visibility :: Visibility
_cmd_visibility = Visibility
vis }
)
case Maybe (Maybe String, Visibility, CmdParser f out (), f (), Input)
mRest of
Maybe (Maybe String, Visibility, CmdParser f out (), f (), Input)
Nothing -> do
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ CmdParser f out ()
restCmdParser
Just (Maybe String
name, Visibility
vis, CmdParser f out ()
child, f ()
act, Input
rest) -> do
(CmdParserF
f
out
(MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
(f (m a) -> m a) -> Free f a -> m a
iterM CmdParserF
f
out
(MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall (m :: * -> *) a.
(MonadMultiState (CommandDesc out) m,
MonadMultiState CmdDescStack m) =>
CmdParserF f out (m a) -> m a
processCmdShallow CmdParser f out ()
f
CommandDesc out
cmd <- do
CommandDesc out
c :: CommandDesc out <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(CommandDesc out)
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack
prevStack :: CmdDescStack <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CommandDesc out
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(CommandDesc out)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandDesc out
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(CommandDesc out))
-> CommandDesc out
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(CommandDesc out)
forall a b. (a -> b) -> a -> b
$ CmdDescStack -> CommandDesc out -> CommandDesc out
postProcessCmd CmdDescStack
prevStack CommandDesc out
c
Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> Input
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ Input
rest
PastCommandInput
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (PastCommandInput
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> PastCommandInput
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ Input -> PastCommandInput
PastCommandInput Input
rest
CommandDesc out
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CommandDesc out
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> CommandDesc out
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ CommandDesc out
forall out. CommandDesc out
emptyCommandDesc { _cmd_mParent :: Maybe (Maybe String, CommandDesc out)
_cmd_mParent = (Maybe String, CommandDesc out)
-> Maybe (Maybe String, CommandDesc out)
forall a. a -> Maybe a
Just (Maybe String
name, CommandDesc out
cmd)
, _cmd_visibility :: Visibility
_cmd_visibility = Visibility
vis
}
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ CmdParser f out ()
child
CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ Deque PartDesc -> CmdDescStack
StackBottom Deque PartDesc
forall a. Monoid a => a
mempty
f ()
childAct <- CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain CmdParser f out ()
child
f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall (m :: * -> *) a. Monad m => a -> m a
return (f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ f ()
act f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
childAct
Free (CmdParserImpl out
out CmdParser f out ()
next) -> do
(Maybe out -> Identity (Maybe out))
-> CommandDesc out -> Identity (CommandDesc out)
forall out. Lens' (CommandDesc out) (Maybe out)
cmd_out ((Maybe out -> Identity (Maybe out))
-> CommandDesc out -> Identity (CommandDesc out))
-> Maybe out
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall s (m :: * -> *) a b.
MonadMultiState s m =>
ASetter s s a b -> b -> m ()
.=+ out -> Maybe out
forall a. a -> Maybe a
Just out
out
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ CmdParser f out ()
next
Free (CmdParserGrouped String
groupName CmdParser f out ()
next) -> do
CmdDescStack
stackCur <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ Deque PartDesc -> String -> CmdDescStack -> CmdDescStack
StackLayer Deque PartDesc
forall a. Monoid a => a
mempty String
groupName CmdDescStack
stackCur
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ CmdParser f out ()
next
Free (CmdParserGroupEnd CmdParser f out ()
next) -> do
CmdDescStack
stackCur <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
case CmdDescStack
stackCur of
StackBottom{} -> do
[String]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell ([String]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> [String]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ [String
"butcher interface error: group end without group start"]
f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall (m :: * -> *) a. Monad m => a -> m a
return (f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
StackLayer Deque PartDesc
descs String
groupName CmdDescStack
up -> do
CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd
(String -> PartDesc -> PartDesc
PartRedirect String
groupName ([PartDesc] -> PartDesc
PartSeq (Deque PartDesc -> [PartDesc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Deque PartDesc
descs)))
CmdDescStack
up
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ CmdParser f out ()
next
Free (CmdParserReorderStop CmdParser f out ()
next) -> do
[String]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell ([String]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> [String]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ [String
"butcher interface error: reorder stop without reorder start"]
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain CmdParser f out ()
next
Free (CmdParserReorderStart CmdParser f out ()
next) -> do
[PartGatherData f]
reorderData <-
Int
-> MultiRWST
'[]
'[[String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[PartGatherData f]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[PartGatherData f]
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m a
MultiRWSS.withMultiStateA (Int
1 :: Int)
(MultiRWST
'[]
'[[String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[PartGatherData f]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[PartGatherData f])
-> MultiRWST
'[]
'[[String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[PartGatherData f]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[PartGatherData f]
forall a b. (a -> b) -> a -> b
$ MultiRWST
'[]
'[[PartGatherData f], [String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
-> MultiRWST
'[]
'[[String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[PartGatherData f]
forall w (m :: * -> *) (r :: [*]) (ws :: [*]) (s :: [*]) a.
(Monoid w, Monad m) =>
MultiRWST r (w : ws) s m a -> MultiRWST r ws s m w
MultiRWSS.withMultiWriterW
(MultiRWST
'[]
'[[PartGatherData f], [String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
-> MultiRWST
'[]
'[[String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[PartGatherData f])
-> MultiRWST
'[]
'[[PartGatherData f], [String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
-> MultiRWST
'[]
'[[String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
[PartGatherData f]
forall a b. (a -> b) -> a -> b
$ (CmdParserF
f
out
(MultiRWST
'[]
'[[PartGatherData f], [String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> MultiRWST
'[]
'[[PartGatherData f], [String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> CmdParser f out ()
-> MultiRWST
'[]
'[[PartGatherData f], [String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
(f (m a) -> m a) -> Free f a -> m a
iterM CmdParserF
f
out
(MultiRWST
'[]
'[[PartGatherData f], [String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> MultiRWST
'[]
'[[PartGatherData f], [String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall (m :: * -> *).
(MonadMultiState Int m, MonadMultiWriter [PartGatherData f] m,
MonadMultiWriter [String] m) =>
CmdParserF f out (m ()) -> m ()
reorderPartGather
(CmdParser f out ()
-> MultiRWST
'[]
'[[PartGatherData f], [String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
())
-> CmdParser f out ()
-> MultiRWST
'[]
'[[PartGatherData f], [String]]
'[Int, CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ CmdParser f out ()
next
let
reorderMapInit :: Map Int (PartGatherData f)
reorderMapInit :: Map Int (PartGatherData f)
reorderMapInit = [(Int, PartGatherData f)] -> Map Int (PartGatherData f)
forall k a. Ord k => [(k, a)] -> Map k a
MapS.fromList ([(Int, PartGatherData f)] -> Map Int (PartGatherData f))
-> [(Int, PartGatherData f)] -> Map Int (PartGatherData f)
forall a b. (a -> b) -> a -> b
$ [PartGatherData f]
reorderData [PartGatherData f]
-> (PartGatherData f -> (Int, PartGatherData f))
-> [(Int, PartGatherData f)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \PartGatherData f
d -> (PartGatherData f -> Int
forall (f :: * -> *). PartGatherData f -> Int
_pgd_id PartGatherData f
d, PartGatherData f
d)
tryParsePartData
:: Input
-> PartGatherData f
-> First (Int, Dynamic, Input, Bool, f ())
tryParsePartData :: Input
-> PartGatherData f -> First (Int, Dynamic, Input, Bool, f ())
tryParsePartData Input
input (PartGatherData Int
pid PartDesc
_ Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
pfe p -> f ()
act Bool
allowMany) = Maybe (Int, Dynamic, Input, Bool, f ())
-> First (Int, Dynamic, Input, Bool, f ())
forall a. Maybe a -> First a
First
[ (Int
pid, p -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn p
r, Input
rest, Bool
allowMany, p -> f ()
act p
r)
| (p
r, Input
rest) <- case Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
pfe of
Left String -> Maybe (p, String)
pfStr -> case Input
input of
InputString String
str -> case String -> Maybe (p, String)
pfStr String
str of
Just (p
x, String
r) | String
r String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
str -> (p, Input) -> Maybe (p, Input)
forall a. a -> Maybe a
Just (p
x, String -> Input
InputString String
r)
Maybe (p, String)
_ -> Maybe (p, Input)
forall a. Maybe a
Nothing
InputArgs (String
str:[String]
strr) -> case String -> Maybe (p, String)
pfStr String
str of
Just (p
x, String
"") -> (p, Input) -> Maybe (p, Input)
forall a. a -> Maybe a
Just (p
x, [String] -> Input
InputArgs [String]
strr)
Maybe (p, String)
_ -> Maybe (p, Input)
forall a. Maybe a
Nothing
InputArgs [] -> Maybe (p, Input)
forall a. Maybe a
Nothing
Right Input -> Maybe (p, Input)
pfInp -> case Input -> Maybe (p, Input)
pfInp Input
input of
Just (p
x, Input
r) | Input
r Input -> Input -> Bool
forall a. Eq a => a -> a -> Bool
/= Input
input -> (p, Input) -> Maybe (p, Input)
forall a. a -> Maybe a
Just (p
x, Input
r)
Maybe (p, Input)
_ -> Maybe (p, Input)
forall a. Maybe a
Nothing
]
parseLoop :: MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(f ())
parseLoop = do
Input
input <- MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
Input
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
Map Int (PartGatherData f)
m :: Map Int (PartGatherData f) <- MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(Map Int (PartGatherData f))
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
case First (Int, Dynamic, Input, Bool, f ())
-> Maybe (Int, Dynamic, Input, Bool, f ())
forall a. First a -> Maybe a
getFirst (First (Int, Dynamic, Input, Bool, f ())
-> Maybe (Int, Dynamic, Input, Bool, f ()))
-> First (Int, Dynamic, Input, Bool, f ())
-> Maybe (Int, Dynamic, Input, Bool, f ())
forall a b. (a -> b) -> a -> b
$ (PartGatherData f -> First (Int, Dynamic, Input, Bool, f ()))
-> Map Int (PartGatherData f)
-> First (Int, Dynamic, Input, Bool, f ())
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Data.Foldable.foldMap (Input
-> PartGatherData f -> First (Int, Dynamic, Input, Bool, f ())
tryParsePartData Input
input) Map Int (PartGatherData f)
m of
Maybe (Int, Dynamic, Input, Bool, f ())
Nothing -> f ()
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(f ())
forall (m :: * -> *) a. Monad m => a -> m a
return (f ()
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(f ()))
-> f ()
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (Int
pid, Dynamic
x, Input
rest, Bool
more, f ()
act) -> do
Input
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet Input
rest
(PartParsedData -> PartParsedData)
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify ((PartParsedData -> PartParsedData)
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
())
-> (PartParsedData -> PartParsedData)
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ ([Dynamic] -> [Dynamic] -> [Dynamic])
-> Int -> [Dynamic] -> PartParsedData -> PartParsedData
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
MapS.insertWith [Dynamic] -> [Dynamic] -> [Dynamic]
forall a. [a] -> [a] -> [a]
(++) Int
pid [Dynamic
x]
Bool
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
()
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
more) (MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
()
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
())
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
()
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ do
Map Int (PartGatherData f)
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Map Int (PartGatherData f)
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
())
-> Map Int (PartGatherData f)
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ Int -> Map Int (PartGatherData f) -> Map Int (PartGatherData f)
forall k a. Ord k => k -> Map k a -> Map k a
MapS.delete Int
pid Map Int (PartGatherData f)
m
f ()
actRest <- MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(f ())
parseLoop
f ()
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(f ())
forall (m :: * -> *) a. Monad m => a -> m a
return (f ()
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(f ()))
-> f ()
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ f ()
act f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
actRest
(PartParsedData
finalMap, (CmdParser f out ()
fr, f ()
acts)) <-
PartParsedData
-> MultiRWST
'[]
'[[String]]
'[PartParsedData, CommandDesc out, PastCommandInput, Input,
CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out (), f ())
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(PartParsedData, (CmdParser f out (), f ()))
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m (s, a)
MultiRWSS.withMultiStateSA (PartParsedData
forall k a. Map k a
MapS.empty :: PartParsedData)
(MultiRWST
'[]
'[[String]]
'[PartParsedData, CommandDesc out, PastCommandInput, Input,
CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out (), f ())
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(PartParsedData, (CmdParser f out (), f ())))
-> MultiRWST
'[]
'[[String]]
'[PartParsedData, CommandDesc out, PastCommandInput, Input,
CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out (), f ())
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(PartParsedData, (CmdParser f out (), f ()))
forall a b. (a -> b) -> a -> b
$ Map Int (PartGatherData f)
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out (), f ())
-> MultiRWST
'[]
'[[String]]
'[PartParsedData, CommandDesc out, PastCommandInput, Input,
CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out (), f ())
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m a
MultiRWSS.withMultiStateA Map Int (PartGatherData f)
reorderMapInit
(MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out (), f ())
-> MultiRWST
'[]
'[[String]]
'[PartParsedData, CommandDesc out, PastCommandInput, Input,
CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out (), f ()))
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out (), f ())
-> MultiRWST
'[]
'[[String]]
'[PartParsedData, CommandDesc out, PastCommandInput, Input,
CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out (), f ())
forall a b. (a -> b) -> a -> b
$ do
f ()
acts <- MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(f ())
parseLoop
CmdDescStack
stackCur <- MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
())
-> CmdDescStack
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
()
forall a b. (a -> b) -> a -> b
$ Deque PartDesc -> String -> CmdDescStack -> CmdDescStack
StackLayer Deque PartDesc
forall a. Monoid a => a
mempty String
"" CmdDescStack
stackCur
CmdParser f out ()
fr <- Int
-> MultiRWST
'[]
'[[String]]
'[Int, Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out ())
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out ())
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m a
MultiRWSS.withMultiStateA (Int
1 :: Int) (MultiRWST
'[]
'[[String]]
'[Int, Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out ())
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out ()))
-> MultiRWST
'[]
'[[String]]
'[Int, Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out ())
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out ())
forall a b. (a -> b) -> a -> b
$ CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[Int, Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out ())
forall (m :: * -> *) (r :: [*]) (w :: [*]) (s :: [*])
(m0 :: * -> *) a.
(MonadMultiState Int m, MonadMultiState PartParsedData m,
MonadMultiState (Map Int (PartGatherData f)) m,
MonadMultiState Input m, MonadMultiState (CommandDesc out) m,
MonadMultiWriter [String] m, m ~ MultiRWST r w s m0,
ContainsType (CmdParser f out ()) s, ContainsType CmdDescStack s,
Monad m0) =>
CmdParser f out a -> m (CmdParser f out a)
processParsedParts CmdParser f out ()
next
(CmdParser f out (), f ())
-> MultiRWST
'[]
'[[String]]
'[Map Int (PartGatherData f), PartParsedData, CommandDesc out,
PastCommandInput, Input, CmdDescStack, CmdParser f out ()]
Identity
(CmdParser f out (), f ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CmdParser f out ()
fr, f ()
acts)
if PartParsedData -> Bool
forall k a. Map k a -> Bool
MapS.null PartParsedData
finalMap
then do
f ()
actRest <- CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain CmdParser f out ()
fr
f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall (m :: * -> *) a. Monad m => a -> m a
return (f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> f ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ f ()
acts f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
actRest
else MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a. a
monadMisuseError
Free (CmdParserAlternatives PartDesc
desc [(String -> Bool, CmdParser f out p)]
alts p -> CmdParser f out ()
nextF) -> do
Input
input :: Input <- MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
Input
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
case Input
input of
InputString String
str
| Just (String -> Bool
_, CmdParser f out p
sub) <- ((String -> Bool, CmdParser f out p) -> Bool)
-> [(String -> Bool, CmdParser f out p)]
-> Maybe (String -> Bool, CmdParser f out p)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(String -> Bool
predicate, CmdParser f out p
_sub) -> String -> Bool
predicate String
str) [(String -> Bool, CmdParser f out p)]
alts ->
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ CmdParser f out p
sub CmdParser f out p
-> (p -> CmdParser f out ()) -> CmdParser f out ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= p -> CmdParser f out ()
nextF
InputArgs (String
str:[String]
_)
| Just (String -> Bool
_, CmdParser f out p
sub) <- ((String -> Bool, CmdParser f out p) -> Bool)
-> [(String -> Bool, CmdParser f out p)]
-> Maybe (String -> Bool, CmdParser f out p)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(String -> Bool
predicate, CmdParser f out p
_sub) -> String -> Bool
predicate String
str) [(String -> Bool, CmdParser f out p)]
alts ->
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ CmdParser f out p
sub CmdParser f out p
-> (p -> CmdParser f out ()) -> CmdParser f out ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= p -> CmdParser f out ()
nextF
Input
_ -> do
[String]
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [String
"could not parse any of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PartDesc -> String
getPartSeqDescPositionName PartDesc
desc]
CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
processMain (CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ()))
-> CmdParser f out ()
-> MultiRWST
'[]
'[[String]]
'[CommandDesc out, PastCommandInput, Input, CmdDescStack,
CmdParser f out ()]
Identity
(f ())
forall a b. (a -> b) -> a -> b
$ p -> CmdParser f out ()
nextF p
forall a. a
monadMisuseError
reorderPartGather
:: ( MonadMultiState Int m
, MonadMultiWriter [PartGatherData f] m
, MonadMultiWriter [String] m
)
=> CmdParserF f out (m ())
-> m ()
reorderPartGather :: forall (m :: * -> *).
(MonadMultiState Int m, MonadMultiWriter [PartGatherData f] m,
MonadMultiWriter [String] m) =>
CmdParserF f out (m ()) -> m ()
reorderPartGather = \case
CmdParserPart PartDesc
desc String -> Maybe (p, String)
parseF p -> f ()
actF p -> m ()
nextF -> do
Int
pid <- m Int
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
Int -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
pid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
[PartGatherData f] -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [Int
-> PartDesc
-> Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
-> (p -> f ())
-> Bool
-> PartGatherData f
forall (f :: * -> *) p.
Typeable p =>
Int
-> PartDesc
-> Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
-> (p -> f ())
-> Bool
-> PartGatherData f
PartGatherData Int
pid PartDesc
desc ((String -> Maybe (p, String))
-> Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
forall a b. a -> Either a b
Left String -> Maybe (p, String)
parseF) p -> f ()
actF Bool
False]
p -> m ()
nextF (p -> m ()) -> p -> m ()
forall a b. (a -> b) -> a -> b
$ p
forall a. a
monadMisuseError
CmdParserPartInp PartDesc
desc Input -> Maybe (p, Input)
parseF p -> f ()
actF p -> m ()
nextF -> do
Int
pid <- m Int
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
Int -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
pid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
[PartGatherData f] -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [Int
-> PartDesc
-> Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
-> (p -> f ())
-> Bool
-> PartGatherData f
forall (f :: * -> *) p.
Typeable p =>
Int
-> PartDesc
-> Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
-> (p -> f ())
-> Bool
-> PartGatherData f
PartGatherData Int
pid PartDesc
desc ((Input -> Maybe (p, Input))
-> Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
forall a b. b -> Either a b
Right Input -> Maybe (p, Input)
parseF) p -> f ()
actF Bool
False]
p -> m ()
nextF (p -> m ()) -> p -> m ()
forall a b. (a -> b) -> a -> b
$ p
forall a. a
monadMisuseError
CmdParserPartMany ManyUpperBound
_ PartDesc
desc String -> Maybe (p, String)
parseF p -> f ()
actF [p] -> m ()
nextF -> do
Int
pid <- m Int
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
Int -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
pid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
[PartGatherData f] -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [Int
-> PartDesc
-> Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
-> (p -> f ())
-> Bool
-> PartGatherData f
forall (f :: * -> *) p.
Typeable p =>
Int
-> PartDesc
-> Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
-> (p -> f ())
-> Bool
-> PartGatherData f
PartGatherData Int
pid PartDesc
desc ((String -> Maybe (p, String))
-> Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
forall a b. a -> Either a b
Left String -> Maybe (p, String)
parseF) p -> f ()
actF Bool
True]
[p] -> m ()
nextF ([p] -> m ()) -> [p] -> m ()
forall a b. (a -> b) -> a -> b
$ [p]
forall a. a
monadMisuseError
CmdParserPartManyInp ManyUpperBound
_ PartDesc
desc Input -> Maybe (p, Input)
parseF p -> f ()
actF [p] -> m ()
nextF -> do
Int
pid <- m Int
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
Int -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
pid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
[PartGatherData f] -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [Int
-> PartDesc
-> Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
-> (p -> f ())
-> Bool
-> PartGatherData f
forall (f :: * -> *) p.
Typeable p =>
Int
-> PartDesc
-> Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
-> (p -> f ())
-> Bool
-> PartGatherData f
PartGatherData Int
pid PartDesc
desc ((Input -> Maybe (p, Input))
-> Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
forall a b. b -> Either a b
Right Input -> Maybe (p, Input)
parseF) p -> f ()
actF Bool
True]
[p] -> m ()
nextF ([p] -> m ()) -> [p] -> m ()
forall a b. (a -> b) -> a -> b
$ [p]
forall a. a
monadMisuseError
CmdParserReorderStop m ()
_next -> do
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
CmdParserHelp{} -> m ()
restCase
CmdParserSynopsis{} -> m ()
restCase
CmdParserPeekDesc{} -> m ()
restCase
CmdParserPeekInput{} -> m ()
restCase
CmdParserChild{} -> m ()
restCase
CmdParserImpl{} -> m ()
restCase
CmdParserReorderStart{} -> m ()
restCase
CmdParserGrouped{} -> m ()
restCase
CmdParserGroupEnd{} -> m ()
restCase
CmdParserAlternatives{} -> m ()
restCase
where
restCase :: m ()
restCase = do
[String] -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [String
"Did not find expected ReorderStop after the reordered parts"]
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
childrenGather
:: ( MonadMultiWriter [ChildGather f out] m
, MonadMultiState (CmdParser f out ()) m
, MonadMultiState (CommandDesc out) m
)
=> CmdParser f out a
-> m (CmdParser f out a)
childrenGather :: forall (m :: * -> *) a.
(MonadMultiWriter [ChildGather f out] m,
MonadMultiState (CmdParser f out ()) m,
MonadMultiState (CommandDesc out) m) =>
CmdParser f out a -> m (CmdParser f out a)
childrenGather = \case
Free (CmdParserChild Maybe String
cmdStr Visibility
vis CmdParser f out ()
sub f ()
act CmdParser f out a
next) -> do
[ChildGather f out] -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [Maybe String
-> Visibility -> CmdParser f out () -> f () -> ChildGather f out
forall (f :: * -> *) out.
Maybe String
-> Visibility -> CmdParser f out () -> f () -> ChildGather f out
ChildGather Maybe String
cmdStr Visibility
vis CmdParser f out ()
sub f ()
act]
CmdParser f out a -> m (CmdParser f out a)
forall (m :: * -> *) a.
(MonadMultiWriter [ChildGather f out] m,
MonadMultiState (CmdParser f out ()) m,
MonadMultiState (CommandDesc out) m) =>
CmdParser f out a -> m (CmdParser f out a)
childrenGather CmdParser f out a
next
Free (CmdParserPeekInput String -> CmdParser f out a
nextF) -> do
CmdParser f out a -> m (CmdParser f out a)
forall (m :: * -> *) a.
(MonadMultiWriter [ChildGather f out] m,
MonadMultiState (CmdParser f out ()) m,
MonadMultiState (CommandDesc out) m) =>
CmdParser f out a -> m (CmdParser f out a)
childrenGather (CmdParser f out a -> m (CmdParser f out a))
-> CmdParser f out a -> m (CmdParser f out a)
forall a b. (a -> b) -> a -> b
$ String -> CmdParser f out a
nextF (String -> CmdParser f out a) -> String -> CmdParser f out a
forall a b. (a -> b) -> a -> b
$ Input -> String
inputToString Input
inputInitial
Free (CmdParserPeekDesc CommandDesc () -> CmdParser f out a
nextF) -> do
CmdParser f out ()
parser :: CmdParser f out () <- m (CmdParser f out ())
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CommandDesc out
cmdCur :: CommandDesc out <- m (CommandDesc out)
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
let (CommandDesc out
cmd :: CommandDesc out, CmdDescStack
stack) =
Identity (CommandDesc out, CmdDescStack)
-> (CommandDesc out, CmdDescStack)
forall a. Identity a -> a
runIdentity
(Identity (CommandDesc out, CmdDescStack)
-> (CommandDesc out, CmdDescStack))
-> Identity (CommandDesc out, CmdDescStack)
-> (CommandDesc out, CmdDescStack)
forall a b. (a -> b) -> a -> b
$ MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
-> Identity (CommandDesc out, CmdDescStack)
forall (m :: * -> *) a. Monad m => MultiRWST '[] '[] '[] m a -> m a
MultiRWSS.runMultiRWSTNil
(MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
-> Identity (CommandDesc out, CmdDescStack))
-> MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
-> Identity (CommandDesc out, CmdDescStack)
forall a b. (a -> b) -> a -> b
$ CommandDesc out
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
-> MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m (s, a)
MultiRWSS.withMultiStateSA CommandDesc out
forall out. CommandDesc out
emptyCommandDesc
{ _cmd_mParent :: Maybe (Maybe String, CommandDesc out)
_cmd_mParent = CommandDesc out -> Maybe (Maybe String, CommandDesc out)
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc out
cmdCur
}
(MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
-> MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack))
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
-> MultiRWST '[] '[] '[] Identity (CommandDesc out, CmdDescStack)
forall a b. (a -> b) -> a -> b
$ CmdDescStack
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m s
MultiRWSS.withMultiStateS (Deque PartDesc -> CmdDescStack
StackBottom Deque PartDesc
forall a. Monoid a => a
mempty)
(MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack)
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
-> MultiRWST '[] '[] '[CommandDesc out] Identity CmdDescStack
forall a b. (a -> b) -> a -> b
$ (CmdParserF
f
out
(MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ())
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ())
-> CmdParser f out ()
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
(f (m a) -> m a) -> Free f a -> m a
iterM CmdParserF
f
out
(MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ())
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
forall (m :: * -> *) a.
(MonadMultiState (CommandDesc out) m,
MonadMultiState CmdDescStack m) =>
CmdParserF f out (m a) -> m a
processCmdShallow
(CmdParser f out ()
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ())
-> CmdParser f out ()
-> MultiRWST '[] '[] '[CmdDescStack, CommandDesc out] Identity ()
forall a b. (a -> b) -> a -> b
$ CmdParser f out ()
parser
CmdParser f out a -> m (CmdParser f out a)
forall (m :: * -> *) a.
(MonadMultiWriter [ChildGather f out] m,
MonadMultiState (CmdParser f out ()) m,
MonadMultiState (CommandDesc out) m) =>
CmdParser f out a -> m (CmdParser f out a)
childrenGather (CmdParser f out a -> m (CmdParser f out a))
-> CmdParser f out a -> m (CmdParser f out a)
forall a b. (a -> b) -> a -> b
$ CommandDesc () -> CmdParser f out a
nextF (CommandDesc () -> CmdParser f out a)
-> CommandDesc () -> CmdParser f out a
forall a b. (a -> b) -> a -> b
$ () () -> CommandDesc out -> CommandDesc ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ CmdDescStack -> CommandDesc out -> CommandDesc out
postProcessCmd CmdDescStack
stack CommandDesc out
cmd
CmdParser f out a
something -> CmdParser f out a -> m (CmdParser f out a)
forall (m :: * -> *) a. Monad m => a -> m a
return CmdParser f out a
something
processParsedParts
:: forall m r w s m0 a
. ( MonadMultiState Int m
, MonadMultiState PartParsedData m
, MonadMultiState (Map Int (PartGatherData f)) m
, MonadMultiState Input m
, MonadMultiState (CommandDesc out) m
, MonadMultiWriter [[Char]] m
, m ~ MultiRWSS.MultiRWST r w s m0
, ContainsType (CmdParser f out ()) s
, ContainsType CmdDescStack s
, Monad m0
)
=> CmdParser f out a
-> m (CmdParser f out a)
processParsedParts :: forall (m :: * -> *) (r :: [*]) (w :: [*]) (s :: [*])
(m0 :: * -> *) a.
(MonadMultiState Int m, MonadMultiState PartParsedData m,
MonadMultiState (Map Int (PartGatherData f)) m,
MonadMultiState Input m, MonadMultiState (CommandDesc out) m,
MonadMultiWriter [String] m, m ~ MultiRWST r w s m0,
ContainsType (CmdParser f out ()) s, ContainsType CmdDescStack s,
Monad m0) =>
CmdParser f out a -> m (CmdParser f out a)
processParsedParts = \case
Free (CmdParserPart PartDesc
desc String -> Maybe (p, String)
_ p -> f ()
_ (p -> CmdParser f out a
nextF :: p -> CmdParser f out a)) ->
PartDesc -> (p -> CmdParser f out a) -> m (CmdParser f out a)
forall p.
Typeable p =>
PartDesc -> (p -> CmdParser f out a) -> m (CmdParser f out a)
part PartDesc
desc p -> CmdParser f out a
nextF
Free (CmdParserPartInp PartDesc
desc Input -> Maybe (p, Input)
_ p -> f ()
_ (p -> CmdParser f out a
nextF :: p -> CmdParser f out a)) ->
PartDesc -> (p -> CmdParser f out a) -> m (CmdParser f out a)
forall p.
Typeable p =>
PartDesc -> (p -> CmdParser f out a) -> m (CmdParser f out a)
part PartDesc
desc p -> CmdParser f out a
nextF
Free (CmdParserPartMany ManyUpperBound
bound PartDesc
desc String -> Maybe (p, String)
_ p -> f ()
_ [p] -> CmdParser f out a
nextF) -> ManyUpperBound
-> PartDesc -> ([p] -> CmdParser f out a) -> m (CmdParser f out a)
forall p.
Typeable p =>
ManyUpperBound
-> PartDesc -> ([p] -> CmdParser f out a) -> m (CmdParser f out a)
partMany ManyUpperBound
bound PartDesc
desc [p] -> CmdParser f out a
nextF
Free (CmdParserPartManyInp ManyUpperBound
bound PartDesc
desc Input -> Maybe (p, Input)
_ p -> f ()
_ [p] -> CmdParser f out a
nextF) ->
ManyUpperBound
-> PartDesc -> ([p] -> CmdParser f out a) -> m (CmdParser f out a)
forall p.
Typeable p =>
ManyUpperBound
-> PartDesc -> ([p] -> CmdParser f out a) -> m (CmdParser f out a)
partMany ManyUpperBound
bound PartDesc
desc [p] -> CmdParser f out a
nextF
Free (CmdParserReorderStop CmdParser f out a
next) -> do
CmdDescStack
stackCur <- m CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
case CmdDescStack
stackCur of
StackBottom{} -> do
[String] -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [String
"unexpected stackBottom"]
StackLayer Deque PartDesc
descs String
_ CmdDescStack
up -> do
CmdDescStack -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack -> m ()) -> CmdDescStack -> m ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd ([PartDesc] -> PartDesc
PartReorder (Deque PartDesc -> [PartDesc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Deque PartDesc
descs)) CmdDescStack
up
CmdParser f out a -> m (CmdParser f out a)
forall (m :: * -> *) a. Monad m => a -> m a
return CmdParser f out a
next
Free (CmdParserGrouped String
groupName CmdParser f out a
next) -> do
CmdDescStack
stackCur <- m CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack -> m ()) -> CmdDescStack -> m ()
forall a b. (a -> b) -> a -> b
$ Deque PartDesc -> String -> CmdDescStack -> CmdDescStack
StackLayer Deque PartDesc
forall a. Monoid a => a
mempty String
groupName CmdDescStack
stackCur
CmdParser f out a -> m (CmdParser f out a)
forall (m :: * -> *) (r :: [*]) (w :: [*]) (s :: [*])
(m0 :: * -> *) a.
(MonadMultiState Int m, MonadMultiState PartParsedData m,
MonadMultiState (Map Int (PartGatherData f)) m,
MonadMultiState Input m, MonadMultiState (CommandDesc out) m,
MonadMultiWriter [String] m, m ~ MultiRWST r w s m0,
ContainsType (CmdParser f out ()) s, ContainsType CmdDescStack s,
Monad m0) =>
CmdParser f out a -> m (CmdParser f out a)
processParsedParts (CmdParser f out a -> m (CmdParser f out a))
-> CmdParser f out a -> m (CmdParser f out a)
forall a b. (a -> b) -> a -> b
$ CmdParser f out a
next
Free (CmdParserGroupEnd CmdParser f out a
next) -> do
CmdDescStack
stackCur <- m CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
case CmdDescStack
stackCur of
StackBottom{} -> do
[String] -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell ([String] -> m ()) -> [String] -> m ()
forall a b. (a -> b) -> a -> b
$ [String
"butcher interface error: group end without group start"]
CmdParser f out a -> m (CmdParser f out a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CmdParser f out a -> m (CmdParser f out a))
-> CmdParser f out a -> m (CmdParser f out a)
forall a b. (a -> b) -> a -> b
$ CmdParser f out a
next
StackLayer Deque PartDesc
descs String
groupName CmdDescStack
up -> do
CmdDescStack -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack -> m ()) -> CmdDescStack -> m ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd
(String -> PartDesc -> PartDesc
PartRedirect String
groupName ([PartDesc] -> PartDesc
PartSeq (Deque PartDesc -> [PartDesc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Deque PartDesc
descs)))
CmdDescStack
up
CmdParser f out a -> m (CmdParser f out a)
forall (m :: * -> *) (r :: [*]) (w :: [*]) (s :: [*])
(m0 :: * -> *) a.
(MonadMultiState Int m, MonadMultiState PartParsedData m,
MonadMultiState (Map Int (PartGatherData f)) m,
MonadMultiState Input m, MonadMultiState (CommandDesc out) m,
MonadMultiWriter [String] m, m ~ MultiRWST r w s m0,
ContainsType (CmdParser f out ()) s, ContainsType CmdDescStack s,
Monad m0) =>
CmdParser f out a -> m (CmdParser f out a)
processParsedParts (CmdParser f out a -> m (CmdParser f out a))
-> CmdParser f out a -> m (CmdParser f out a)
forall a b. (a -> b) -> a -> b
$ CmdParser f out a
next
Pure a
x -> CmdParser f out a -> m (CmdParser f out a)
forall (m :: * -> *) a. Monad m => a -> m a
return (CmdParser f out a -> m (CmdParser f out a))
-> CmdParser f out a -> m (CmdParser f out a)
forall a b. (a -> b) -> a -> b
$ a -> CmdParser f out a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> CmdParser f out a) -> a -> CmdParser f out a
forall a b. (a -> b) -> a -> b
$ a
x
CmdParser f out a
f -> do
[String] -> m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell [String
"Did not find expected ReorderStop after the reordered parts"]
CmdParser f out a -> m (CmdParser f out a)
forall (m :: * -> *) a. Monad m => a -> m a
return CmdParser f out a
f
where
part
:: forall p
. Typeable p
=> PartDesc
-> (p -> CmdParser f out a)
-> m (CmdParser f out a)
part :: forall p.
Typeable p =>
PartDesc -> (p -> CmdParser f out a) -> m (CmdParser f out a)
part PartDesc
desc p -> CmdParser f out a
nextF = do
do
CmdDescStack
stackCur <- m CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack -> m ()) -> CmdDescStack -> m ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd PartDesc
desc CmdDescStack
stackCur
Int
pid <- m Int
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
Int -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
pid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
PartParsedData
parsedMap :: PartParsedData <- m PartParsedData
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
PartParsedData -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (PartParsedData -> m ()) -> PartParsedData -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> PartParsedData -> PartParsedData
forall k a. Ord k => k -> Map k a -> Map k a
MapS.delete Int
pid PartParsedData
parsedMap
Map Int (PartGatherData f)
partMap :: Map Int (PartGatherData f) <- m (Map Int (PartGatherData f))
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
Input
input :: Input <- m Input
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
let
errorResult :: MultiRWST r w s m0 (CmdParser f out a)
errorResult = do
[String] -> MultiRWST r w s m0 ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell
[ String
"could not parse expected input "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ PartDesc -> String
getPartSeqDescPositionName PartDesc
desc
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" with remaining input: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Input -> String
forall a. Show a => a -> String
show Input
input
]
CmdParser f out a -> MultiRWST r w s m0 (CmdParser f out a)
forall (m :: * -> *) (r :: [*]) (w :: [*]) (s :: [*])
(m0 :: * -> *) a.
(MonadMultiState Int m, MonadMultiState PartParsedData m,
MonadMultiState (Map Int (PartGatherData f)) m,
MonadMultiState Input m, MonadMultiState (CommandDesc out) m,
MonadMultiWriter [String] m, m ~ MultiRWST r w s m0,
ContainsType (CmdParser f out ()) s, ContainsType CmdDescStack s,
Monad m0) =>
CmdParser f out a -> m (CmdParser f out a)
processParsedParts (CmdParser f out a -> MultiRWST r w s m0 (CmdParser f out a))
-> CmdParser f out a -> MultiRWST r w s m0 (CmdParser f out a)
forall a b. (a -> b) -> a -> b
$ p -> CmdParser f out a
nextF p
forall a. a
monadMisuseError
continueOrMisuse :: Maybe p -> m (CmdParser f out a)
continueOrMisuse :: Maybe p -> m (CmdParser f out a)
continueOrMisuse = m (CmdParser f out a)
-> (p -> m (CmdParser f out a)) -> Maybe p -> m (CmdParser f out a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (CmdParser f out a)
forall a. a
monadMisuseError (CmdParser f out a -> m (CmdParser f out a)
forall (m :: * -> *) (r :: [*]) (w :: [*]) (s :: [*])
(m0 :: * -> *) a.
(MonadMultiState Int m, MonadMultiState PartParsedData m,
MonadMultiState (Map Int (PartGatherData f)) m,
MonadMultiState Input m, MonadMultiState (CommandDesc out) m,
MonadMultiWriter [String] m, m ~ MultiRWST r w s m0,
ContainsType (CmdParser f out ()) s, ContainsType CmdDescStack s,
Monad m0) =>
CmdParser f out a -> m (CmdParser f out a)
processParsedParts (CmdParser f out a -> m (CmdParser f out a))
-> (p -> CmdParser f out a) -> p -> m (CmdParser f out a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> CmdParser f out a
nextF)
case Int -> PartParsedData -> Maybe [Dynamic]
forall k a. Ord k => k -> Map k a -> Maybe a
MapS.lookup Int
pid PartParsedData
parsedMap of
Maybe [Dynamic]
Nothing -> case Int -> Map Int (PartGatherData f) -> Maybe (PartGatherData f)
forall k a. Ord k => k -> Map k a -> Maybe a
MapS.lookup Int
pid Map Int (PartGatherData f)
partMap of
Maybe (PartGatherData f)
Nothing -> m (CmdParser f out a)
forall a. a
monadMisuseError
Just (PartGatherData Int
_ PartDesc
_ Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
pfe p -> f ()
_ Bool
_) -> case Either (String -> Maybe (p, String)) (Input -> Maybe (p, Input))
pfe of
Left String -> Maybe (p, String)
pf -> case String -> Maybe (p, String)
pf String
"" of
Maybe (p, String)
Nothing -> m (CmdParser f out a)
MultiRWST r w s m0 (CmdParser f out a)
errorResult
Just (p
dx, String
_) -> Maybe p -> m (CmdParser f out a)
continueOrMisuse (Maybe p -> m (CmdParser f out a))
-> Maybe p -> m (CmdParser f out a)
forall a b. (a -> b) -> a -> b
$ p -> Maybe p
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast p
dx
Right Input -> Maybe (p, Input)
pf -> case Input -> Maybe (p, Input)
pf ([String] -> Input
InputArgs []) of
Maybe (p, Input)
Nothing -> m (CmdParser f out a)
MultiRWST r w s m0 (CmdParser f out a)
errorResult
Just (p
dx, Input
_) -> Maybe p -> m (CmdParser f out a)
continueOrMisuse (Maybe p -> m (CmdParser f out a))
-> Maybe p -> m (CmdParser f out a)
forall a b. (a -> b) -> a -> b
$ p -> Maybe p
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast p
dx
Just [Dynamic
dx] -> Maybe p -> m (CmdParser f out a)
continueOrMisuse (Maybe p -> m (CmdParser f out a))
-> Maybe p -> m (CmdParser f out a)
forall a b. (a -> b) -> a -> b
$ Dynamic -> Maybe p
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
dx
Just [Dynamic]
_ -> m (CmdParser f out a)
forall a. a
monadMisuseError
partMany
:: Typeable p
=> ManyUpperBound
-> PartDesc
-> ([p] -> CmdParser f out a)
-> m (CmdParser f out a)
partMany :: forall p.
Typeable p =>
ManyUpperBound
-> PartDesc -> ([p] -> CmdParser f out a) -> m (CmdParser f out a)
partMany ManyUpperBound
bound PartDesc
desc [p] -> CmdParser f out a
nextF = do
do
CmdDescStack
stackCur <- m CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack -> m ()) -> CmdDescStack -> m ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd (ManyUpperBound -> PartDesc -> PartDesc
wrapBoundDesc ManyUpperBound
bound PartDesc
desc) CmdDescStack
stackCur
Int
pid <- m Int
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
Int -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
pid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
PartParsedData
m :: PartParsedData <- m PartParsedData
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
PartParsedData -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (PartParsedData -> m ()) -> PartParsedData -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> PartParsedData -> PartParsedData
forall k a. Ord k => k -> Map k a -> Map k a
MapS.delete Int
pid PartParsedData
m
let partDyns :: [Dynamic]
partDyns = case Int -> PartParsedData -> Maybe [Dynamic]
forall k a. Ord k => k -> Map k a -> Maybe a
MapS.lookup Int
pid PartParsedData
m of
Maybe [Dynamic]
Nothing -> []
Just [Dynamic]
r -> [Dynamic] -> [Dynamic]
forall a. [a] -> [a]
reverse [Dynamic]
r
case (Dynamic -> Maybe p) -> [Dynamic] -> Maybe [p]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Dynamic -> Maybe p
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic [Dynamic]
partDyns of
Maybe [p]
Nothing -> m (CmdParser f out a)
forall a. a
monadMisuseError
Just [p]
xs -> CmdParser f out a -> m (CmdParser f out a)
forall (m :: * -> *) (r :: [*]) (w :: [*]) (s :: [*])
(m0 :: * -> *) a.
(MonadMultiState Int m, MonadMultiState PartParsedData m,
MonadMultiState (Map Int (PartGatherData f)) m,
MonadMultiState Input m, MonadMultiState (CommandDesc out) m,
MonadMultiWriter [String] m, m ~ MultiRWST r w s m0,
ContainsType (CmdParser f out ()) s, ContainsType CmdDescStack s,
Monad m0) =>
CmdParser f out a -> m (CmdParser f out a)
processParsedParts (CmdParser f out a -> m (CmdParser f out a))
-> CmdParser f out a -> m (CmdParser f out a)
forall a b. (a -> b) -> a -> b
$ [p] -> CmdParser f out a
nextF [p]
xs
processCmdShallow
:: (MonadMultiState (CommandDesc out) m, MonadMultiState CmdDescStack m)
=> CmdParserF f out (m a)
-> m a
processCmdShallow :: forall (m :: * -> *) a.
(MonadMultiState (CommandDesc out) m,
MonadMultiState CmdDescStack m) =>
CmdParserF f out (m a) -> m a
processCmdShallow = \case
CmdParserHelp Doc
h m a
next -> do
CommandDesc out
cmd :: CommandDesc out <- m (CommandDesc out)
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CommandDesc out -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CommandDesc out -> m ()) -> CommandDesc out -> m ()
forall a b. (a -> b) -> a -> b
$ CommandDesc out
cmd { _cmd_help :: Maybe Doc
_cmd_help = Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
h }
m a
next
CmdParserSynopsis String
s m a
next -> do
CommandDesc out
cmd :: CommandDesc out <- m (CommandDesc out)
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CommandDesc out -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet
(CommandDesc out -> m ()) -> CommandDesc out -> m ()
forall a b. (a -> b) -> a -> b
$ CommandDesc out
cmd { _cmd_synopsis :: Maybe Doc
_cmd_synopsis = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
PP.fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc
PP.text ([String] -> [Doc]) -> [String] -> [Doc]
forall a b. (a -> b) -> a -> b
$ String -> [String]
List.words String
s }
m a
next
CmdParserPeekDesc CommandDesc () -> m a
nextF -> do
m (CommandDesc out)
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet m (CommandDesc out) -> (CommandDesc out -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CommandDesc () -> m a
nextF (CommandDesc () -> m a)
-> (CommandDesc out -> CommandDesc ()) -> CommandDesc out -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (out -> ()) -> CommandDesc out -> CommandDesc ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(out
_ :: out) -> ())
CmdParserPeekInput String -> m a
nextF -> do
String -> m a
nextF (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ Input -> String
inputToString Input
inputInitial
CmdParserPart PartDesc
desc String -> Maybe (p, String)
_parseF p -> f ()
_act p -> m a
nextF -> do
do
CmdDescStack
stackCur <- m CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack -> m ()) -> CmdDescStack -> m ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd PartDesc
desc CmdDescStack
stackCur
p -> m a
nextF p
forall a. a
monadMisuseError
CmdParserPartInp PartDesc
desc Input -> Maybe (p, Input)
_parseF p -> f ()
_act p -> m a
nextF -> do
do
CmdDescStack
stackCur <- m CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack -> m ()) -> CmdDescStack -> m ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd PartDesc
desc CmdDescStack
stackCur
p -> m a
nextF p
forall a. a
monadMisuseError
CmdParserPartMany ManyUpperBound
bound PartDesc
desc String -> Maybe (p, String)
_parseF p -> f ()
_act [p] -> m a
nextF -> do
do
CmdDescStack
stackCur <- m CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack -> m ()) -> CmdDescStack -> m ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd (ManyUpperBound -> PartDesc -> PartDesc
wrapBoundDesc ManyUpperBound
bound PartDesc
desc) CmdDescStack
stackCur
[p] -> m a
nextF [p]
forall a. a
monadMisuseError
CmdParserPartManyInp ManyUpperBound
bound PartDesc
desc Input -> Maybe (p, Input)
_parseF p -> f ()
_act [p] -> m a
nextF -> do
do
CmdDescStack
stackCur <- m CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack -> m ()) -> CmdDescStack -> m ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd (ManyUpperBound -> PartDesc -> PartDesc
wrapBoundDesc ManyUpperBound
bound PartDesc
desc) CmdDescStack
stackCur
[p] -> m a
nextF [p]
forall a. a
monadMisuseError
CmdParserChild Maybe String
cmdStr Visibility
vis CmdParser f out ()
_sub f ()
_act m a
next -> do
Maybe (CommandDesc out)
mExisting <- Maybe String -> m (Maybe (CommandDesc out))
forall out (m :: * -> *).
MonadMultiState (CommandDesc out) m =>
Maybe String -> m (Maybe (CommandDesc out))
takeCommandChild Maybe String
cmdStr
let CommandDesc out
childDesc :: CommandDesc out =
CommandDesc out -> Maybe (CommandDesc out) -> CommandDesc out
forall a. a -> Maybe a -> a
Maybe.fromMaybe CommandDesc out
forall out. CommandDesc out
emptyCommandDesc { _cmd_visibility :: Visibility
_cmd_visibility = Visibility
vis } Maybe (CommandDesc out)
mExisting
(Deque (Maybe String, CommandDesc out)
-> Identity (Deque (Maybe String, CommandDesc out)))
-> CommandDesc out -> Identity (CommandDesc out)
forall out.
Lens' (CommandDesc out) (Deque (Maybe String, CommandDesc out))
cmd_children ((Deque (Maybe String, CommandDesc out)
-> Identity (Deque (Maybe String, CommandDesc out)))
-> CommandDesc out -> Identity (CommandDesc out))
-> (Deque (Maybe String, CommandDesc out)
-> Deque (Maybe String, CommandDesc out))
-> m ()
forall s (m :: * -> *) a b.
MonadMultiState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=+ (Maybe String, CommandDesc out)
-> Deque (Maybe String, CommandDesc out)
-> Deque (Maybe String, CommandDesc out)
forall a. a -> Deque a -> Deque a
Deque.snoc (Maybe String
cmdStr, CommandDesc out
childDesc)
m a
next
CmdParserImpl out
out m a
next -> do
(Maybe out -> Identity (Maybe out))
-> CommandDesc out -> Identity (CommandDesc out)
forall out. Lens' (CommandDesc out) (Maybe out)
cmd_out ((Maybe out -> Identity (Maybe out))
-> CommandDesc out -> Identity (CommandDesc out))
-> Maybe out -> m ()
forall s (m :: * -> *) a b.
MonadMultiState s m =>
ASetter s s a b -> b -> m ()
.=+ out -> Maybe out
forall a. a -> Maybe a
Just out
out
m a
next
CmdParserGrouped String
groupName m a
next -> do
CmdDescStack
stackCur <- m CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack -> m ()) -> CmdDescStack -> m ()
forall a b. (a -> b) -> a -> b
$ Deque PartDesc -> String -> CmdDescStack -> CmdDescStack
StackLayer Deque PartDesc
forall a. Monoid a => a
mempty String
groupName CmdDescStack
stackCur
m a
next
CmdParserGroupEnd m a
next -> do
CmdDescStack
stackCur <- m CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
case CmdDescStack
stackCur of
StackBottom{} -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
StackLayer Deque PartDesc
_descs String
"" CmdDescStack
_up -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
StackLayer Deque PartDesc
descs String
groupName CmdDescStack
up -> do
CmdDescStack -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack -> m ()) -> CmdDescStack -> m ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd
(String -> PartDesc -> PartDesc
PartRedirect String
groupName ([PartDesc] -> PartDesc
PartSeq (Deque PartDesc -> [PartDesc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Deque PartDesc
descs)))
CmdDescStack
up
m a
next
CmdParserReorderStop m a
next -> do
CmdDescStack
stackCur <- m CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
case CmdDescStack
stackCur of
StackBottom{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
StackLayer Deque PartDesc
descs String
"" CmdDescStack
up -> do
CmdDescStack -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack -> m ()) -> CmdDescStack -> m ()
forall a b. (a -> b) -> a -> b
$ PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd ([PartDesc] -> PartDesc
PartReorder (Deque PartDesc -> [PartDesc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Deque PartDesc
descs)) CmdDescStack
up
StackLayer{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
m a
next
CmdParserReorderStart m a
next -> do
CmdDescStack
stackCur <- m CmdDescStack
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CmdDescStack -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (CmdDescStack -> m ()) -> CmdDescStack -> m ()
forall a b. (a -> b) -> a -> b
$ Deque PartDesc -> String -> CmdDescStack -> CmdDescStack
StackLayer Deque PartDesc
forall a. Monoid a => a
mempty String
"" CmdDescStack
stackCur
m a
next
CmdParserAlternatives PartDesc
_ [] p -> m a
_ -> String -> m a
forall a. HasCallStack => String -> a
error String
"empty alternatives"
CmdParserAlternatives PartDesc
desc ((String -> Bool
_, CmdParser f out p
alt):[(String -> Bool, CmdParser f out p)]
_) p -> m a
nextF -> do
(CmdDescStack -> CmdDescStack) -> m ()
forall s (m :: * -> *). MonadMultiState s m => (s -> s) -> m ()
mModify (PartDesc -> CmdDescStack -> CmdDescStack
descStackAdd PartDesc
desc)
p -> m a
nextF (p -> m a) -> m p -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (CmdParserF f out (m p) -> m p) -> CmdParser f out p -> m p
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
(f (m a) -> m a) -> Free f a -> m a
iterM CmdParserF f out (m p) -> m p
forall (m :: * -> *) a.
(MonadMultiState (CommandDesc out) m,
MonadMultiState CmdDescStack m) =>
CmdParserF f out (m a) -> m a
processCmdShallow CmdParser f out p
alt
_failureCurrentShallowRerun
:: ( m ~ MultiRWSS.MultiRWST r w s m0
, MonadMultiState (CmdParser f out ()) m
, MonadMultiState (CommandDesc out) m
, ContainsType CmdDescStack s
, Monad m0
)
=> m ()
_failureCurrentShallowRerun :: forall (m :: * -> *) (r :: [*]) (w :: [*]) (s :: [*])
(m0 :: * -> *).
(m ~ MultiRWST r w s m0, MonadMultiState (CmdParser f out ()) m,
MonadMultiState (CommandDesc out) m, ContainsType CmdDescStack s,
Monad m0) =>
m ()
_failureCurrentShallowRerun = do
CmdParser f out ()
parser :: CmdParser f out () <- m (CmdParser f out ())
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
CommandDesc out
cmd :: CommandDesc out <-
CommandDesc out
-> MultiRWST r w (CommandDesc out : s) m0 ()
-> MultiRWST r w s m0 (CommandDesc out)
forall (m :: * -> *) s (r :: [*]) (w :: [*]) (ss :: [*]) a.
Monad m =>
s -> MultiRWST r w (s : ss) m a -> MultiRWST r w ss m s
MultiRWSS.withMultiStateS CommandDesc out
forall out. CommandDesc out
emptyCommandDesc
(MultiRWST r w (CommandDesc out : s) m0 ()
-> MultiRWST r w s m0 (CommandDesc out))
-> MultiRWST r w (CommandDesc out : s) m0 ()
-> MultiRWST r w s m0 (CommandDesc out)
forall a b. (a -> b) -> a -> b
$ (CmdParserF f out (MultiRWST r w (CommandDesc out : s) m0 ())
-> MultiRWST r w (CommandDesc out : s) m0 ())
-> CmdParser f out () -> MultiRWST r w (CommandDesc out : s) m0 ()
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
(f (m a) -> m a) -> Free f a -> m a
iterM CmdParserF f out (MultiRWST r w (CommandDesc out : s) m0 ())
-> MultiRWST r w (CommandDesc out : s) m0 ()
forall (m :: * -> *) a.
(MonadMultiState (CommandDesc out) m,
MonadMultiState CmdDescStack m) =>
CmdParserF f out (m a) -> m a
processCmdShallow CmdParser f out ()
parser
CommandDesc out -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet CommandDesc out
cmd
postProcessCmd :: CmdDescStack -> CommandDesc out -> CommandDesc out
postProcessCmd :: CmdDescStack -> CommandDesc out -> CommandDesc out
postProcessCmd CmdDescStack
descStack CommandDesc out
cmd = CommandDesc out -> CommandDesc out
forall a. CommandDesc a -> CommandDesc a
descFixParents (CommandDesc out -> CommandDesc out)
-> CommandDesc out -> CommandDesc out
forall a b. (a -> b) -> a -> b
$ CommandDesc out
cmd
{ _cmd_parts :: [PartDesc]
_cmd_parts = case CmdDescStack
descStack of
StackBottom Deque PartDesc
l -> Deque PartDesc -> [PartDesc]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Deque PartDesc
l
StackLayer{} -> []
}
monadMisuseError :: a
monadMisuseError :: forall a. a
monadMisuseError =
String -> a
forall a. HasCallStack => String -> a
error
(String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"CmdParser definition error -"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" used Monad powers where only Applicative/Arrow is allowed"
getPartSeqDescPositionName :: PartDesc -> String
getPartSeqDescPositionName :: PartDesc -> String
getPartSeqDescPositionName = \case
PartLiteral String
s -> String
s
PartVariable String
s -> String
s
PartOptional PartDesc
ds' -> PartDesc -> String
f PartDesc
ds'
PartAlts [PartDesc]
alts -> PartDesc -> String
f (PartDesc -> String) -> PartDesc -> String
forall a b. (a -> b) -> a -> b
$ [PartDesc] -> PartDesc
forall a. [a] -> a
head [PartDesc]
alts
PartDefault String
_ PartDesc
d -> PartDesc -> String
f PartDesc
d
PartSuggestion [CompletionItem]
_ PartDesc
d -> PartDesc -> String
f PartDesc
d
PartRedirect String
s PartDesc
_ -> String
s
PartMany PartDesc
ds -> PartDesc -> String
f PartDesc
ds
PartWithHelp Doc
_ PartDesc
d -> PartDesc -> String
f PartDesc
d
PartSeq [PartDesc]
ds -> [String] -> String
List.unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ PartDesc -> String
f (PartDesc -> String) -> [PartDesc] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PartDesc]
ds
PartReorder [PartDesc]
ds -> [String] -> String
List.unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ PartDesc -> String
f (PartDesc -> String) -> [PartDesc] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PartDesc]
ds
PartHidden PartDesc
d -> PartDesc -> String
f PartDesc
d
where f :: PartDesc -> String
f = PartDesc -> String
getPartSeqDescPositionName
dropSpaces :: MonadMultiState Input m => m ()
dropSpaces :: forall (m :: * -> *). MonadMultiState Input m => m ()
dropSpaces = do
Input
inp <- m Input
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
case Input
inp of
InputString String
s -> Input -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet (Input -> m ()) -> Input -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Input
InputString (String -> Input) -> String -> Input
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isSpace String
s
InputArgs{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
inputToString :: Input -> String
inputToString :: Input -> String
inputToString (InputString String
s ) = String
s
inputToString (InputArgs [String]
ss) = [String] -> String
List.unwords [String]
ss
dequeLookupRemove :: Eq k => k -> Deque (k, a) -> (Maybe a, Deque (k, a))
dequeLookupRemove :: forall k a. Eq k => k -> Deque (k, a) -> (Maybe a, Deque (k, a))
dequeLookupRemove k
key Deque (k, a)
deque = case Deque (k, a) -> Maybe ((k, a), Deque (k, a))
forall a. Deque a -> Maybe (a, Deque a)
Deque.uncons Deque (k, a)
deque of
Maybe ((k, a), Deque (k, a))
Nothing -> (Maybe a
forall a. Maybe a
Nothing, Deque (k, a)
forall a. Monoid a => a
mempty)
Just ((k
k, a
v), Deque (k, a)
rest) -> if k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
key
then (a -> Maybe a
forall a. a -> Maybe a
Just a
v, Deque (k, a)
rest)
else
let (Maybe a
r, Deque (k, a)
rest') = k -> Deque (k, a) -> (Maybe a, Deque (k, a))
forall k a. Eq k => k -> Deque (k, a) -> (Maybe a, Deque (k, a))
dequeLookupRemove k
key Deque (k, a)
rest
in (Maybe a
r, (k, a) -> Deque (k, a) -> Deque (k, a)
forall a. a -> Deque a -> Deque a
Deque.cons (k
k, a
v) Deque (k, a)
rest')
takeCommandChild
:: MonadMultiState (CommandDesc out) m
=> Maybe String
-> m (Maybe (CommandDesc out))
takeCommandChild :: forall out (m :: * -> *).
MonadMultiState (CommandDesc out) m =>
Maybe String -> m (Maybe (CommandDesc out))
takeCommandChild Maybe String
key = do
CommandDesc out
cmd <- m (CommandDesc out)
forall a (m :: * -> *). MonadMultiGet a m => m a
mGet
let (Maybe (CommandDesc out)
r, Deque (Maybe String, CommandDesc out)
children') = Maybe String
-> Deque (Maybe String, CommandDesc out)
-> (Maybe (CommandDesc out), Deque (Maybe String, CommandDesc out))
forall k a. Eq k => k -> Deque (k, a) -> (Maybe a, Deque (k, a))
dequeLookupRemove Maybe String
key (Deque (Maybe String, CommandDesc out)
-> (Maybe (CommandDesc out),
Deque (Maybe String, CommandDesc out)))
-> Deque (Maybe String, CommandDesc out)
-> (Maybe (CommandDesc out), Deque (Maybe String, CommandDesc out))
forall a b. (a -> b) -> a -> b
$ CommandDesc out -> Deque (Maybe String, CommandDesc out)
forall out.
CommandDesc out -> Deque (Maybe String, CommandDesc out)
_cmd_children CommandDesc out
cmd
CommandDesc out -> m ()
forall a (m :: * -> *). MonadMultiState a m => a -> m ()
mSet CommandDesc out
cmd { _cmd_children :: Deque (Maybe String, CommandDesc out)
_cmd_children = Deque (Maybe String, CommandDesc out)
children' }
Maybe (CommandDesc out) -> m (Maybe (CommandDesc out))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (CommandDesc out)
r
mapOut :: (outa -> outb) -> CmdParser f outa a -> CmdParser f outb a
mapOut :: forall outa outb (f :: * -> *) a.
(outa -> outb) -> CmdParser f outa a -> CmdParser f outb a
mapOut outa -> outb
f = (forall a. CmdParserF f outa a -> CmdParserF f outb a)
-> Free (CmdParserF f outa) a -> Free (CmdParserF f outb) a
forall (g :: * -> *) (f :: * -> *) b.
Functor g =>
(forall a. f a -> g a) -> Free f b -> Free g b
hoistFree ((forall a. CmdParserF f outa a -> CmdParserF f outb a)
-> Free (CmdParserF f outa) a -> Free (CmdParserF f outb) a)
-> (forall a. CmdParserF f outa a -> CmdParserF f outb a)
-> Free (CmdParserF f outa) a
-> Free (CmdParserF f outb) a
forall a b. (a -> b) -> a -> b
$ \case
CmdParserHelp Doc
doc a
r -> Doc -> a -> CmdParserF f outb a
forall (f :: * -> *) out a. Doc -> a -> CmdParserF f out a
CmdParserHelp Doc
doc a
r
CmdParserSynopsis String
s a
r -> String -> a -> CmdParserF f outb a
forall (f :: * -> *) out a. String -> a -> CmdParserF f out a
CmdParserSynopsis String
s a
r
CmdParserPeekDesc CommandDesc () -> a
fr -> (CommandDesc () -> a) -> CmdParserF f outb a
forall (f :: * -> *) out a.
(CommandDesc () -> a) -> CmdParserF f out a
CmdParserPeekDesc CommandDesc () -> a
fr
CmdParserPeekInput String -> a
fr -> (String -> a) -> CmdParserF f outb a
forall (f :: * -> *) out a. (String -> a) -> CmdParserF f out a
CmdParserPeekInput String -> a
fr
CmdParserPart PartDesc
desc String -> Maybe (p, String)
fp p -> f ()
fa p -> a
fr -> PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> (p -> a)
-> CmdParserF f outb a
forall (f :: * -> *) out a p.
Typeable p =>
PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> (p -> a)
-> CmdParserF f out a
CmdParserPart PartDesc
desc String -> Maybe (p, String)
fp p -> f ()
fa p -> a
fr
CmdParserPartMany ManyUpperBound
bound PartDesc
desc String -> Maybe (p, String)
fp p -> f ()
fa [p] -> a
fr ->
ManyUpperBound
-> PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> ([p] -> a)
-> CmdParserF f outb a
forall (f :: * -> *) out a p.
Typeable p =>
ManyUpperBound
-> PartDesc
-> (String -> Maybe (p, String))
-> (p -> f ())
-> ([p] -> a)
-> CmdParserF f out a
CmdParserPartMany ManyUpperBound
bound PartDesc
desc String -> Maybe (p, String)
fp p -> f ()
fa [p] -> a
fr
CmdParserPartInp PartDesc
desc Input -> Maybe (p, Input)
fp p -> f ()
fa p -> a
fr -> PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> (p -> a)
-> CmdParserF f outb a
forall (f :: * -> *) out a p.
Typeable p =>
PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> (p -> a)
-> CmdParserF f out a
CmdParserPartInp PartDesc
desc Input -> Maybe (p, Input)
fp p -> f ()
fa p -> a
fr
CmdParserPartManyInp ManyUpperBound
bound PartDesc
desc Input -> Maybe (p, Input)
fp p -> f ()
fa [p] -> a
fr ->
ManyUpperBound
-> PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> ([p] -> a)
-> CmdParserF f outb a
forall (f :: * -> *) out a p.
Typeable p =>
ManyUpperBound
-> PartDesc
-> (Input -> Maybe (p, Input))
-> (p -> f ())
-> ([p] -> a)
-> CmdParserF f out a
CmdParserPartManyInp ManyUpperBound
bound PartDesc
desc Input -> Maybe (p, Input)
fp p -> f ()
fa [p] -> a
fr
CmdParserChild Maybe String
s Visibility
vis CmdParser f outa ()
child f ()
act a
r ->
Maybe String
-> Visibility
-> CmdParser f outb ()
-> f ()
-> a
-> CmdParserF f outb a
forall (f :: * -> *) out a.
Maybe String
-> Visibility
-> CmdParser f out ()
-> f ()
-> a
-> CmdParserF f out a
CmdParserChild Maybe String
s Visibility
vis ((outa -> outb) -> CmdParser f outa () -> CmdParser f outb ()
forall outa outb (f :: * -> *) a.
(outa -> outb) -> CmdParser f outa a -> CmdParser f outb a
mapOut outa -> outb
f CmdParser f outa ()
child) f ()
act a
r
CmdParserImpl outa
out a
r -> outb -> a -> CmdParserF f outb a
forall (f :: * -> *) out a. out -> a -> CmdParserF f out a
CmdParserImpl (outa -> outb
f outa
out) a
r
CmdParserReorderStart a
r -> a -> CmdParserF f outb a
forall (f :: * -> *) out a. a -> CmdParserF f out a
CmdParserReorderStart a
r
CmdParserReorderStop a
r -> a -> CmdParserF f outb a
forall (f :: * -> *) out a. a -> CmdParserF f out a
CmdParserReorderStop a
r
CmdParserGrouped String
s a
r -> String -> a -> CmdParserF f outb a
forall (f :: * -> *) out a. String -> a -> CmdParserF f out a
CmdParserGrouped String
s a
r
CmdParserGroupEnd a
r -> a -> CmdParserF f outb a
forall (f :: * -> *) out a. a -> CmdParserF f out a
CmdParserGroupEnd a
r
CmdParserAlternatives PartDesc
desc [(String -> Bool, CmdParser f outa p)]
alts p -> a
r -> PartDesc
-> [(String -> Bool, CmdParser f outb p)]
-> (p -> a)
-> CmdParserF f outb a
forall (f :: * -> *) out a p.
Typeable p =>
PartDesc
-> [(String -> Bool, CmdParser f out p)]
-> (p -> a)
-> CmdParserF f out a
CmdParserAlternatives
PartDesc
desc
[ (String -> Bool
predicate, (outa -> outb) -> CmdParser f outa p -> CmdParser f outb p
forall outa outb (f :: * -> *) a.
(outa -> outb) -> CmdParser f outa a -> CmdParser f outb a
mapOut outa -> outb
f CmdParser f outa p
sub) | (String -> Bool
predicate, CmdParser f outa p
sub) <- [(String -> Bool, CmdParser f outa p)]
alts ]
p -> a
r
wrapBoundDesc :: ManyUpperBound -> PartDesc -> PartDesc
wrapBoundDesc :: ManyUpperBound -> PartDesc -> PartDesc
wrapBoundDesc ManyUpperBound
ManyUpperBound1 = PartDesc -> PartDesc
PartOptional
wrapBoundDesc ManyUpperBound
ManyUpperBoundN = PartDesc -> PartDesc
PartMany
descFixParents :: CommandDesc a -> CommandDesc a
descFixParents :: forall a. CommandDesc a -> CommandDesc a
descFixParents = Maybe (Maybe String, CommandDesc a)
-> CommandDesc a -> CommandDesc a
forall a.
Maybe (Maybe String, CommandDesc a)
-> CommandDesc a -> CommandDesc a
descFixParentsWithTopM Maybe (Maybe String, CommandDesc a)
forall a. Maybe a
Nothing
descFixParentsWithTopM
:: Maybe (Maybe String, CommandDesc a) -> CommandDesc a -> CommandDesc a
descFixParentsWithTopM :: forall a.
Maybe (Maybe String, CommandDesc a)
-> CommandDesc a -> CommandDesc a
descFixParentsWithTopM Maybe (Maybe String, CommandDesc a)
mTop CommandDesc a
topDesc = (CommandDesc a -> CommandDesc a) -> CommandDesc a
forall a. (a -> a) -> a
Data.Function.fix ((CommandDesc a -> CommandDesc a) -> CommandDesc a)
-> (CommandDesc a -> CommandDesc a) -> CommandDesc a
forall a b. (a -> b) -> a -> b
$ \CommandDesc a
fixed -> CommandDesc a
topDesc
{ _cmd_mParent :: Maybe (Maybe String, CommandDesc a)
_cmd_mParent = CommandDesc a
-> (Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a)
forall a.
CommandDesc a
-> (Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a)
goUp CommandDesc a
fixed ((Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a))
-> Maybe (Maybe String, CommandDesc a)
-> Maybe (Maybe String, CommandDesc a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (Maybe String, CommandDesc a)
mTop Maybe (Maybe String, CommandDesc a)
-> Maybe (Maybe String, CommandDesc a)
-> Maybe (Maybe String, CommandDesc a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CommandDesc a -> Maybe (Maybe String, CommandDesc a)
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc a
topDesc)
, _cmd_children :: Deque (Maybe String, CommandDesc a)
_cmd_children = CommandDesc a -> Deque (Maybe String, CommandDesc a)
forall out.
CommandDesc out -> Deque (Maybe String, CommandDesc out)
_cmd_children CommandDesc a
topDesc Deque (Maybe String, CommandDesc a)
-> ((Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a))
-> Deque (Maybe String, CommandDesc a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CommandDesc a
-> (Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a)
forall a.
CommandDesc a
-> (Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a)
goDown CommandDesc a
fixed
}
where
goUp
:: CommandDesc a
-> (Maybe String, CommandDesc a)
-> (Maybe String, CommandDesc a)
goUp :: forall a.
CommandDesc a
-> (Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a)
goUp CommandDesc a
child (Maybe String
childName, CommandDesc a
parent) =
(,) Maybe String
childName (CommandDesc a -> (Maybe String, CommandDesc a))
-> CommandDesc a -> (Maybe String, CommandDesc a)
forall a b. (a -> b) -> a -> b
$ (CommandDesc a -> CommandDesc a) -> CommandDesc a
forall a. (a -> a) -> a
Data.Function.fix ((CommandDesc a -> CommandDesc a) -> CommandDesc a)
-> (CommandDesc a -> CommandDesc a) -> CommandDesc a
forall a b. (a -> b) -> a -> b
$ \CommandDesc a
fixed -> CommandDesc a
parent
{ _cmd_mParent :: Maybe (Maybe String, CommandDesc a)
_cmd_mParent = CommandDesc a
-> (Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a)
forall a.
CommandDesc a
-> (Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a)
goUp CommandDesc a
fixed ((Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a))
-> Maybe (Maybe String, CommandDesc a)
-> Maybe (Maybe String, CommandDesc a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CommandDesc a -> Maybe (Maybe String, CommandDesc a)
forall out.
CommandDesc out -> Maybe (Maybe String, CommandDesc out)
_cmd_mParent CommandDesc a
parent
, _cmd_children :: Deque (Maybe String, CommandDesc a)
_cmd_children = CommandDesc a -> Deque (Maybe String, CommandDesc a)
forall out.
CommandDesc out -> Deque (Maybe String, CommandDesc out)
_cmd_children CommandDesc a
parent
Deque (Maybe String, CommandDesc a)
-> ((Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a))
-> Deque (Maybe String, CommandDesc a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Maybe String
n, CommandDesc a
c) -> if Maybe String
n Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
childName then (Maybe String
n, CommandDesc a
child) else (Maybe String
n, CommandDesc a
c)
}
goDown
:: CommandDesc a
-> (Maybe String, CommandDesc a)
-> (Maybe String, CommandDesc a)
goDown :: forall a.
CommandDesc a
-> (Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a)
goDown CommandDesc a
parent (Maybe String
childName, CommandDesc a
child) =
(,) Maybe String
childName (CommandDesc a -> (Maybe String, CommandDesc a))
-> CommandDesc a -> (Maybe String, CommandDesc a)
forall a b. (a -> b) -> a -> b
$ (CommandDesc a -> CommandDesc a) -> CommandDesc a
forall a. (a -> a) -> a
Data.Function.fix ((CommandDesc a -> CommandDesc a) -> CommandDesc a)
-> (CommandDesc a -> CommandDesc a) -> CommandDesc a
forall a b. (a -> b) -> a -> b
$ \CommandDesc a
fixed -> CommandDesc a
child
{ _cmd_mParent :: Maybe (Maybe String, CommandDesc a)
_cmd_mParent = (Maybe String, CommandDesc a)
-> Maybe (Maybe String, CommandDesc a)
forall a. a -> Maybe a
Just (Maybe String
childName, CommandDesc a
parent)
, _cmd_children :: Deque (Maybe String, CommandDesc a)
_cmd_children = CommandDesc a -> Deque (Maybe String, CommandDesc a)
forall out.
CommandDesc out -> Deque (Maybe String, CommandDesc out)
_cmd_children CommandDesc a
child Deque (Maybe String, CommandDesc a)
-> ((Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a))
-> Deque (Maybe String, CommandDesc a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CommandDesc a
-> (Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a)
forall a.
CommandDesc a
-> (Maybe String, CommandDesc a) -> (Maybe String, CommandDesc a)
goDown CommandDesc a
fixed
}
_tooLongText
:: Int
-> String
-> String
-> PP.Doc
_tooLongText :: Int -> String -> String -> Doc
_tooLongText Int
i String
alt String
s = String -> Doc
PP.text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
Bool.bool String
alt String
s (Bool -> String) -> Bool -> String
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
i String
s