{-# LANGUAGE DeriveGeneric          #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE PostfixOperators       #-}
{-# LANGUAGE Safe                   #-}

{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

-- |
-- Copyright: © Oren Ben-Kiki 2007,
--            © Herbert Valerio Riedel 2015-2018
-- SPDX-License-Identifier: GPL-2.0-or-later
--
-- Tokenizer for the YAML 1.2 syntax as defined in <http://yaml.org/spec/1.2/spec.html>.
--
module Data.YAML.Token
  ( tokenize
  , Token(..)
  , Code(..)
  , Encoding(..)
  ) where

import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.DList                 as D
import           Prelude                    hiding ((*), (+), (-), (/), (^))
import qualified Prelude

import           Data.YAML.Token.Encoding   (Encoding (..), decode)

import           Util                       hiding (empty)
import qualified Util

-- * Generic operators
--
-- ** Numeric operators
--
-- We rename the four numerical operators @+@ @-@ @*@ @\/@ to start with @.@
-- (@.+@, @.-@, @.*@, @.\/@). This allows us to use the originals for BNF
-- notation (we also hijack the @^@ operator). This is not a generally
-- recommended practice. It is justified in this case since we have very little
-- arithmetic operations, and a lot of BNF rules which this makes extremely
-- readable.

infixl 6 .+
-- | \".+\" is the numeric addition (we use \"+\" for postfix \"one or more\").
(.+) :: Int -> Int -> Int
.+ :: Int -> Int -> Int
(.+) = Int -> Int -> Int
forall a. Num a => a -> a -> a
(Prelude.+)

infixl 6 .-
-- | \".-\" is the numeric subtraction (we use \"-\" for infix \"and not\").
(.-) :: Int -> Int -> Int
.- :: Int -> Int -> Int
(.-) = Int -> Int -> Int
forall a. Num a => a -> a -> a
(Prelude.-)

{-
infixl 7 .*
-- | \".*\" is the numeric multiplication (we use \"*\" for postfix \"zero or
-- more\").
(.*) :: Int -> Int -> Int
(.*) = (Prelude.*)
-}

-- ** Record field access
--
-- We also define @^.@ for record access for increased readability.

infixl 8 ^.
-- | @record ^. field@ is the same as @field record@,  but is more readable.
--
-- NB: This trivially emulates the @lens@ operator
(^.) :: record -> (record -> value) -> value
record :: record
record ^. :: record -> (record -> value) -> value
^. field :: record -> value
field = record -> value
field record
record

-- * Result tokens
--
-- The parsing result is a stream of tokens rather than a parse tree. The idea
-- is to convert the YAML input into \"byte codes\". These byte codes are
-- intended to be written into a byte codes file (or more likely a UNIX pipe)
-- for further processing.

-- | 'Token' codes.
data Code = Bom             -- ^ BOM, contains \"@TF8@\", \"@TF16LE@\", \"@TF32BE@\", etc.
          | Text            -- ^ Content text characters.
          | Meta            -- ^ Non-content (meta) text characters.
          | Break           -- ^ Separation line break.
          | LineFeed        -- ^ Line break normalized to content line feed.
          | LineFold        -- ^ Line break folded to content space.
          | Indicator       -- ^ Character indicating structure.
          | White           -- ^ Separation white space.
          | Indent          -- ^ Indentation spaces.
          | DirectivesEnd   -- ^ Document start marker.
          | DocumentEnd     -- ^ Document end marker.
          | BeginEscape     -- ^ Begins escape sequence.
          | EndEscape       -- ^ Ends escape sequence.
          | BeginComment    -- ^ Begins comment.
          | EndComment      -- ^ Ends comment.
          | BeginDirective  -- ^ Begins directive.
          | EndDirective    -- ^ Ends directive.
          | BeginTag        -- ^ Begins tag.
          | EndTag          -- ^ Ends tag.
          | BeginHandle     -- ^ Begins tag handle.
          | EndHandle       -- ^ Ends tag handle.
          | BeginAnchor     -- ^ Begins anchor.
          | EndAnchor       -- ^ Ends anchor.
          | BeginProperties -- ^ Begins node properties.
          | EndProperties   -- ^ Ends node properties.
          | BeginAlias      -- ^ Begins alias.
          | EndAlias        -- ^ Ends alias.
          | BeginScalar     -- ^ Begins scalar content.
          | EndScalar       -- ^ Ends scalar content.
          | BeginSequence   -- ^ Begins sequence content.
          | EndSequence     -- ^ Ends sequence content.
          | BeginMapping    -- ^ Begins mapping content.
          | EndMapping      -- ^ Ends mapping content.
          | BeginPair       -- ^ Begins mapping key:value pair.
          | EndPair         -- ^ Ends mapping key:value pair.
          | BeginNode       -- ^ Begins complete node.
          | EndNode         -- ^ Ends complete node.
          | BeginDocument   -- ^ Begins document.
          | EndDocument     -- ^ Ends document.
          | BeginStream     -- ^ Begins YAML stream.
          | EndStream       -- ^ Ends YAML stream.
          | Error           -- ^ Parsing error at this point.
          | Unparsed        -- ^ Unparsed due to errors (or at end of test).
          | Detected        -- ^ Detected parameter (for testing).
  deriving (Int -> Code -> ShowS
[Code] -> ShowS
Code -> String
(Int -> Code -> ShowS)
-> (Code -> String) -> ([Code] -> ShowS) -> Show Code
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Code] -> ShowS
$cshowList :: [Code] -> ShowS
show :: Code -> String
$cshow :: Code -> String
showsPrec :: Int -> Code -> ShowS
$cshowsPrec :: Int -> Code -> ShowS
Show,Code -> Code -> Bool
(Code -> Code -> Bool) -> (Code -> Code -> Bool) -> Eq Code
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Code -> Code -> Bool
$c/= :: Code -> Code -> Bool
== :: Code -> Code -> Bool
$c== :: Code -> Code -> Bool
Eq,(forall x. Code -> Rep Code x)
-> (forall x. Rep Code x -> Code) -> Generic Code
forall x. Rep Code x -> Code
forall x. Code -> Rep Code x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Code x -> Code
$cfrom :: forall x. Code -> Rep Code x
Generic)

-- | @since 0.2.0
instance NFData Code where
  rnf :: Code -> ()
rnf x :: Code
x = Code -> () -> ()
forall a b. a -> b -> b
seq Code
x ()

{-
-- | @show code@ converts a 'Code' to the one-character YEAST token code char.
-- The list of byte codes is also documented in the @yaml2yeast@ program.
instance Show Code where
  show code = case code of
                   Bom             -> "U"
                   Text            -> "T"
                   Meta            -> "t"
                   Break           -> "b"
                   LineFeed        -> "L"
                   LineFold        -> "l"
                   Indicator       -> "I"
                   White           -> "w"
                   Indent          -> "i"
                   DirectivesEnd   -> "K"
                   DocumentEnd     -> "k"
                   BeginEscape     -> "E"
                   EndEscape       -> "e"
                   BeginComment    -> "C"
                   EndComment      -> "c"
                   BeginDirective  -> "D"
                   EndDirective    -> "d"
                   BeginTag        -> "G"
                   EndTag          -> "g"
                   BeginHandle     -> "H"
                   EndHandle       -> "h"
                   BeginAnchor     -> "A"
                   EndAnchor       -> "a"
                   BeginProperties -> "P"
                   EndProperties   -> "p"
                   BeginAlias      -> "R"
                   EndAlias        -> "r"
                   BeginScalar     -> "S"
                   EndScalar       -> "s"
                   BeginSequence   -> "Q"
                   EndSequence     -> "q"
                   BeginMapping    -> "M"
                   EndMapping      -> "m"
                   BeginNode       -> "N"
                   EndNode         -> "n"
                   BeginPair       -> "X"
                   EndPair         -> "x"
                   BeginDocument   -> "O"
                   EndDocument     -> "o"
                   Error           -> "!"
                   Unparsed        -> "-"
                   Detected        -> "$"
-}

-- | Parsed token.
data Token = Token {
    Token -> Int
tByteOffset :: !Int,   -- ^ 0-base byte offset in stream.
    Token -> Int
tCharOffset :: !Int,   -- ^ 0-base character offset in stream.
    Token -> Int
tLine       :: !Int,   -- ^ 1-based line number.
    Token -> Int
tLineChar   :: !Int,   -- ^ 0-based character in line.
    Token -> Code
tCode       :: !Code,  -- ^ Specific token 'Code'.
    Token -> String
tText       :: !String -- ^ Contained input chars, if any.
  } deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show,(forall x. Token -> Rep Token x)
-> (forall x. Rep Token x -> Token) -> Generic Token
forall x. Rep Token x -> Token
forall x. Token -> Rep Token x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Token x -> Token
$cfrom :: forall x. Token -> Rep Token x
Generic)

-- | @since 0.2.0
instance NFData Token where
  rnf :: Token -> ()
rnf Token { tText :: Token -> String
tText = String
txt } = String -> ()
forall a. NFData a => a -> ()
rnf String
txt

-- * Parsing framework
--
-- Haskell has no shortage of parsing frameworks. We use our own because:
--
--  * Most available frameworks are inappropriate because of their focus on
--    building a parse tree, and completing all of it before any of it is
--    accessible to the caller. We return a stream of tokens, and would like
--    its head to be accessible as soon as possible to allow for streaming. To
--    do this with bounded memory usage we use a combination of continuation
--    passing style and difference lists for the collected tokens.
--
--  * Haskell makes it so easy to roll your own parsing framework. We need some
--    specialized machinery (limited lookahead, forbidden patterns). It is
--    possible to build these on top of existing frameworks but the end result
--    isn't much shorter than rolling our own.
--
-- Since we roll our own framework we don't bother with making it generalized,
-- so we maintain a single 'State' type rather than having a generic one that
-- contains a polymorphic \"UserState\" field etc.

-- | A 'Data.YAML.Token.Parser' is basically a function computing a 'Reply'.
newtype Parser result = Parser (State -> Reply result)

applyParser :: Parser result -> State -> Reply result
applyParser :: Parser result -> State -> Reply result
applyParser (Parser p :: State -> Reply result
p) s :: State
s = State -> Reply result
p State
s

-- | The 'Result' of each invocation is either an error, the actual result, or
-- a continuation for computing the actual result.
data Result result = Failed String        -- ^ Parsing aborted with a failure.
                   | Result result        -- ^ Parsing completed with a result.
                   | More (Parser result) -- ^ Parsing is ongoing with a continuation.

{-
-- Showing a 'Result' is only used in debugging.
instance (Show result) => Show (Result result) where
  show result = case result of
                     Failed message -> "Failed " ++ message
                     Result result  -> "Result " ++ (show result)
                     More _         -> "More"
-}

-- | Each invocation of a 'Data.YAML.Token.Parser' yields a 'Reply'. The 'Result' is only one
-- part of the 'Reply'.
data Reply result = Reply {
    Reply result -> Result result
rResult :: !(Result result), -- ^ Parsing result.
    Reply result -> DList Token
rTokens :: !(D.DList Token), -- ^ Tokens generated by the parser.
    Reply result -> Maybe Decision
rCommit :: !(Maybe Decision),  -- ^ Commitment to a decision point.
    Reply result -> State
rState  :: !State            -- ^ The updated parser state.
  }

{-
-- Showing a 'State' is only used in debugging.
instance (Show result) => Show (Reply result) where
  show reply = "Result: "    ++ (show $ reply^.rResult)
            ++ ", Tokens: "  ++ (show $ D.toList $ reply^.rTokens)
            ++ ", Commit: "  ++ (show $ reply^.rCommit)
            ++ ", State: { " ++ (show $ reply^.rState) ++ "}"
-}

-- A 'Pattern' is a parser that doesn't have an (interesting) result.
type Pattern = Parser ()

-- ** Parsing state

-- | The internal parser state. We don't bother with parameterising it with a
-- \"UserState\", we just bundle the generic and specific fields together (not
-- that it is that easy to draw the line - is @sLine@ generic or specific?).
data State = State {
    State -> Encoding
sEncoding        :: !Encoding,        -- ^ The input UTF encoding.
    State -> Decision
sDecision        :: !Decision,        -- ^ Current decision name.
    State -> Int
sLimit           :: !Int,             -- ^ Lookahead characters limit.
    State -> Maybe Pattern
sForbidden       :: !(Maybe Pattern), -- ^ Pattern we must not enter into.
    State -> Bool
sIsPeek          :: !Bool,            -- ^ Disables token generation.
    State -> Bool
sIsSol           :: !Bool,            -- ^ Is at start of line?
    State -> String
sChars           :: ![Char],          -- ^ (Reversed) characters collected for a token.
    State -> Int
sCharsByteOffset :: !Int,             -- ^ Byte offset of first collected character.
    State -> Int
sCharsCharOffset :: !Int,             -- ^ Char offset of first collected character.
    State -> Int
sCharsLine       :: !Int,             -- ^ Line of first collected character.
    State -> Int
sCharsLineChar   :: !Int,             -- ^ Character in line of first collected character.
    State -> Int
sByteOffset      :: !Int,             -- ^ Offset in bytes in the input.
    State -> Int
sCharOffset      :: !Int,             -- ^ Offset in characters in the input.
    State -> Int
sLine            :: !Int,             -- ^ Builds on YAML's line break definition.
    State -> Int
sLineChar        :: !Int,             -- ^ Character number in line.
    State -> Code
sCode            :: !Code,            -- ^ Of token we are collecting chars for.
    State -> Char
sLast            :: !Char,            -- ^ Last matched character.
    State -> [(Int, Char)]
sInput           :: ![(Int, Char)]    -- ^ The decoded input characters.
  }

{-
-- Showing a 'State' is only used in debugging. Note that forcing dump of
-- @sInput@ will disable streaming it.
instance Show State where
  show state = "Encoding: "          ++ (show $ state^.sEncoding)
            ++ ", Decision: "        ++ (show $ state^.sDecision)
            ++ ", Limit: "           ++ (show $ state^.sLimit)
            ++ ", IsPeek: "          ++ (show $ state^.sIsPeek)
            ++ ", IsSol: "           ++ (show $ state^.sIsSol)
            ++ ", Chars: >>>"        ++ (reverse $ state^.sChars) ++ "<<<"
            ++ ", CharsByteOffset: " ++ (show $ state^.sCharsByteOffset)
            ++ ", CharsCharOffset: " ++ (show $ state^.sCharsCharOffset)
            ++ ", CharsLine: "       ++ (show $ state^.sCharsLine)
            ++ ", CharsLineChar: "   ++ (show $ state^.sCharsLineChar)
            ++ ", ByteOffset: "      ++ (show $ state^.sByteOffset)
            ++ ", CharOffset: "      ++ (show $ state^.sCharOffset)
            ++ ", Line: "            ++ (show $ state^.sLine)
            ++ ", LineChar: "        ++ (show $ state^.sLineChar)
            ++ ", Code: "            ++ (show $ state^.sCode)
            ++ ", Last: "            ++ (show $ state^.sLast)
--          ++ ", Input: >>>"        ++ (show $ state^.sInput) ++ "<<<"
-}

-- | @initialState name input@ returns an initial 'State' for parsing the
-- /input/ (with /name/ for error messages).
initialState :: BLC.ByteString -> State
initialState :: ByteString -> State
initialState input :: ByteString
input
  = $WState :: Encoding
-> Decision
-> Int
-> Maybe Pattern
-> Bool
-> Bool
-> String
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Code
-> Char
-> [(Int, Char)]
-> State
State { sEncoding :: Encoding
sEncoding        = Encoding
encoding
          , sDecision :: Decision
sDecision        = Decision
DeNone
          , sLimit :: Int
sLimit           = -1
          , sForbidden :: Maybe Pattern
sForbidden       = Maybe Pattern
forall a. Maybe a
Nothing
          , sIsPeek :: Bool
sIsPeek          = Bool
False
          , sIsSol :: Bool
sIsSol           = Bool
True
          , sChars :: String
sChars           = []
          , sCharsByteOffset :: Int
sCharsByteOffset = -1
          , sCharsCharOffset :: Int
sCharsCharOffset = -1
          , sCharsLine :: Int
sCharsLine       = -1
          , sCharsLineChar :: Int
sCharsLineChar   = -1
          , sByteOffset :: Int
sByteOffset      = 0
          , sCharOffset :: Int
sCharOffset      = 0
          , sLine :: Int
sLine            = 1
          , sLineChar :: Int
sLineChar        = 0
          , sCode :: Code
sCode            = Code
Unparsed
          , sLast :: Char
sLast            = ' '
          , sInput :: [(Int, Char)]
sInput           = [(Int, Char)]
decoded
          }
  where
    (encoding :: Encoding
encoding, decoded :: [(Int, Char)]
decoded) = ByteString -> (Encoding, [(Int, Char)])
decode ByteString
input

-- *** Setters
--
-- We need four setter functions to pass them around as arguments. For some
-- reason, Haskell only generates getter functions.

-- | @setLimit limit state@ sets the @sLimit@ field to /limit/.
setLimit :: Int -> State -> State
setLimit :: Int -> State -> State
setLimit limit :: Int
limit state :: State
state = State
state { sLimit :: Int
sLimit = Int
limit }
{-# INLINE setLimit #-}

-- | @setForbidden forbidden state@ sets the @sForbidden@ field to /forbidden/.
setForbidden :: Maybe Pattern -> State -> State
setForbidden :: Maybe Pattern -> State -> State
setForbidden forbidden :: Maybe Pattern
forbidden state :: State
state = State
state { sForbidden :: Maybe Pattern
sForbidden = Maybe Pattern
forbidden }
{-# INLINE setForbidden #-}

-- | @setCode code state@ sets the @sCode@ field to /code/.
setCode :: Code -> State -> State
setCode :: Code -> State -> State
setCode code :: Code
code state :: State
state = State
state { sCode :: Code
sCode = Code
code }
{-# INLINE setCode #-}

-- ** Implicit parsers
--
-- It is tedious to have to wrap each expected character (or character range)
-- in an explicit 'Parse' constructor. We let Haskell do that for us using a
-- 'Match' class.

-- | @Match parameter result@ specifies that we can convert the /parameter/ to
-- a 'Data.YAML.Token.Parser' returning the /result/.
class Match parameter result | parameter -> result where
    match :: parameter -> Parser result

-- | We don't need to convert a 'Data.YAML.Token.Parser', it already is one.
instance Match (Parser result) result where
    match :: Parser result -> Parser result
match = Parser result -> Parser result
forall a. a -> a
id

-- | We convert 'Char' to a parser for a character (that returns nothing).
instance Match Char () where
    match :: Char -> Pattern
match code :: Char
code = (Char -> Bool) -> Pattern
nextIf (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
code)

-- | We convert a 'Char' tuple to a parser for a character range (that returns
-- nothing).
instance Match (Char, Char) () where
    match :: (Char, Char) -> Pattern
match (low :: Char
low, high :: Char
high) = (Char -> Bool) -> Pattern
nextIf ((Char -> Bool) -> Pattern) -> (Char -> Bool) -> Pattern
forall a b. (a -> b) -> a -> b
$ \ code :: Char
code -> Char
low Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
code Bool -> Bool -> Bool
&& Char
code Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
high

-- | We convert 'String' to a parser for a sequence of characters (that returns
-- nothing).
instance Match String () where
    match :: String -> Pattern
match = (Char -> Pattern -> Pattern) -> Pattern -> String -> Pattern
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> Pattern -> Pattern
forall match1 result1 match2 result2.
(Match match1 result1, Match match2 result2) =>
match1 -> match2 -> Parser result2
(&) Pattern
empty

-- ** Reply constructors

-- | @returnReply state result@ prepares a 'Reply' with the specified /state/
-- and /result/.
returnReply :: State -> result -> Reply result
returnReply :: State -> result -> Reply result
returnReply state :: State
state result :: result
result = $WReply :: forall result.
Result result
-> DList Token -> Maybe Decision -> State -> Reply result
Reply { rResult :: Result result
rResult = result -> Result result
forall result. result -> Result result
Result result
result,
                                   rTokens :: DList Token
rTokens = DList Token
forall a. DList a
D.empty,
                                   rCommit :: Maybe Decision
rCommit = Maybe Decision
forall a. Maybe a
Nothing,
                                   rState :: State
rState  = State
state }

-- | @tokenReply state token@ returns a 'Reply' containing the /state/ and
-- /token/. Any collected characters are cleared (either there are none, or we
-- put them in this token, or we don't want them).
tokenReply :: State -> Token -> Reply ()
tokenReply :: State -> Token -> Reply ()
tokenReply state :: State
state token :: Token
token = $WReply :: forall result.
Result result
-> DList Token -> Maybe Decision -> State -> Reply result
Reply { rResult :: Result ()
rResult = () -> Result ()
forall result. result -> Result result
Result (),
                                 rTokens :: DList Token
rTokens = Token -> DList Token
forall a. a -> DList a
D.singleton Token
token,
                                 rCommit :: Maybe Decision
rCommit = Maybe Decision
forall a. Maybe a
Nothing,
                                 rState :: State
rState  = State
state { sCharsByteOffset :: Int
sCharsByteOffset = -1,
                                                   sCharsCharOffset :: Int
sCharsCharOffset = -1,
                                                   sCharsLine :: Int
sCharsLine       = -1,
                                                   sCharsLineChar :: Int
sCharsLineChar   = -1,
                                                   sChars :: String
sChars           = [] } }

-- | @failReply state message@ prepares a 'Reply' with the specified /state/
-- and error /message/.
failReply :: State -> String -> Reply result
failReply :: State -> String -> Reply result
failReply state :: State
state message :: String
message = $WReply :: forall result.
Result result
-> DList Token -> Maybe Decision -> State -> Reply result
Reply { rResult :: Result result
rResult = String -> Result result
forall result. String -> Result result
Failed String
message,
                                  rTokens :: DList Token
rTokens = DList Token
forall a. DList a
D.empty,
                                  rCommit :: Maybe Decision
rCommit = Maybe Decision
forall a. Maybe a
Nothing,
                                  rState :: State
rState  = State
state }

-- | @unexpectedReply state@ returns a @failReply@ for an unexpected character.
unexpectedReply :: State -> Reply result
unexpectedReply :: State -> Reply result
unexpectedReply state :: State
state = case State
stateState -> (State -> [(Int, Char)]) -> [(Int, Char)]
forall record value. record -> (record -> value) -> value
^.State -> [(Int, Char)]
sInput of
                             ((_, char :: Char
char):_) -> State -> String -> Reply result
forall result. State -> String -> Reply result
failReply State
state (String -> Reply result) -> String -> Reply result
forall a b. (a -> b) -> a -> b
$ "Unexpected '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
char] String -> ShowS
forall a. [a] -> [a] -> [a]
++ "'"
                             []            -> State -> String -> Reply result
forall result. State -> String -> Reply result
failReply State
state "Unexpected end of input"


instance Functor Parser where
  fmap :: (a -> b) -> Parser a -> Parser b
fmap g :: a -> b
g f :: Parser a
f = (State -> Reply b) -> Parser b
forall result. (State -> Reply result) -> Parser result
Parser ((State -> Reply b) -> Parser b) -> (State -> Reply b) -> Parser b
forall a b. (a -> b) -> a -> b
$ \state :: State
state ->
    let reply :: Reply a
reply = Parser a -> State -> Reply a
forall result. Parser result -> State -> Reply result
applyParser Parser a
f State
state
    in case Reply a
replyReply a -> (Reply a -> Result a) -> Result a
forall record value. record -> (record -> value) -> value
^.Reply a -> Result a
forall result. Reply result -> Result result
rResult of
       Failed message :: String
message -> Reply a
reply { rResult :: Result b
rResult = String -> Result b
forall result. String -> Result result
Failed String
message }
       Result x :: a
x       -> Reply a
reply { rResult :: Result b
rResult = b -> Result b
forall result. result -> Result result
Result (a -> b
g a
x) }
       More parser :: Parser a
parser    -> Reply a
reply { rResult :: Result b
rResult = Parser b -> Result b
forall result. Parser result -> Result result
More (Parser b -> Result b) -> Parser b -> Result b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
g Parser a
parser }


instance Applicative Parser where
  pure :: a -> Parser a
pure result :: a
result = (State -> Reply a) -> Parser a
forall result. (State -> Reply result) -> Parser result
Parser ((State -> Reply a) -> Parser a) -> (State -> Reply a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \state :: State
state -> State -> a -> Reply a
forall result. State -> result -> Reply result
returnReply State
state a
result

  <*> :: Parser (a -> b) -> Parser a -> Parser b
(<*>) = Parser (a -> b) -> Parser a -> Parser b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

  left :: Parser a
left *> :: Parser a -> Parser b -> Parser b
*> right :: Parser b
right = (State -> Reply b) -> Parser b
forall result. (State -> Reply result) -> Parser result
Parser ((State -> Reply b) -> Parser b) -> (State -> Reply b) -> Parser b
forall a b. (a -> b) -> a -> b
$ \state :: State
state ->
    let reply :: Reply a
reply = Parser a -> State -> Reply a
forall result. Parser result -> State -> Reply result
applyParser Parser a
left State
state
    in case Reply a
replyReply a -> (Reply a -> Result a) -> Result a
forall record value. record -> (record -> value) -> value
^.Reply a -> Result a
forall result. Reply result -> Result result
rResult of
       Failed message :: String
message -> Reply a
reply { rResult :: Result b
rResult = String -> Result b
forall result. String -> Result result
Failed String
message }
       Result _       -> Reply a
reply { rResult :: Result b
rResult = Parser b -> Result b
forall result. Parser result -> Result result
More Parser b
right }
       More parser :: Parser a
parser    -> Reply a
reply { rResult :: Result b
rResult = Parser b -> Result b
forall result. Parser result -> Result result
More (Parser b -> Result b) -> Parser b -> Result b
forall a b. (a -> b) -> a -> b
$ Parser a
parser Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser b
right }

-- | Allow using the @do@ notation for our parsers, which makes for short and
-- sweet @do@ syntax when we want to examine the results (we typically don't).
instance Monad Parser where

  -- @return result@ does just that - return a /result/.
  return :: a -> Parser a
return = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  -- @left >>= right@ applies the /left/ parser, and if it didn't fail
  -- applies the /right/ one (well, the one /right/ returns).
  left :: Parser a
left >>= :: Parser a -> (a -> Parser b) -> Parser b
>>= right :: a -> Parser b
right = (State -> Reply b) -> Parser b
forall result. (State -> Reply result) -> Parser result
Parser ((State -> Reply b) -> Parser b) -> (State -> Reply b) -> Parser b
forall a b. (a -> b) -> a -> b
$ \state :: State
state ->
    let reply :: Reply a
reply = Parser a -> State -> Reply a
forall result. Parser result -> State -> Reply result
applyParser Parser a
left State
state
    in case Reply a
replyReply a -> (Reply a -> Result a) -> Result a
forall record value. record -> (record -> value) -> value
^.Reply a -> Result a
forall result. Reply result -> Result result
rResult of
       Failed message :: String
message -> Reply a
reply { rResult :: Result b
rResult = String -> Result b
forall result. String -> Result result
Failed String
message }
       Result value :: a
value   -> Reply a
reply { rResult :: Result b
rResult = Parser b -> Result b
forall result. Parser result -> Result result
More (Parser b -> Result b) -> Parser b -> Result b
forall a b. (a -> b) -> a -> b
$ a -> Parser b
right a
value }
       More parser :: Parser a
parser    -> Reply a
reply { rResult :: Result b
rResult = Parser b -> Result b
forall result. Parser result -> Result result
More (Parser b -> Result b) -> Parser b -> Result b
forall a b. (a -> b) -> a -> b
$ Parser a
parser Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Parser b
right }

  >> :: Parser a -> Parser b -> Parser b
(>>) = Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

-- | @fail message@ does just that - fails with a /message/.
pfail :: String -> Parser a
pfail :: String -> Parser a
pfail message :: String
message = (State -> Reply a) -> Parser a
forall result. (State -> Reply result) -> Parser result
Parser ((State -> Reply a) -> Parser a) -> (State -> Reply a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \state :: State
state -> State -> String -> Reply a
forall result. State -> String -> Reply result
failReply State
state String
message

-- ** Parsing operators
--
-- Here we reap the benefits of renaming the numerical operators. The Operator
-- precedence, in decreasing strength:
--
-- @repeated % n@, @repeated <% n@, @match - rejected@, @match ! decision@,
-- @match ?! decision@, @choice ^ (first \/ second)@.
--
-- @match - first - second@ is @(match - first) - second@.
--
-- @first & second & third@ is @first & (second & third)@. Note that @first -
-- rejected & second@ is @(first - rejected) & second@, etc.
--
-- @match \/ alternative \/ otherwise@ is @match \/ (alternative \/
-- otherwise)@. Note that @first & second \/ third@ is @(first & second) \/
-- third@.
--
-- @( match *)@, @(match +)@, @(match ?)@, @(match <?)@, @(match >?)@, @(match
-- >!)@, @(match <!)@ are the weakest and require the surrounding @()@.

infix  3 ^
infix  3 %
infix  3 <%
infix  3 !
infix  3 ?!
infixl 3 -
infixr 2 &
infixr 1 /
infix  0 ?
infix  0 *
infix  0 +
infix  0 <?
infix  0 >?
infix  0 >!

-- | @parser % n@ repeats /parser/ exactly /n/ times.
(%) :: (Match match result) => match -> Int -> Pattern
parser :: match
parser % :: match -> Int -> Pattern
% n :: Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0    = Pattern
empty
  | Bool
otherwise = Parser result
parser' Parser result -> Pattern -> Pattern
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser result
parser' Parser result -> Int -> Pattern
forall match result. Match match result => match -> Int -> Pattern
% Int
n Int -> Int -> Int
.- 1)
  where
    parser' :: Parser result
parser' = match -> Parser result
forall parameter result.
Match parameter result =>
parameter -> Parser result
match match
parser

-- | @parser <% n@ matches fewer than /n/ occurrences of /parser/.
(<%) :: (Match match result) => match -> Int -> Pattern
parser :: match
parser <% :: match -> Int -> Pattern
<% n :: Int
n = case Int
n Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` 1 of
  LT -> String -> Pattern
forall a. String -> Parser a
pfail "Fewer than 0 repetitions"
  EQ -> match -> Maybe String -> Pattern
forall match result.
Match match result =>
match -> Maybe String -> Pattern
reject match
parser Maybe String
forall a. Maybe a
Nothing
  GT -> Decision
DeLess Decision -> Pattern -> Pattern
forall match result.
Match match result =>
Decision -> match -> Parser result
^ ( ((match
parser match -> Decision -> Pattern
forall match result.
Match match result =>
match -> Decision -> Pattern
! Decision
DeLess) Pattern -> Pattern -> Pattern
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (match
parser match -> Int -> Pattern
forall match result. Match match result => match -> Int -> Pattern
<% Int
n Int -> Int -> Int
.- 1)) Pattern -> Pattern -> Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern
empty )

data Decision = DeNone -- ""
              | DeStar -- "*"
              | DeLess -- "<%"
              | DeDirective
              | DeDoc
              | DeEscape
              | DeEscaped
              | DeFold
              | DeKey
              | DeHeader
              | DeMore
              | DeNode
              | DePair
              deriving (Int -> Decision -> ShowS
[Decision] -> ShowS
Decision -> String
(Int -> Decision -> ShowS)
-> (Decision -> String) -> ([Decision] -> ShowS) -> Show Decision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Decision] -> ShowS
$cshowList :: [Decision] -> ShowS
show :: Decision -> String
$cshow :: Decision -> String
showsPrec :: Int -> Decision -> ShowS
$cshowsPrec :: Int -> Decision -> ShowS
Show,Decision -> Decision -> Bool
(Decision -> Decision -> Bool)
-> (Decision -> Decision -> Bool) -> Eq Decision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Decision -> Decision -> Bool
$c/= :: Decision -> Decision -> Bool
== :: Decision -> Decision -> Bool
$c== :: Decision -> Decision -> Bool
Eq)

-- | @decision ^ (option \/ option \/ ...)@ provides a /decision/ name to the
-- choice about to be made, to allow to @commit@ to it.
(^) :: (Match match result) => Decision -> match -> Parser result
decision :: Decision
decision ^ :: Decision -> match -> Parser result
^ parser :: match
parser = Decision -> Parser result -> Parser result
forall result. Decision -> Parser result -> Parser result
choice Decision
decision (Parser result -> Parser result) -> Parser result -> Parser result
forall a b. (a -> b) -> a -> b
$ match -> Parser result
forall parameter result.
Match parameter result =>
parameter -> Parser result
match match
parser

-- | @parser ! decision@ commits to /decision/ (in an option) after
-- successfully matching the /parser/.
(!) :: (Match match result) => match -> Decision -> Pattern
parser :: match
parser ! :: match -> Decision -> Pattern
! decision :: Decision
decision = match -> Parser result
forall parameter result.
Match parameter result =>
parameter -> Parser result
match match
parser Parser result -> Pattern -> Pattern
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Decision -> Pattern
commit Decision
decision

-- | @parser ?! decision@ commits to /decision/ (in an option) if the current
-- position matches /parser/, without consuming any characters.
(?!) :: (Match match result) => match -> Decision -> Pattern
parser :: match
parser ?! :: match -> Decision -> Pattern
?! decision :: Decision
decision = match -> Parser result
forall parameter result.
Match parameter result =>
parameter -> Parser result
peek match
parser Parser result -> Pattern -> Pattern
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Decision -> Pattern
commit Decision
decision

-- | @lookbehind <?@ matches the current point without consuming any
-- characters, if the previous character matches the lookbehind parser (single
-- character positive lookbehind)
(<?) :: (Match match result) => match -> Parser result
<? :: match -> Parser result
(<?) lookbehind :: match
lookbehind = match -> Parser result
forall parameter result.
Match parameter result =>
parameter -> Parser result
prev match
lookbehind

-- | @lookahead >?@ matches the current point without consuming any characters
-- if it matches the lookahead parser (positive lookahead)
(>?) :: (Match match result) => match -> Parser result
>? :: match -> Parser result
(>?) lookahead :: match
lookahead = match -> Parser result
forall parameter result.
Match parameter result =>
parameter -> Parser result
peek match
lookahead

-- | @lookahead >?@ matches the current point without consuming any characters
-- if it matches the lookahead parser (negative lookahead)
(>!) :: (Match match result) => match -> Pattern
>! :: match -> Pattern
(>!) lookahead :: match
lookahead = match -> Maybe String -> Pattern
forall match result.
Match match result =>
match -> Maybe String -> Pattern
reject match
lookahead Maybe String
forall a. Maybe a
Nothing

-- | @parser - rejected@ matches /parser/, except if /rejected/ matches at this
-- point.
(-) :: (Match match1 result1, Match match2 result2) => match1 -> match2 -> Parser result1
parser :: match1
parser - :: match1 -> match2 -> Parser result1
- rejected :: match2
rejected = match2 -> Maybe String -> Pattern
forall match result.
Match match result =>
match -> Maybe String -> Pattern
reject match2
rejected Maybe String
forall a. Maybe a
Nothing Pattern -> Parser result1 -> Parser result1
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> match1 -> Parser result1
forall parameter result.
Match parameter result =>
parameter -> Parser result
match match1
parser

-- | @before & after@ parses /before/ and, if it succeeds, parses /after/. This
-- basically invokes the monad's @>>=@ (bind) method.
(&) :: (Match match1 result1, Match match2 result2) => match1 -> match2 -> Parser result2
before :: match1
before & :: match1 -> match2 -> Parser result2
& after :: match2
after = match1 -> Parser result1
forall parameter result.
Match parameter result =>
parameter -> Parser result
match match1
before Parser result1 -> Parser result2 -> Parser result2
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> match2 -> Parser result2
forall parameter result.
Match parameter result =>
parameter -> Parser result
match match2
after

-- | @first \/ second@ tries to parse /first/, and failing that parses
-- /second/, unless /first/ has committed in which case is fails immediately.
(/) :: (Match match1 result, Match match2 result) => match1 -> match2 -> Parser result
first :: match1
first / :: match1 -> match2 -> Parser result
/ second :: match2
second = (State -> Reply result) -> Parser result
forall result. (State -> Reply result) -> Parser result
Parser ((State -> Reply result) -> Parser result)
-> (State -> Reply result) -> Parser result
forall a b. (a -> b) -> a -> b
$ Parser result -> State -> Reply result
forall result. Parser result -> State -> Reply result
applyParser (match1 -> Parser result
forall parameter result.
Match parameter result =>
parameter -> Parser result
match match1
first Parser result -> Parser result -> Parser result
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> match2 -> Parser result
forall parameter result.
Match parameter result =>
parameter -> Parser result
match match2
second)

-- | @(optional ?)@ tries to match /parser/, otherwise does nothing.
(?) :: (Match match result) => match -> Pattern
? :: match -> Pattern
(?) optional :: match
optional = (match -> Parser result
forall parameter result.
Match parameter result =>
parameter -> Parser result
match match
optional Parser result -> Pattern -> Pattern
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern
empty) Pattern -> Pattern -> Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern
empty

-- | @(parser *)@ matches zero or more occurrences of /repeat/, as long as each
-- one actually consumes input characters.
(*) :: (Match match result) => match -> Pattern
* :: match -> Pattern
(*) parser :: match
parser = Decision
DeStar Decision -> Pattern -> Pattern
forall match result.
Match match result =>
Decision -> match -> Parser result
^ Pattern
zomParser
  where
    zomParser :: Pattern
zomParser = ((match
parser match -> Decision -> Pattern
forall match result.
Match match result =>
match -> Decision -> Pattern
! Decision
DeStar) Pattern -> Pattern -> Pattern
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pattern -> Pattern
forall parameter result.
Match parameter result =>
parameter -> Parser result
match Pattern
zomParser) Pattern -> Pattern -> Pattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pattern
empty

-- | @(parser +)@ matches one or more occurrences of /parser/, as long as each
-- one actually consumed input characters.
(+) :: (Match match result) => match -> Pattern
+ :: match -> Pattern
(+) parser :: match
parser = match -> Parser result
forall parameter result.
Match parameter result =>
parameter -> Parser result
match match
parser Parser result -> Pattern -> Pattern
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (match
parser match -> Pattern
forall match result. Match match result => match -> Pattern
*)

-- ** Basic parsers

-- | @first <|> second@ tries to parse /first/, and failing that parses
-- /second/, unless /first/ has committed in which case is fails immediately.
instance Alternative Parser where
  empty :: Parser a
empty = String -> Parser a
forall a. String -> Parser a
pfail "empty"

  left :: Parser a
left <|> :: Parser a -> Parser a -> Parser a
<|> right :: Parser a
right = (State -> Reply a) -> Parser a
forall result. (State -> Reply result) -> Parser result
Parser ((State -> Reply a) -> Parser a) -> (State -> Reply a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \state :: State
state -> State -> DList Token -> Parser a -> Parser a -> State -> Reply a
forall result.
State
-> DList Token
-> Parser result
-> Parser result
-> State
-> Reply result
decideParser State
state DList Token
forall a. DList a
D.empty Parser a
left Parser a
right State
state
    where
      decideParser :: State
-> DList Token
-> Parser result
-> Parser result
-> State
-> Reply result
decideParser point :: State
point tokens :: DList Token
tokens left :: Parser result
left right :: Parser result
right state :: State
state =
        let reply :: Reply result
reply = Parser result -> State -> Reply result
forall result. Parser result -> State -> Reply result
applyParser Parser result
left State
state
            tokens' :: DList Token
tokens' = DList Token -> DList Token -> DList Token
forall a. DList a -> DList a -> DList a
D.append DList Token
tokens (DList Token -> DList Token) -> DList Token -> DList Token
forall a b. (a -> b) -> a -> b
$ Reply result
replyReply result -> (Reply result -> DList Token) -> DList Token
forall record value. record -> (record -> value) -> value
^.Reply result -> DList Token
forall result. Reply result -> DList Token
rTokens
        in case (Reply result
replyReply result -> (Reply result -> Result result) -> Result result
forall record value. record -> (record -> value) -> value
^.Reply result -> Result result
forall result. Reply result -> Result result
rResult, Reply result
replyReply result -> (Reply result -> Maybe Decision) -> Maybe Decision
forall record value. record -> (record -> value) -> value
^.Reply result -> Maybe Decision
forall result. Reply result -> Maybe Decision
rCommit) of
                (Failed _,    _)      -> $WReply :: forall result.
Result result
-> DList Token -> Maybe Decision -> State -> Reply result
Reply { rState :: State
rState  = State
point,
                                                 rTokens :: DList Token
rTokens = DList Token
forall a. DList a
D.empty,
                                                 rResult :: Result result
rResult = Parser result -> Result result
forall result. Parser result -> Result result
More Parser result
right,
                                                 rCommit :: Maybe Decision
rCommit = Maybe Decision
forall a. Maybe a
Nothing }
                (Result _,   _)       -> Reply result
reply { rTokens :: DList Token
rTokens = DList Token
tokens' }
                (More _, Just _)      -> Reply result
reply { rTokens :: DList Token
rTokens = DList Token
tokens' }
                (More left' :: Parser result
left', Nothing) -> State
-> DList Token
-> Parser result
-> Parser result
-> State
-> Reply result
decideParser State
point DList Token
tokens' Parser result
left' Parser result
right (Reply result
replyReply result -> (Reply result -> State) -> State
forall record value. record -> (record -> value) -> value
^.Reply result -> State
forall result. Reply result -> State
rState)


-- | @choice decision parser@ provides a /decision/ name to the choice about to
-- be made in /parser/, to allow to @commit@ to it.
choice :: Decision -> Parser result -> Parser result
choice :: Decision -> Parser result -> Parser result
choice decision :: Decision
decision parser :: Parser result
parser = (State -> Reply result) -> Parser result
forall result. (State -> Reply result) -> Parser result
Parser ((State -> Reply result) -> Parser result)
-> (State -> Reply result) -> Parser result
forall a b. (a -> b) -> a -> b
$ \ state :: State
state ->
  Parser result -> State -> Reply result
forall result. Parser result -> State -> Reply result
applyParser (Decision -> Decision -> Parser result -> Parser result
forall result.
Decision -> Decision -> Parser result -> Parser result
choiceParser (State
stateState -> (State -> Decision) -> Decision
forall record value. record -> (record -> value) -> value
^.State -> Decision
sDecision) Decision
decision Parser result
parser) State
state { sDecision :: Decision
sDecision = Decision
decision }
  where choiceParser :: Decision -> Decision -> Parser result -> Parser result
choiceParser parentDecision :: Decision
parentDecision makingDecision :: Decision
makingDecision parser :: Parser result
parser = (State -> Reply result) -> Parser result
forall result. (State -> Reply result) -> Parser result
Parser ((State -> Reply result) -> Parser result)
-> (State -> Reply result) -> Parser result
forall a b. (a -> b) -> a -> b
$ \ state :: State
state ->
          let reply :: Reply result
reply   = Parser result -> State -> Reply result
forall result. Parser result -> State -> Reply result
applyParser Parser result
parser State
state
              commit' :: Maybe Decision
commit' = case Reply result
replyReply result -> (Reply result -> Maybe Decision) -> Maybe Decision
forall record value. record -> (record -> value) -> value
^.Reply result -> Maybe Decision
forall result. Reply result -> Maybe Decision
rCommit of
                             Nothing                                    -> Maybe Decision
forall a. Maybe a
Nothing
                             Just decision :: Decision
decision | Decision
decision Decision -> Decision -> Bool
forall a. Eq a => a -> a -> Bool
== Decision
makingDecision -> Maybe Decision
forall a. Maybe a
Nothing
                                           | Bool
otherwise                  -> Reply result
replyReply result -> (Reply result -> Maybe Decision) -> Maybe Decision
forall record value. record -> (record -> value) -> value
^.Reply result -> Maybe Decision
forall result. Reply result -> Maybe Decision
rCommit
              reply' :: Reply result
reply'  = case Reply result
replyReply result -> (Reply result -> Result result) -> Result result
forall record value. record -> (record -> value) -> value
^.Reply result -> Result result
forall result. Reply result -> Result result
rResult of
                             More parser' :: Parser result
parser' -> Reply result
reply { rCommit :: Maybe Decision
rCommit = Maybe Decision
commit',
                                                     rResult :: Result result
rResult = Parser result -> Result result
forall result. Parser result -> Result result
More (Parser result -> Result result) -> Parser result -> Result result
forall a b. (a -> b) -> a -> b
$ Decision -> Decision -> Parser result -> Parser result
choiceParser Decision
parentDecision Decision
makingDecision Parser result
parser' }
                             _            -> Reply result
reply { rCommit :: Maybe Decision
rCommit = Maybe Decision
commit',
                                                     rState :: State
rState = (Reply result
replyReply result -> (Reply result -> State) -> State
forall record value. record -> (record -> value) -> value
^.Reply result -> State
forall result. Reply result -> State
rState) { sDecision :: Decision
sDecision = Decision
parentDecision } }
          in Reply result
reply'

-- | @parser ``recovery`` pattern@ parses the specified /parser/; if it fails,
-- it continues to the /recovery/ parser to recover.
recovery :: (Match match1 result) => match1 -> Parser result -> Parser result
recovery :: match1 -> Parser result -> Parser result
recovery pattern :: match1
pattern recover :: Parser result
recover =
  (State -> Reply result) -> Parser result
forall result. (State -> Reply result) -> Par