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



-- general-purpose helpers
----------------------------

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

-- sadly, you need a degree in type inference to know when we can use
-- these operators and when it must be avoided due to type ambiguities
-- arising around s in the signatures below. That's the price of not having
-- the functional dependency in MonadMulti*T.

(.=+) :: 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)

-- inflateStateProxy :: (Monad m, ContainsType s ss)
--                   => p s -> StateS.StateT s m a -> MultiRWSS.MultiRWST r w ss m a
-- inflateStateProxy _ = MultiRWSS.inflateState

-- more on-topic stuff
----------------------------

-- instance IsHelpBuilder (CmdBuilder out) where
--   help s = liftF $ CmdBuilderHelp s ()
-- 
-- instance IsHelpBuilder (ParamBuilder p) where
--   help s = liftF $ ParamBuilderHelp s ()
-- 
-- instance IsHelpBuilder FlagBuilder where
--   help s = liftF $ FlagBuilderHelp s ()

-- | Add a synopsis to the command currently in scope; at top level this will
-- be the implicit top-level command.
--
-- Adding a second synopsis will overwrite a previous synopsis;
-- 'checkCmdParser' will check that you don't (accidentally) do this however.
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 ()

-- | Add a help document to the command currently in scope; at top level this
-- will be the implicit top-level command.
--
-- Adding a second document will overwrite a previous document;
-- 'checkCmdParser' will check that you don't (accidentally) do this however.
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 ()

-- | Like @'addCmdHelp' . PP.text@
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) ()

-- | Semi-hacky way of accessing the output CommandDesc from inside of a
-- 'CmdParser'. This is not implemented via knot-tying, i.e. the CommandDesc
-- you get is _not_ equivalent to the CommandDesc returned by 'runCmdParser'.
-- Also see 'runCmdParserWithHelpDesc' which does knot-tying.
--
-- For best results, use this "below"
-- any 'addCmd' invocations in the current context, e.g. directly before
-- the 'addCmdImpl' invocation.
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

-- | Semi-hacky way of accessing the current input that is not yet processed.
-- This must not be used to do any parsing. The purpose of this function is
-- to provide a String to be used for output to the user, as feedback about
-- what command was executed. For example we may think of an interactive
-- program reacting to commandline input such as
-- "run --delay 60 fire-rockets" which shows a 60 second delay on the
-- "fire-rockets" command. The latter string could have been obtained
-- via 'peekInput' after having parsed "run --delay 60" already.
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

-- | Add part that is expected to occur exactly once in the input. May
-- succeed on empty input (e.g. by having a default).
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

-- | Add part that is not required to occur, and can occur as often as
-- indicated by 'ManyUpperBound'. Must not succeed on empty input.
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

-- | Add part that is expected to occur exactly once in the input. May
-- succeed on empty input (e.g. by having a default).
--
-- Only difference to 'addCmdPart' is that it accepts 'Input', i.e. can
-- behave differently for @String@ and @[String]@ input.
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

-- | Add part that is not required to occur, and can occur as often as
-- indicated by 'ManyUpperBound'. Must not succeed on empty input.
--
-- Only difference to 'addCmdPart' is that it accepts 'Input', i.e. can
-- behave differently for @String@ and @[String]@ input.
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

-- | Add a new child command in the current context.
addCmd
  :: Applicative f
  => String -- ^ command name
  -> CmdParser f out () -- ^ subcommand
  -> 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 ()) ()

-- | Add a new child command in the current context, but make it hidden. It
-- will not appear in docs/help generated by e.g. the functions in the
-- @Pretty@ module.
--
-- This feature is not well tested yet.
addCmdHidden
  :: Applicative f
  => String -- ^ command name
  -> CmdParser f out () -- ^ subcommand
  -> 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 ()) ()

-- | Add a list of sub-parsers one of which will be selected and used based
-- on the provided predicate function. The input elements consist of:
-- a) a name used for the command description of the output,
-- b) a predicate function; the first True predicate determines which element
--    to apply
-- c) a CmdParser.
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]

-- | Create a simple PartDesc from a string.
varPartDesc :: String -> PartDesc
varPartDesc :: String -> PartDesc
varPartDesc = String -> PartDesc
PartVariable

-- | Add a new nameless child command in the current context. Nameless means
-- that this command matches the empty input, i.e. will always apply.
-- This feature is experimental and CommandDesc pretty-printing might not
-- correctly in presense of nullCmds.
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 ()) ()

-- | Add an implementation to the current command.
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 ()

-- | Best explained via example:
--
-- > do
-- >   reorderStart
-- >   bright <- addSimpleBoolFlag "" ["bright"] mempty
-- >   yellow <- addSimpleBoolFlag "" ["yellow"] mempty
-- >   reorderStop
-- >   ..
--
-- will accept any inputs "" "--bright" "--yellow" "--bright --yellow" "--yellow --bright".
--
-- This works for any flags/params, but bear in mind that the results might
-- be unexpected because params may match on any input.
--
-- Note that start/stop must occur in pairs, and it will be a runtime error
-- if you mess this up. Use 'checkCmdParser' if you want to check all parts
-- of your 'CmdParser' without providing inputs that provide 100% coverage.
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 ()

-- | See 'reorderStart'
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 ()

-- addPartHelp :: String -> CmdPartParser ()
-- addPartHelp s = liftF $ CmdPartParserHelp s ()
-- 
-- addPartParserBasic :: (String -> Maybe (p, String)) -> Maybe p -> CmdPartParser p
-- addPartParserBasic f def = liftF $ CmdPartParserCore f def id
-- 
-- addPartParserOptionalBasic :: CmdPartParser p -> CmdPartParser (Maybe p)
-- addPartParserOptionalBasic p = liftF $ CmdPartParserOptional p id

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


-- | Because butcher is evil (i.e. has constraints not encoded in the types;
-- see the README), this method can be used as a rough check that you did not
-- mess up. It traverses all possible parts of the 'CmdParser' thereby
-- ensuring that the 'CmdParser' has a valid structure.
--
-- This method also yields a _complete_ @CommandDesc@ output, where the other
-- runCmdParser* functions all traverse only a shallow structure around the
-- parts of the 'CmdParser' touched while parsing the current input.
checkCmdParser
  :: forall f out
   . Maybe String -- ^ top-level command name
  -> CmdParser f out () -- ^ parser to check
  -> 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


-- | Run a @CmdParser@ on the given input, returning:
--
-- a) A @CommandDesc ()@ that accurately represents the subcommand that was
--    reached, even if parsing failed. Because this is returned always, the
--    argument is @()@ because "out" requires a successful parse.
--
-- b) Either an error or the result of a successful parse, including a proper
--    "CommandDesc out" from which an "out" can be extracted (presuming that
--    the command has an implementation).
runCmdParser
  :: Maybe String -- ^ program name to be used for the top-level @CommandDesc@
  -> Input -- ^ input to be processed
  -> CmdParser Identity out () -- ^ parser to use
  -> (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

-- | Like 'runCmdParser', but also returning all input after the last
-- successfully parsed subcommand. E.g. for some input
-- "myprog foo bar -v --wrong" where parsing fails at "--wrong", this will
-- contain the full "-v --wrong". Useful for interactive feedback stuff.
runCmdParserExt
  :: Maybe String -- ^ program name to be used for the top-level @CommandDesc@
  -> Input -- ^ input to be processed
  -> CmdParser Identity out () -- ^ parser to use
  -> (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

-- | The Applicative-enabled version of 'runCmdParser'.
runCmdParserA
  :: forall f out
   . Applicative f
  => Maybe String -- ^ program name to be used for the top-level @CommandDesc@
  -> Input -- ^ input to be processed
  -> CmdParser f out () -- ^ parser to use
  -> 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

-- | The Applicative-enabled version of 'runCmdParserExt'.
runCmdParserAExt
  :: forall f out
   . Applicative f
  => Maybe String -- ^ program name to be used for the top-level @CommandDesc@
  -> Input -- ^ input to be processed
  -> CmdParser f out () -- ^ parser to use
  -> 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
    :: -- forall a
       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
      -- partialDesc :: CommandDesc out <- mGet
      -- partialStack :: CmdDescStack <- mGet
      -- run the rest without affecting the actual stack
      -- to retrieve the complete cmddesc.
      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
                  } -- partialDesc
              (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) -- partialStack
              (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
            -- no input consumed, default applied
            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
                 -- we intentionally override/ignore act here.
                 -- TODO: it should be documented that we expect the same act
                 -- on different child nodes with the same name.
              )
        (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
        -- get the shallow desc for the child in a separate env.
        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 -- a child not matching what we have in the input
          -- get the shallow desc for the child in a separate env.
          -- proceed regularly on the same layer
          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 -- matching child -> descend
          -- process all remaining stuff on the same layer shallowly,
          -- including the current node. This will walk over the child
          -- definition(s) again, but that is harmless because we do not
          -- overwrite them.
          (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
          -- do the descend
          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
          -- check that descending yielded
          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 () -- hard abort should be fine for this case.
        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
                     -- i will be angry if foldMap ever decides to not fold
                     -- in order of keys.
            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 -- filling the map
            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)
      -- we check that all data placed in the map has been consumed while
      -- running the parts for which we collected the parseresults.
      -- there can only be any rest if the collection of parts changed
      -- between the reorderPartGather traversal and the processParsedParts
      -- consumption.
      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
    -- TODO: why do PartGatherData contain desc?
    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
      -- partialDesc :: CommandDesc out <- mGet
      -- partialStack :: CmdDescStack <- mGet
      -- run the rest without affecting the actual stack
      -- to retrieve the complete cmddesc.
      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
                  } -- partialDesc
              (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) -- partialStack
              (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 -- hard abort should be fine for this case.
        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 -- it would still be in the map
                                      -- if it never had been successfully
                                      -- parsed, as indicicated by the
                                      -- previous parsedMap Nothing lookup.
          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

  -- this does no error reporting at all.
  -- user needs to use check for that purpose instead.
  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

  -- currently unused; was previously used during failure in
  -- processParsedParts. Using this leads to duplicated descs, but I fear
  -- that not using it also leads to certain problems (missing children?).
  -- Probably want to re-write into proper two-phase 1) obtain desc 2) run
  -- parser, like the applicative approach.
  _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 -- this is not optimal, but probably
                                   -- does not matter.
    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

-- | map over the @out@ type argument
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

-- cmdActionPartial :: CommandDesc out -> Either String out
-- cmdActionPartial = maybe (Left err) Right . _cmd_out
--   where
--     err = "command is missing implementation!"
--  
-- cmdAction :: CmdParser out () -> String -> Either String out
-- cmdAction b s = case runCmdParser Nothing s b of
--   (_, Right cmd)                     -> cmdActionPartial cmd
--   (_, Left (ParsingError (out:_) _)) -> Left $ out
--   _ -> error "whoops"
-- 
-- cmdActionRun :: (CommandDesc () -> ParsingError -> out)
--              -> CmdParser out ()
--              -> String
--              -> out
-- cmdActionRun f p s = case runCmdParser Nothing s p of
--   (cmd, Right out) -> case _cmd_out out of
--     Just o -> o
--     Nothing -> f cmd (ParsingError ["command is missing implementation!"] "")
--   (cmd, Left err) -> f cmd err

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

-- descFixParentsWithTop :: String -> CommandDesc a -> CommandDesc a
-- descFixParentsWithTop s = descFixParentsWithTopM (Just (s, emptyCommandDesc))

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 -- max length
  -> String -- alternative if actual length is bigger than max.
  -> String -- text to print, if length is fine.
  -> 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