{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoFieldSelectors #-}

{-|
Implement the v2 parser specified at: https://kdl.dev/spec/#name-full-grammar
-}
module KDL.Parser.Internal (
  Parser,
  ParseConfig (..),
  runParser,

  -- * (1) Compatibility
  p_bom,
  p_version,

  -- * (3.1) Document
  p_document,
  p_nodes,
  p_line_space,
  p_node_space,

  -- * (3.2) Node
  p_node,
  p_base_node,
  p_node_prop_or_arg,
  p_node_terminator,

  -- * (3.3) Line Continuation
  p_escline,

  -- * (3.4) Property
  p_prop,

  -- * (3.5) Argument
  p_value'Entry,

  -- * (3.6) Children Block
  p_node_children,

  -- * (3.7) Value
  p_value,
  p_keyword,

  -- * (3.8) Type Annotation
  p_type,

  -- * (3.9) String
  p_string'Identifier,
  p_string,

  -- * (3.10) Identifier String
  p_identifier_string,
  isValidUnquotedString,
  p_unambiguous_ident,
  p_signed_ident,
  disallowed_keyword_identifiers,
  p_dotted_ident,
  p_identifier_char,

  -- * (3.11) Quoted String
  p_quoted_string,
  p_single_line_string_body,
  p_string_character,
  p_hex_unicode,
  p_ws_escape,

  -- * (3.12) Multi-line String
  p_multi_line_string_body,

  -- * (3.13) Raw String
  p_raw_string,
  p_raw_string_quotes,
  p_single_line_raw_string_body,
  p_single_line_raw_string_char,
  p_multi_line_raw_string_body,

  -- * (3.14) Number
  p_number,
  p_hex,
  p_hex_digit,
  p_octal,
  p_binary,
  p_decimal,
  p_integer,
  p_digits,
  p_exponent,
  p_sign,
  p_keyword_number,

  -- * (3.15) Boolean
  p_boolean,

  -- * (3.17) Whitespace
  p_ws,
  p_unicode_space,
  p_single_line_comment,
  p_multi_line_comment,
  p_slashdash,

  -- * (3.18) Newline
  p_newline,

  -- * (3.19) Disallowed Literal Code Points
  is_disallowed_literal_code_points,

  -- * Unicode
  p_unicode,
  is_unicode_scalar_value,
) where

import Control.Monad (guard, void, (>=>))
import Control.Monad.Trans.Class qualified as Trans
import Control.Monad.Trans.Reader qualified as Reader
import Control.Monad.Trans.State.Strict (StateT, evalStateT)
import Control.Monad.Trans.State.Strict qualified as State
import Data.Bifunctor (bimap)
import Data.Bits (toIntegralSized)
import Data.Char (
  chr,
  digitToInt,
  isDigit,
  isHexDigit,
  isOctDigit,
  isSpace,
  ord,
 )
import Data.Default (Default (..))
import Data.Either (isRight)
import Data.Foldable (foldlM, traverse_)
import Data.Foldable qualified as Seq (toList)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.Scientific (Scientific)
import Data.Scientific qualified as Scientific
import Data.Sequence qualified as Seq
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Void (Void)
import KDL.Types (
  Ann (..),
  AnnExtension (..),
  AnnFormat (..),
  Document,
  Entry (..),
  EntryExtension (..),
  EntryFormat (..),
  Identifier (..),
  IdentifierExtension (..),
  IdentifierFormat (..),
  Node (..),
  NodeExtension (..),
  NodeFormat (..),
  NodeList (..),
  NodeListExtension (..),
  NodeListFormat (..),
  Span (..),
  Value (..),
  ValueData (..),
  ValueExtension (..),
  ValueFormat (..),
 )
import KDL.Types qualified as AnnExtension (AnnExtension (..))
import KDL.Types qualified as AnnFormat (AnnFormat (..))
import KDL.Types qualified as EntryExtension (EntryExtension (..))
import KDL.Types qualified as EntryFormat (EntryFormat (..))
import KDL.Types qualified as Node (Node (..))
import KDL.Types qualified as NodeExtension (NodeExtension (..))
import KDL.Types qualified as NodeFormat (NodeFormat (..))
import KDL.Types qualified as NodeListExtension (NodeListExtension (..))
import KDL.Types qualified as NodeListFormat (NodeListFormat (..))
import Text.Megaparsec hiding (runParser)
import Text.Megaparsec.Char
import Prelude hiding (span)

#if !MIN_VERSION_base(4,20,0)
import Data.Foldable (foldl')
#endif

data ParseConfig = ParseConfig
  { ParseConfig -> String
filepath :: FilePath
  , ParseConfig -> Bool
includeSpans :: Bool
  }

instance Default ParseConfig where
  def :: ParseConfig
def =
    ParseConfig
      { filepath :: String
filepath = String
""
      , includeSpans :: Bool
includeSpans = Bool
False
      }

type Parser = ParsecT Void Text (Reader.Reader ParseConfig)

runParser :: ParseConfig -> Parser a -> Text -> Either (ParseErrorBundle Text Void) a
runParser :: forall a.
ParseConfig
-> Parser a -> Text -> Either (ParseErrorBundle Text Void) a
runParser ParseConfig
config Parser a
p = (Reader ParseConfig (Either (ParseErrorBundle Text Void) a)
-> ParseConfig -> Either (ParseErrorBundle Text Void) a
forall r a. Reader r a -> r -> a
`Reader.runReader` ParseConfig
config) (Reader ParseConfig (Either (ParseErrorBundle Text Void) a)
 -> Either (ParseErrorBundle Text Void) a)
-> (Text
    -> Reader ParseConfig (Either (ParseErrorBundle Text Void) a))
-> Text
-> Either (ParseErrorBundle Text Void) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a
-> String
-> Text
-> Reader ParseConfig (Either (ParseErrorBundle Text Void) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT Parser a
p ParseConfig
config.filepath

{----- (1) Compatibility -----}

-- | ref: (1)
-- bom := '\u{FEFF}'
p_bom :: Parser ()
p_bom :: Parser ()
p_bom = String -> Parser () -> Parser ()
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"BOM" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Void Text (Reader ParseConfig) (Tokens Text) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text (Reader ParseConfig) (Tokens Text) -> Parser ())
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\xFEFF"

-- | ref: (1)
-- version :=
--     '/-' unicode-space* 'kdl-version' unicode-space+ ('1' | '2')
--     unicode-space* newline
p_version :: Parser ()
p_version :: Parser ()
p_version = String -> Parser () -> Parser ()
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"version" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"/-"
  String
_ <- ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text (Reader ParseConfig) Char
p_unicode_space
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"kdl-version"
  String
_ <- ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text (Reader ParseConfig) Char
p_unicode_space
  Token Text
_ <- [Token Text] -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'1', Char
'2']
  String
_ <- ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text (Reader ParseConfig) Char
p_unicode_space
  Text
_ <- Parser Text
p_newline
  () -> Parser ()
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{----- (3.1) Document -----}

-- | ref: (3.1)
-- document := bom? version? nodes
p_document :: Parser Document
p_document :: Parser Document
p_document = do
  Text
bom <- Parser Text -> Parser Text
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (Parser Text -> Parser Text)
-> (Parser () -> Parser Text) -> Parser () -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Parser Text -> Parser Text
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" (Parser Text -> Parser Text)
-> (Parser () -> Parser Text) -> Parser () -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser () -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser () -> Parser Text) -> Parser () -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser ()
p_bom
  Text
version <- Parser Text -> Parser Text
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (Parser Text -> Parser Text)
-> (Parser () -> Parser Text) -> Parser () -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Parser Text -> Parser Text
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" (Parser Text -> Parser Text)
-> (Parser () -> Parser Text) -> Parser () -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser () -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser () -> Parser Text) -> Parser () -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser ()
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser ()
p_version
  Document
nodes <- Parser Document
p_nodes
  Parser () -> Parser ()
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  Document -> Parser Document
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Document -> Parser Document)
-> (Document -> Document) -> Document -> Parser Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Document -> Document
forall a. HasWsFormat a => Text -> a -> a
prependLeading Text
bom (Document -> Document)
-> (Document -> Document) -> Document -> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Document -> Document
forall a. HasWsFormat a => Text -> a -> a
prependLeading Text
version (Document -> Parser Document) -> Document -> Parser Document
forall a b. (a -> b) -> a -> b
$ Document
nodes

-- | ref: (3.1)
-- nodes := (line-space* node)* line-space*
p_nodes :: Parser NodeList
p_nodes :: Parser Document
p_nodes = String -> Parser Document -> Parser Document
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"nodes" (Parser Document -> Parser Document)
-> Parser Document -> Parser Document
forall a b. (a -> b) -> a -> b
$ do
  -- The grammar is left-associative, but we do right-associative to get
  -- correct backtracking semantics + good parse errors
  Text
initialWS <- Parser [()] -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser [()] -> Parser Text) -> Parser [()] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_line_space
  ([Either Text Node]
results, Span
span) <- Parser [Either Text Node] -> Parser ([Either Text Node], Span)
forall a. Parser a -> Parser (a, Span)
withSpan (Parser [Either Text Node] -> Parser ([Either Text Node], Span))
-> (Parser ([Either Text Node], Bool) -> Parser [Either Text Node])
-> Parser ([Either Text Node], Bool)
-> Parser ([Either Text Node], Span)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Either Text Node]] -> [Either Text Node])
-> ParsecT Void Text (Reader ParseConfig) [[Either Text Node]]
-> Parser [Either Text Node]
forall a b.
(a -> b)
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Either Text Node]] -> [Either Text Node]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ParsecT Void Text (Reader ParseConfig) [[Either Text Node]]
 -> Parser [Either Text Node])
-> (Parser ([Either Text Node], Bool)
    -> ParsecT Void Text (Reader ParseConfig) [[Either Text Node]])
-> Parser ([Either Text Node], Bool)
-> Parser [Either Text Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ([Either Text Node], Bool)
-> ParsecT Void Text (Reader ParseConfig) [[Either Text Node]]
forall a. Parser (a, Bool) -> Parser [a]
manyWhile (Parser ([Either Text Node], Bool)
 -> Parser ([Either Text Node], Span))
-> Parser ([Either Text Node], Bool)
-> Parser ([Either Text Node], Span)
forall a b. (a -> b) -> a -> b
$ do
    (SlashdashResult
sdash, Parser (Node, Bool)
parseNode) <- Parser (SlashdashResult, Parser (Node, Bool))
p_node
    (Either Text Node
result, Bool
continue) <-
      SlashdashResult
-> Parser (Node, Bool) -> Parser (Either Text (Node, Bool))
forall a. SlashdashResult -> Parser a -> Parser (Either Text a)
resolveSlashdash SlashdashResult
sdash Parser (Node, Bool)
parseNode Parser (Either Text (Node, Bool))
-> (Either Text (Node, Bool)
    -> ParsecT Void Text (Reader ParseConfig) (Either Text Node, Bool))
-> ParsecT Void Text (Reader ParseConfig) (Either Text Node, Bool)
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> (a -> ParsecT Void Text (Reader ParseConfig) b)
-> ParsecT Void Text (Reader ParseConfig) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left Text
src -> (Either Text Node, Bool)
-> ParsecT Void Text (Reader ParseConfig) (Either Text Node, Bool)
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either Text Node
forall a b. a -> Either a b
Left Text
src, Bool
True)
        Right (Node
node, Bool
hasTerminator) -> (Either Text Node, Bool)
-> ParsecT Void Text (Reader ParseConfig) (Either Text Node, Bool)
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Node -> Either Text Node
forall a b. b -> Either a b
Right Node
node, Bool
hasTerminator)
    Text
trailing <- Parser [()] -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser [()] -> Parser Text) -> Parser [()] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_line_space
    ([Either Text Node], Bool) -> Parser ([Either Text Node], Bool)
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either Text Node
result, Text -> Either Text Node
forall a b. a -> Either a b
Left Text
trailing], Bool
continue)
  let ([Node]
nodes, Text
leftoverWS) = Text -> [Either Text Node] -> ([Node], Text)
forall a. HasWsFormat a => Text -> [Either Text a] -> ([a], Text)
mergeLeadingWS Text
initialWS [Either Text Node]
results
  -- If there are no nodes, all the whitespace should be considered leading
  -- whitespace. Otherwise, the leftover whitespace (e.g. slashdashed nodes
  -- at the end) are trailing whitespace.
  let (Text
leading, Text
trailing) =
        if [Node] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Node]
nodes
          then (Text
leftoverWS, Text
"")
          else (Text
"", Text
leftoverWS)
      ext :: NodeListExtension
ext =
        NodeListExtension
          { format :: Maybe NodeListFormat
format = NodeListFormat -> Maybe NodeListFormat
forall a. a -> Maybe a
Just NodeListFormat{Text
leading :: Text
trailing :: Text
trailing :: Text
leading :: Text
..}
          , Span
span :: Span
span :: Span
span
          }
  Document -> Parser Document
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeList{[Node]
NodeListExtension
nodes :: [Node]
ext :: NodeListExtension
ext :: NodeListExtension
nodes :: [Node]
..}
 where
  manyWhile :: Parser (a, Bool) -> Parser [a]
  manyWhile :: forall a. Parser (a, Bool) -> Parser [a]
manyWhile Parser (a, Bool)
p =
    Parser (a, Bool)
-> ParsecT Void Text (Reader ParseConfig) (Maybe (a, Bool))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (a, Bool)
p ParsecT Void Text (Reader ParseConfig) (Maybe (a, Bool))
-> (Maybe (a, Bool) -> ParsecT Void Text (Reader ParseConfig) [a])
-> ParsecT Void Text (Reader ParseConfig) [a]
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> (a -> ParsecT Void Text (Reader ParseConfig) b)
-> ParsecT Void Text (Reader ParseConfig) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (a, Bool)
Nothing -> [a] -> ParsecT Void Text (Reader ParseConfig) [a]
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Just (a
a, Bool
continue) -> ([a] -> [a])
-> ParsecT Void Text (Reader ParseConfig) [a]
-> ParsecT Void Text (Reader ParseConfig) [a]
forall a b.
(a -> b)
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
a :) (ParsecT Void Text (Reader ParseConfig) [a]
 -> ParsecT Void Text (Reader ParseConfig) [a])
-> (ParsecT Void Text (Reader ParseConfig) [a]
    -> ParsecT Void Text (Reader ParseConfig) [a])
-> ParsecT Void Text (Reader ParseConfig) [a]
-> ParsecT Void Text (Reader ParseConfig) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a]
-> ParsecT Void Text (Reader ParseConfig) [a]
-> ParsecT Void Text (Reader ParseConfig) [a]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] (ParsecT Void Text (Reader ParseConfig) [a]
 -> ParsecT Void Text (Reader ParseConfig) [a])
-> ParsecT Void Text (Reader ParseConfig) [a]
-> ParsecT Void Text (Reader ParseConfig) [a]
forall a b. (a -> b) -> a -> b
$ if Bool
continue then Parser (a, Bool) -> ParsecT Void Text (Reader ParseConfig) [a]
forall a. Parser (a, Bool) -> Parser [a]
manyWhile Parser (a, Bool)
p else ParsecT Void Text (Reader ParseConfig) [a]
forall a. ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | ref: (3.1) + (3.17)
-- // Whitespace where newlines are allowed.
-- line-space := node-space | newline | single-line-comment
p_line_space :: Parser ()
p_line_space :: Parser ()
p_line_space = Parser () -> Parser ()
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
  Parser () -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> Parser ())
-> ([Parser ()] -> Parser ()) -> [Parser ()] -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parser ()] -> Parser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser ()] -> Parser ()) -> [Parser ()] -> Parser ()
forall a b. (a -> b) -> a -> b
$
    [ Parser ()
p_node_space
    , Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text
p_newline
    , Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text
p_single_line_comment
    ]

-- | ref: (3.1) + (3.17)
-- // Whitespace within nodes,
-- // where newline-ish things must be esclined.
-- node-space := ws* escline ws* | ws+
p_node_space :: Parser ()
p_node_space :: Parser ()
p_node_space = Parser () -> Parser ()
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Void Text (Reader ParseConfig) [Text] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text (Reader ParseConfig) [Text] -> Parser ())
-> ([ParsecT Void Text (Reader ParseConfig) [Text]]
    -> ParsecT Void Text (Reader ParseConfig) [Text])
-> [ParsecT Void Text (Reader ParseConfig) [Text]]
-> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT Void Text (Reader ParseConfig) [Text]]
-> ParsecT Void Text (Reader ParseConfig) [Text]
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT Void Text (Reader ParseConfig) [Text]]
 -> ParsecT Void Text (Reader ParseConfig) [Text])
-> ([ParsecT Void Text (Reader ParseConfig) [Text]]
    -> [ParsecT Void Text (Reader ParseConfig) [Text]])
-> [ParsecT Void Text (Reader ParseConfig) [Text]]
-> ParsecT Void Text (Reader ParseConfig) [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsecT Void Text (Reader ParseConfig) [Text]
 -> ParsecT Void Text (Reader ParseConfig) [Text])
-> [ParsecT Void Text (Reader ParseConfig) [Text]]
-> [ParsecT Void Text (Reader ParseConfig) [Text]]
forall a b. (a -> b) -> [a] -> [b]
map ParsecT Void Text (Reader ParseConfig) [Text]
-> ParsecT Void Text (Reader ParseConfig) [Text]
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ([ParsecT Void Text (Reader ParseConfig) [Text]] -> Parser ())
-> [ParsecT Void Text (Reader ParseConfig) [Text]] -> Parser ()
forall a b. (a -> b) -> a -> b
$
    [ Parser Text -> ParsecT Void Text (Reader ParseConfig) [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser Text
p_ws ParsecT Void Text (Reader ParseConfig) [Text]
-> Parser () -> Parser ()
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
p_escline Parser ()
-> ParsecT Void Text (Reader ParseConfig) [Text]
-> ParsecT Void Text (Reader ParseConfig) [Text]
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text -> ParsecT Void Text (Reader ParseConfig) [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser Text
p_ws
    , Parser Text -> ParsecT Void Text (Reader ParseConfig) [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser Text
p_ws
    ]

{----- (3.2) Node -----}

-- | ref: (3.2)
-- node := base-node node-terminator
-- final-node := base-node node-terminator?
p_node :: Parser (SlashdashResult, Parser (Node, Bool))
p_node :: Parser (SlashdashResult, Parser (Node, Bool))
p_node = String
-> Parser (SlashdashResult, Parser (Node, Bool))
-> Parser (SlashdashResult, Parser (Node, Bool))
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"node" (Parser (SlashdashResult, Parser (Node, Bool))
 -> Parser (SlashdashResult, Parser (Node, Bool)))
-> Parser (SlashdashResult, Parser (Node, Bool))
-> Parser (SlashdashResult, Parser (Node, Bool))
forall a b. (a -> b) -> a -> b
$ do
  (SlashdashResult
sdash, Parser Node
parseNode) <- Parser (SlashdashResult, Parser Node)
p_base_node
  (SlashdashResult, Parser (Node, Bool))
-> Parser (SlashdashResult, Parser (Node, Bool))
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((SlashdashResult, Parser (Node, Bool))
 -> Parser (SlashdashResult, Parser (Node, Bool)))
-> (Parser (Node, Bool) -> (SlashdashResult, Parser (Node, Bool)))
-> Parser (Node, Bool)
-> Parser (SlashdashResult, Parser (Node, Bool))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SlashdashResult
sdash,) (Parser (Node, Bool)
 -> Parser (SlashdashResult, Parser (Node, Bool)))
-> Parser (Node, Bool)
-> Parser (SlashdashResult, Parser (Node, Bool))
forall a b. (a -> b) -> a -> b
$ do
    SpanStart
spanStart <- Parser SpanStart
startSpan
    Node
node <- Parser Node
parseNode
    Maybe Text
mTerminator <- Parser Text -> ParsecT Void Text (Reader ParseConfig) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text
p_node_terminator
    Span
span <- SpanStart -> Parser Span
finishSpan SpanStart
spanStart
    let node' :: Node
node' =
          case Maybe Text
mTerminator of
            Just Text
terminator ->
              Node
node
                { Node.ext =
                    node.ext
                      { NodeExtension.format = setTerminator terminator <$> node.ext.format
                      , NodeExtension.span = span
                      }
                }
            Maybe Text
Nothing -> Node
node
    (Node, Bool) -> Parser (Node, Bool)
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Node
node', Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
mTerminator)
 where
  setTerminator :: Text -> NodeFormat -> NodeFormat
setTerminator Text
terminator NodeFormat
format =
    NodeFormat
format
      { NodeFormat.beforeTerminator = format.trailing
      , NodeFormat.terminator = terminator
      , NodeFormat.trailing = ""
      }

-- | ref: (3.2)
-- base-node := slashdash? type? node-space* string
--     (node-space* (node-space | slashdash) node-prop-or-arg)*
--     // slashdashed node-children must always be after props and args.
--     (node-space* slashdash node-children)*
--     (node-space* node-children)?
--     (node-space* slashdash node-children)*
--     node-space*
p_base_node :: Parser (SlashdashResult, Parser Node)
p_base_node :: Parser (SlashdashResult, Parser Node)
p_base_node = String
-> Parser (SlashdashResult, Parser Node)
-> Parser (SlashdashResult, Parser Node)
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"base node" (Parser (SlashdashResult, Parser Node)
 -> Parser (SlashdashResult, Parser Node))
-> Parser (SlashdashResult, Parser Node)
-> Parser (SlashdashResult, Parser Node)
forall a b. (a -> b) -> a -> b
$ do
  SlashdashResult
sdash <- SlashdashResult
-> ParsecT Void Text (Reader ParseConfig) SlashdashResult
-> ParsecT Void Text (Reader ParseConfig) SlashdashResult
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option SlashdashResult
NoSlashdash ParsecT Void Text (Reader ParseConfig) SlashdashResult
p_slashdash
  (SlashdashResult, Parser Node)
-> Parser (SlashdashResult, Parser Node)
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((SlashdashResult, Parser Node)
 -> Parser (SlashdashResult, Parser Node))
-> (Parser Node -> (SlashdashResult, Parser Node))
-> Parser Node
-> Parser (SlashdashResult, Parser Node)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SlashdashResult
sdash,) (Parser Node -> Parser (SlashdashResult, Parser Node))
-> Parser Node -> Parser (SlashdashResult, Parser Node)
forall a b. (a -> b) -> a -> b
$ do
    SpanStart
spanStart <- Parser SpanStart
startSpan

    -- node ann
    Maybe Ann
initialAnn <- ParsecT Void Text (Reader ParseConfig) Ann
-> ParsecT Void Text (Reader ParseConfig) (Maybe Ann)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text (Reader ParseConfig) Ann
p_type
    Text
postAnnWS <- Parser [()] -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser [()] -> Parser Text) -> Parser [()] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_node_space
    let (Maybe Ann
ann, Text
leading) =
          case Maybe Ann
initialAnn of
            Just Ann
a -> (Ann -> Maybe Ann
forall a. a -> Maybe a
Just (Ann -> Maybe Ann) -> Ann -> Maybe Ann
forall a b. (a -> b) -> a -> b
$ Text -> Ann -> Ann
forall a. HasWsFormat a => Text -> a -> a
appendTrailing Text
postAnnWS Ann
a, Text
"")
            Maybe Ann
Nothing -> (Maybe Ann
forall a. Maybe a
Nothing, Text
postAnnWS)

    -- node name
    Identifier
name <- Parser Identifier
p_string'Identifier

    -- node entries
    ([Entry]
entries, Text
postEntriesWS) <- Text -> [Either Text Entry] -> ([Entry], Text)
forall a. HasWsFormat a => Text -> [Either Text a] -> ([a], Text)
mergeLeadingWS Text
"" ([Either Text Entry] -> ([Entry], Text))
-> ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
-> ParsecT Void Text (Reader ParseConfig) ([Entry], Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
p_entries

    -- slashdashed node-children #1
    Text
slashdashedChildren1 <- Parser Text
p_slashdashed_children

    -- node children
    let unzipMaybe :: Maybe (a, a) -> (Maybe a, Maybe a)
unzipMaybe = (Maybe a, Maybe a)
-> ((a, a) -> (Maybe a, Maybe a))
-> Maybe (a, a)
-> (Maybe a, Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing) (\(a
a, a
b) -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, a -> Maybe a
forall a. a -> Maybe a
Just a
b))
    (Maybe Text
preChildrenWS, Maybe Document
children) <- (Maybe (Text, Document) -> (Maybe Text, Maybe Document))
-> ParsecT Void Text (Reader ParseConfig) (Maybe (Text, Document))
-> ParsecT
     Void Text (Reader ParseConfig) (Maybe Text, Maybe Document)
forall a b.
(a -> b)
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Text, Document) -> (Maybe Text, Maybe Document)
forall {a} {a}. Maybe (a, a) -> (Maybe a, Maybe a)
unzipMaybe (ParsecT Void Text (Reader ParseConfig) (Maybe (Text, Document))
 -> ParsecT
      Void Text (Reader ParseConfig) (Maybe Text, Maybe Document))
-> (ParsecT Void Text (Reader ParseConfig) (Text, Document)
    -> ParsecT Void Text (Reader ParseConfig) (Maybe (Text, Document)))
-> ParsecT Void Text (Reader ParseConfig) (Text, Document)
-> ParsecT
     Void Text (Reader ParseConfig) (Maybe Text, Maybe Document)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text (Reader ParseConfig) (Text, Document)
-> ParsecT Void Text (Reader ParseConfig) (Maybe (Text, Document))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text (Reader ParseConfig) (Text, Document)
 -> ParsecT
      Void Text (Reader ParseConfig) (Maybe Text, Maybe Document))
-> ParsecT Void Text (Reader ParseConfig) (Text, Document)
-> ParsecT
     Void Text (Reader ParseConfig) (Maybe Text, Maybe Document)
forall a b. (a -> b) -> a -> b
$ do
      -- Make sure a children block is coming up before we commit to consuming
      -- the whitespace as pre-children whitespace
      Char
_ <- ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void Text (Reader ParseConfig) Char
 -> ParsecT Void Text (Reader ParseConfig) Char)
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text (Reader ParseConfig) Char
 -> ParsecT Void Text (Reader ParseConfig) Char)
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_node_space Parser [()]
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"children block" (Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'{')
      (,)
        (Text -> Document -> (Text, Document))
-> Parser Text
-> ParsecT
     Void Text (Reader ParseConfig) (Document -> (Text, Document))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [()] -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_node_space)
        ParsecT
  Void Text (Reader ParseConfig) (Document -> (Text, Document))
-> Parser Document
-> ParsecT Void Text (Reader ParseConfig) (Text, Document)
forall a b.
ParsecT Void Text (Reader ParseConfig) (a -> b)
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Document
p_node_children
    let beforeChildren :: Text
beforeChildren = Text
postEntriesWS Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
slashdashedChildren1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
preChildrenWS

    Span
span <- SpanStart -> Parser Span
finishSpan SpanStart
spanStart

    -- slashdashed node-children #2
    Text
slashdashedChildren2 <- Parser Text
p_slashdashed_children

    -- trailing space
    Text
postChildrenWS <- Parser [()] -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser [()] -> Parser Text) -> Parser [()] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_node_space
    let trailing :: Text
trailing = Text
slashdashedChildren2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
postChildrenWS

    -- set by caller
    let beforeTerminator :: Text
beforeTerminator = Text
""
        terminator :: Text
terminator = Text
""

    let ext :: NodeExtension
ext =
          NodeExtension
            { format :: Maybe NodeFormat
format = NodeFormat -> Maybe NodeFormat
forall a. a -> Maybe a
Just NodeFormat{Text
beforeTerminator :: Text
terminator :: Text
trailing :: Text
leading :: Text
beforeChildren :: Text
trailing :: Text
beforeTerminator :: Text
terminator :: Text
beforeChildren :: Text
leading :: Text
..}
            , Span
span :: Span
span :: Span
span
            }

    Node -> Parser Node
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node{[Entry]
Maybe Ann
Maybe Document
Identifier
NodeExtension
ext :: NodeExtension
ann :: Maybe Ann
name :: Identifier
entries :: [Entry]
children :: Maybe Document
ext :: NodeExtension
children :: Maybe Document
entries :: [Entry]
name :: Identifier
ann :: Maybe Ann
..}
 where
  -- (node-space* (node-space | slashdash) node-prop-or-arg)*
  p_entries :: ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
p_entries = ([[Either Text Entry]] -> [Either Text Entry])
-> ParsecT Void Text (Reader ParseConfig) [[Either Text Entry]]
-> ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
forall a b.
(a -> b)
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Either Text Entry]] -> [Either Text Entry]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ParsecT Void Text (Reader ParseConfig) [[Either Text Entry]]
 -> ParsecT Void Text (Reader ParseConfig) [Either Text Entry])
-> (ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
    -> ParsecT Void Text (Reader ParseConfig) [[Either Text Entry]])
-> ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
-> ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
-> ParsecT Void Text (Reader ParseConfig) [[Either Text Entry]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
 -> ParsecT Void Text (Reader ParseConfig) [[Either Text Entry]])
-> (ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
    -> ParsecT Void Text (Reader ParseConfig) [Either Text Entry])
-> ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
-> ParsecT Void Text (Reader ParseConfig) [[Either Text Entry]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
-> ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"node prop or arg" (ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
 -> ParsecT Void Text (Reader ParseConfig) [Either Text Entry])
-> ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
-> ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
forall a b. (a -> b) -> a -> b
$ do
    -- make sure this is not the pre-children whitespace or post-node whitespace
    -- so that we can commit to this being node-prop-or-arg whitespace
    Parser () -> Parser ()
forall a. ParsecT Void Text (Reader ParseConfig) a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
      [()]
_ <- Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_node_space
      Maybe SlashdashResult
_ <- ParsecT Void Text (Reader ParseConfig) SlashdashResult
-> ParsecT Void Text (Reader ParseConfig) (Maybe SlashdashResult)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text (Reader ParseConfig) SlashdashResult
p_slashdash
      [Parser ()] -> Parser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ ParsecT Void Text (Reader ParseConfig) Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'{')
        , ParsecT Void Text (Reader ParseConfig) Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}')
        , Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text
p_node_terminator
        ]
    Text
leading <- Parser [()] -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser [()] -> Parser Text) -> Parser [()] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_node_space
    -- if there was no node-space, it _must_ be a slashdash
    SlashdashResult
sdash <- (if Text -> Bool
Text.null Text
leading then ParsecT Void Text (Reader ParseConfig) SlashdashResult
-> ParsecT Void Text (Reader ParseConfig) SlashdashResult
forall a. a -> a
id else SlashdashResult
-> ParsecT Void Text (Reader ParseConfig) SlashdashResult
-> ParsecT Void Text (Reader ParseConfig) SlashdashResult
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option SlashdashResult
NoSlashdash) ParsecT Void Text (Reader ParseConfig) SlashdashResult
p_slashdash
    Either Text Entry
entry <- SlashdashResult -> Parser Entry -> Parser (Either Text Entry)
forall a. SlashdashResult -> Parser a -> Parser (Either Text a)
resolveSlashdash SlashdashResult
sdash Parser Entry
p_node_prop_or_arg
    [Either Text Entry]
-> ParsecT Void Text (Reader ParseConfig) [Either Text Entry]
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Either Text Entry
forall a b. a -> Either a b
Left Text
leading, Either Text Entry
entry]

  -- (node-space* slashdash node-children)*
  p_slashdashed_children :: Parser Text
p_slashdashed_children =
    Parser [()] -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser [()] -> Parser Text)
-> (Parser () -> Parser [()]) -> Parser () -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser () -> Parser [()])
-> (Parser () -> Parser ()) -> Parser () -> Parser [()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser () -> Parser ()
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser () -> Parser Text) -> Parser () -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
      [()]
_ <- Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_node_space
      SlashdashResult
_ <- ParsecT Void Text (Reader ParseConfig) SlashdashResult
p_slashdash
      Document
_ <- Parser Document
p_node_children
      () -> Parser ()
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | ref: (3.2)
-- node-prop-or-arg := prop | value
p_node_prop_or_arg :: Parser Entry
p_node_prop_or_arg :: Parser Entry
p_node_prop_or_arg = String -> Parser Entry -> Parser Entry
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"node entry" (Parser Entry -> Parser Entry) -> Parser Entry -> Parser Entry
forall a b. (a -> b) -> a -> b
$ do
  Parser Entry -> Parser Entry
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Entry
p_prop Parser Entry -> Parser Entry -> Parser Entry
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Entry
p_value'Entry

-- | ref: (3.2)
-- node-terminator := single-line-comment | newline | ';' | eof
p_node_terminator :: Parser Text
p_node_terminator :: Parser Text
p_node_terminator = String -> Parser Text -> Parser Text
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"end of node" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
  [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser Text
p_single_line_comment
    , Parser Text
p_newline
    , Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
";"
    , Parser Text
p_eof
    ]

{----- (3.3) Line Continuation -----}

-- | ref: (3.3)
-- escline := '\\' ws* (single-line-comment | newline | eof)
p_escline :: Parser ()
p_escline :: Parser ()
p_escline = String -> Parser () -> Parser ()
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"escline" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\\"
  [Text]
_ <- Parser Text -> ParsecT Void Text (Reader ParseConfig) [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser Text
p_ws
  Text
_ <- Parser Text
p_single_line_comment Parser Text -> Parser Text -> Parser Text
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
p_newline Parser Text -> Parser Text -> Parser Text
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
p_eof
  () -> Parser ()
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{----- (3.4) Property -----}

-- | ref: (3.4)
-- prop := string node-space* '=' node-space* value
p_prop :: Parser Entry
p_prop :: Parser Entry
p_prop = String -> Parser Entry -> Parser Entry
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"property" (Parser Entry -> Parser Entry) -> Parser Entry -> Parser Entry
forall a b. (a -> b) -> a -> b
$ do
  SpanStart
spanStart <- Parser SpanStart
startSpan
  Identifier
name <- Parser Identifier
p_string'Identifier
  Text
afterKey <- Parser [()] -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser [()] -> Parser Text) -> Parser [()] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_node_space
  Char
_ <- Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
  Text
afterEq <- Parser [()] -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser [()] -> Parser Text) -> Parser [()] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_node_space
  (Value
value, Text
leading) <- Parser (Value, Text)
p_value
  Span
span <- SpanStart -> Parser Span
finishSpan SpanStart
spanStart
  let format :: EntryFormat
format =
        EntryFormat
          { Text
leading :: Text
leading :: Text
leading
          , Text
afterKey :: Text
afterKey :: Text
afterKey
          , Text
afterEq :: Text
afterEq :: Text
afterEq
          , trailing :: Text
trailing = Text
""
          }
      ext :: EntryExtension
ext = EntryExtension{format :: Maybe EntryFormat
format = EntryFormat -> Maybe EntryFormat
forall a. a -> Maybe a
Just EntryFormat
format, Span
span :: Span
span :: Span
span}
  Entry -> Parser Entry
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entry{name :: Maybe Identifier
name = Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
name, Value
EntryExtension
value :: Value
ext :: EntryExtension
ext :: EntryExtension
value :: Value
..}

{----- (3.5) Argument -----}

-- | ref: (3.5)
p_value'Entry :: Parser Entry
p_value'Entry :: Parser Entry
p_value'Entry = String -> Parser Entry -> Parser Entry
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"argument" (Parser Entry -> Parser Entry) -> Parser Entry -> Parser Entry
forall a b. (a -> b) -> a -> b
$ do
  ((Value
value, Text
leading), Span
span) <- Parser (Value, Text) -> Parser ((Value, Text), Span)
forall a. Parser a -> Parser (a, Span)
withSpan Parser (Value, Text)
p_value
  let format :: EntryFormat
format =
        EntryFormat
          { Text
leading :: Text
leading :: Text
leading
          , afterKey :: Text
afterKey = Text
""
          , afterEq :: Text
afterEq = Text
""
          , trailing :: Text
trailing = Text
""
          }
      ext :: EntryExtension
ext =
        EntryExtension
          { format :: Maybe EntryFormat
format = EntryFormat -> Maybe EntryFormat
forall a. a -> Maybe a
Just EntryFormat
format
          , Span
span :: Span
span :: Span
span
          }
  Entry -> Parser Entry
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entry{name :: Maybe Identifier
name = Maybe Identifier
forall a. Maybe a
Nothing, Value
EntryExtension
ext :: EntryExtension
value :: Value
value :: Value
ext :: EntryExtension
..}

{----- (3.6) Children Block -----}

-- | ref: (3.6)
-- node-children := '{' nodes final-node? '}'
p_node_children :: Parser NodeList
p_node_children :: Parser Document
p_node_children = String -> Parser Document -> Parser Document
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"children block" (Parser Document -> Parser Document)
-> Parser Document -> Parser Document
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
-> Parser Document
-> Parser Document
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'{') (Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}') (Parser Document -> Parser Document)
-> Parser Document -> Parser Document
forall a b. (a -> b) -> a -> b
$ do
    Parser Document
p_nodes -- 'final-node?' logic is in p_nodes / p_node

{----- (3.7) Value -----}

-- | ref: (3.7)
-- value := type? node-space* (string | number | keyword)
p_value :: Parser (Value, Text)
p_value :: Parser (Value, Text)
p_value = String -> Parser (Value, Text) -> Parser (Value, Text)
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"value" (Parser (Value, Text) -> Parser (Value, Text))
-> Parser (Value, Text) -> Parser (Value, Text)
forall a b. (a -> b) -> a -> b
$ do
  SpanStart
spanStart <- Parser SpanStart
startSpan
  Maybe Ann
initialAnn <- ParsecT Void Text (Reader ParseConfig) Ann
-> ParsecT Void Text (Reader ParseConfig) (Maybe Ann)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text (Reader ParseConfig) Ann
p_type
  Text
postAnnWS <- Parser [()] -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser [()] -> Parser Text) -> Parser [()] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_node_space
  let (Maybe Ann
ann, Text
leading) =
        case Maybe Ann
initialAnn of
          Just Ann
a -> (Ann -> Maybe Ann
forall a. a -> Maybe a
Just (Ann -> Maybe Ann) -> Ann -> Maybe Ann
forall a b. (a -> b) -> a -> b
$ Text -> Ann -> Ann
forall a. HasWsFormat a => Text -> a -> a
appendTrailing Text
postAnnWS Ann
a, Text
"")
          Maybe Ann
Nothing -> (Maybe Ann
forall a. Maybe a
Nothing, Text
postAnnWS)

  (ValueData
data_, Text
repr_) <-
    Parser ValueData -> Parser (ValueData, Text)
forall a. Parser a -> Parser (a, Text)
withSource (Parser ValueData -> Parser (ValueData, Text))
-> ([Parser ValueData] -> Parser ValueData)
-> [Parser ValueData]
-> Parser (ValueData, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parser ValueData] -> Parser ValueData
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser ValueData] -> Parser ValueData)
-> ([Parser ValueData] -> [Parser ValueData])
-> [Parser ValueData]
-> Parser ValueData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser ValueData -> Parser ValueData)
-> [Parser ValueData] -> [Parser ValueData]
forall a b. (a -> b) -> [a] -> [b]
map Parser ValueData -> Parser ValueData
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ([Parser ValueData] -> Parser (ValueData, Text))
-> [Parser ValueData] -> Parser (ValueData, Text)
forall a b. (a -> b) -> a -> b
$
      [ Text -> ValueData
String (Text -> ValueData) -> Parser Text -> Parser ValueData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
p_string
      , Parser ValueData
p_number
      , Parser ValueData
p_keyword
      ]
  let repr :: Maybe Text
repr = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
repr_
  Span
span <- SpanStart -> Parser Span
finishSpan SpanStart
spanStart

  let ext :: ValueExtension
ext =
        ValueExtension
          { format :: Maybe ValueFormat
format = ValueFormat -> Maybe ValueFormat
forall a. a -> Maybe a
Just ValueFormat{Maybe Text
repr :: Maybe Text
repr :: Maybe Text
..}
          , Span
span :: Span
span :: Span
span
          }
  (Value, Text) -> Parser (Value, Text)
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value{Maybe Ann
ValueData
ValueExtension
ann :: Maybe Ann
data_ :: ValueData
ext :: ValueExtension
ext :: ValueExtension
data_ :: ValueData
ann :: Maybe Ann
..}, Text
leading)

-- | ref: (3.7)
p_keyword :: Parser ValueData
p_keyword :: Parser ValueData
p_keyword = String -> Parser ValueData -> Parser ValueData
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"value keyword" (Parser ValueData -> Parser ValueData)
-> Parser ValueData -> Parser ValueData
forall a b. (a -> b) -> a -> b
$ do
  [Parser ValueData] -> Parser ValueData
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser ValueData] -> Parser ValueData)
-> ([Parser ValueData] -> [Parser ValueData])
-> [Parser ValueData]
-> Parser ValueData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser ValueData -> Parser ValueData)
-> [Parser ValueData] -> [Parser ValueData]
forall a b. (a -> b) -> [a] -> [b]
map Parser ValueData -> Parser ValueData
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ([Parser ValueData] -> Parser ValueData)
-> [Parser ValueData] -> Parser ValueData
forall a b. (a -> b) -> a -> b
$
    [ Bool -> ValueData
Bool (Bool -> ValueData)
-> ParsecT Void Text (Reader ParseConfig) Bool -> Parser ValueData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader ParseConfig) Bool
p_boolean
    , ValueData
Null ValueData
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser ValueData
forall a b.
a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#null"
    ]

{----- (3.8) Type Annotation -----}

-- | ref: (3.8)
-- type := '(' node-space* string node-space* ')'
p_type :: Parser Ann
p_type :: ParsecT Void Text (Reader ParseConfig) Ann
p_type = String
-> ParsecT Void Text (Reader ParseConfig) Ann
-> ParsecT Void Text (Reader ParseConfig) Ann
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"type annotation" (ParsecT Void Text (Reader ParseConfig) Ann
 -> ParsecT Void Text (Reader ParseConfig) Ann)
-> ParsecT Void Text (Reader ParseConfig) Ann
-> ParsecT Void Text (Reader ParseConfig) Ann
forall a b. (a -> b) -> a -> b
$ do
  ((Identifier
identifier, Maybe AnnFormat
format), Span
span) <-
    Parser (Identifier, Maybe AnnFormat)
-> Parser ((Identifier, Maybe AnnFormat), Span)
forall a. Parser a -> Parser (a, Span)
withSpan (Parser (Identifier, Maybe AnnFormat)
 -> Parser ((Identifier, Maybe AnnFormat), Span))
-> (Parser (Identifier, Maybe AnnFormat)
    -> Parser (Identifier, Maybe AnnFormat))
-> Parser (Identifier, Maybe AnnFormat)
-> Parser ((Identifier, Maybe AnnFormat), Span)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
-> Parser (Identifier, Maybe AnnFormat)
-> Parser (Identifier, Maybe AnnFormat)
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(') (Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')') (Parser (Identifier, Maybe AnnFormat)
 -> Parser ((Identifier, Maybe AnnFormat), Span))
-> Parser (Identifier, Maybe AnnFormat)
-> Parser ((Identifier, Maybe AnnFormat), Span)
forall a b. (a -> b) -> a -> b
$ do
      Text
beforeId <- Parser [()] -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser [()] -> Parser Text) -> Parser [()] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_node_space
      Identifier
identifier <- Parser Identifier
p_string'Identifier
      Text
afterId <- Parser [()] -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser [()] -> Parser Text) -> Parser [()] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_node_space
      let format :: Maybe AnnFormat
format = AnnFormat -> Maybe AnnFormat
forall a. a -> Maybe a
Just AnnFormat{leading :: Text
leading = Text
"", trailing :: Text
trailing = Text
"", Text
beforeId :: Text
afterId :: Text
afterId :: Text
beforeId :: Text
..}
      (Identifier, Maybe AnnFormat)
-> Parser (Identifier, Maybe AnnFormat)
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier
identifier, Maybe AnnFormat
format)

  let ext :: AnnExtension
ext = AnnExtension{Maybe AnnFormat
format :: Maybe AnnFormat
format :: Maybe AnnFormat
format, Span
span :: Span
span :: Span
span}
  Ann -> ParsecT Void Text (Reader ParseConfig) Ann
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ann{Identifier
identifier :: Identifier
identifier :: Identifier
identifier, AnnExtension
ext :: AnnExtension
ext :: AnnExtension
ext}

{----- (3.9) String -----}

-- | ref: (3.9)
p_string'Identifier :: Parser Identifier
p_string'Identifier :: Parser Identifier
p_string'Identifier = do
  ((Text
value, Text
repr_), Span
span) <- Parser (Text, Text) -> Parser ((Text, Text), Span)
forall a. Parser a -> Parser (a, Span)
withSpan (Parser (Text, Text) -> Parser ((Text, Text), Span))
-> (Parser Text -> Parser (Text, Text))
-> Parser Text
-> Parser ((Text, Text), Span)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text -> Parser (Text, Text)
forall a. Parser a -> Parser (a, Text)
withSource (Parser Text -> Parser ((Text, Text), Span))
-> Parser Text -> Parser ((Text, Text), Span)
forall a b. (a -> b) -> a -> b
$ Parser Text
p_string
  let repr :: Maybe Text
repr = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
repr_
  let ext :: IdentifierExtension
ext = IdentifierExtension{format :: Maybe IdentifierFormat
format = IdentifierFormat -> Maybe IdentifierFormat
forall a. a -> Maybe a
Just IdentifierFormat{Maybe Text
repr :: Maybe Text
repr :: Maybe Text
..}, Span
span :: Span
span :: Span
span}
  Identifier -> Parser Identifier
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Identifier{Text
IdentifierExtension
value :: Text
ext :: IdentifierExtension
ext :: IdentifierExtension
value :: Text
..}

-- | ref: (3.9)
-- string := identifier-string | quoted-string | raw-string ¶
p_string :: Parser Text
p_string :: Parser Text
p_string = String -> Parser Text -> Parser Text
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"string" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
  [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser Text
p_identifier_string
    , Parser Text
p_quoted_string
    , Parser Text
p_raw_string
    ]

{----- (3.10) Identifier String -----}

-- | ref: (3.10)
-- identifier-string := unambiguous-ident | signed-ident | dotted-ident
p_identifier_string :: Parser Text
p_identifier_string :: Parser Text
p_identifier_string = String -> Parser Text -> Parser Text
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"unquoted string" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
  [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser Text] -> Parser Text)
-> ([Parser Text] -> [Parser Text]) -> [Parser Text] -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser Text -> Parser Text) -> [Parser Text] -> [Parser Text]
forall a b. (a -> b) -> [a] -> [b]
map Parser Text -> Parser Text
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ([Parser Text] -> Parser Text) -> [Parser Text] -> Parser Text
forall a b. (a -> b) -> a -> b
$
    [ Parser Text
p_unambiguous_ident
    , Parser Text
p_signed_ident
    , Parser Text
p_dotted_ident
    ]

isValidUnquotedString :: Text -> Bool
isValidUnquotedString :: Text -> Bool
isValidUnquotedString = Either (ParseErrorBundle Text Void) Text -> Bool
forall a b. Either a b -> Bool
isRight (Either (ParseErrorBundle Text Void) Text -> Bool)
-> (Text -> Either (ParseErrorBundle Text Void) Text)
-> Text
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseConfig
-> Parser Text -> Text -> Either (ParseErrorBundle Text Void) Text
forall a.
ParseConfig
-> Parser a -> Text -> Either (ParseErrorBundle Text Void) a
runParser ParseConfig
forall a. Default a => a
def (Parser Text
p_identifier_string Parser Text -> Parser () -> Parser Text
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)

-- | ref: (3.10)
-- unambiguous-ident :=
--     ((identifier-char - digit - sign - '.') identifier-char*)
--     - disallowed-keyword-identifiers
p_unambiguous_ident :: Parser Text
p_unambiguous_ident :: Parser Text
p_unambiguous_ident = String -> Parser Text -> Parser Text
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"unquoted string" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
  Char
c <- ParsecT Void Text (Reader ParseConfig) Char
p_identifier_char
  Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'-', Char
'+', Char
'.']
  String
cs <- ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text (Reader ParseConfig) Char
p_identifier_char
  let s :: Text
s = String -> Text
Text.pack (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs)
  Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text
s Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
disallowed_keyword_identifiers
  Text -> Parser Text
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s

-- | ref: (3.10)
-- signed-ident :=
--     sign ((identifier-char - digit - '.') identifier-char*)?
p_signed_ident :: Parser Text
p_signed_ident :: Parser Text
p_signed_ident = do
  Char
c0 <- ParsecT Void Text (Reader ParseConfig) Char
p_sign
  String
cs <- String
-> ParsecT Void Text (Reader ParseConfig) String
-> ParsecT Void Text (Reader ParseConfig) String
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option String
"" (ParsecT Void Text (Reader ParseConfig) String
 -> ParsecT Void Text (Reader ParseConfig) String)
-> ParsecT Void Text (Reader ParseConfig) String
-> ParsecT Void Text (Reader ParseConfig) String
forall a b. (a -> b) -> a -> b
$ do
    Char
c1 <- ParsecT Void Text (Reader ParseConfig) Char
p_identifier_char
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isDigit Char
c1 Bool -> Bool -> Bool
|| Char
c1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
    String
cs <- ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text (Reader ParseConfig) Char
p_identifier_char
    String -> ParsecT Void Text (Reader ParseConfig) String
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char
c1 Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs)
  Text -> Parser Text
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (Char
c0 Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs)

-- | ref: (3.10)
-- disallowed-keyword-identifiers :=
--     'true' | 'false' | 'null' | 'inf' | '-inf' | 'nan'
disallowed_keyword_identifiers :: Set Text
disallowed_keyword_identifiers :: Set Text
disallowed_keyword_identifiers =
  [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
    [ Text
"true"
    , Text
"false"
    , Text
"null"
    , Text
"inf"
    , Text
"-inf"
    , Text
"nan"
    ]

-- | ref: (3.10)
-- dotted-ident :=
--     sign? '.' ((identifier-char - digit) identifier-char*)?
p_dotted_ident :: Parser Text
p_dotted_ident :: Parser Text
p_dotted_ident = do
  Text
c0 <- Text -> Parser Text -> Parser Text
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
Text.singleton (Char -> Text)
-> ParsecT Void Text (Reader ParseConfig) Char -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader ParseConfig) Char
p_sign
  Char
c1 <- Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token Text
'.'
  String
cs <- String
-> ParsecT Void Text (Reader ParseConfig) String
-> ParsecT Void Text (Reader ParseConfig) String
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option String
"" (ParsecT Void Text (Reader ParseConfig) String
 -> ParsecT Void Text (Reader ParseConfig) String)
-> ParsecT Void Text (Reader ParseConfig) String
-> ParsecT Void Text (Reader ParseConfig) String
forall a b. (a -> b) -> a -> b
$ do
    Char
c2 <- ParsecT Void Text (Reader ParseConfig) Char
p_identifier_char
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isDigit Char
c2
    String
cs <- ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text (Reader ParseConfig) Char
p_identifier_char
    String -> ParsecT Void Text (Reader ParseConfig) String
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char
c2 Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs)
  Text -> Parser Text
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Text
c0 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Char
c1 Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs)

-- | ref: (3.10.2)
-- identifier-char :=
--     unicode - unicode-space - newline - [\\/(){};\[\]"#=]
--     - disallowed-literal-code-points
p_identifier_char :: Parser Char
p_identifier_char :: ParsecT Void Text (Reader ParseConfig) Char
p_identifier_char = do
  (Token Text -> Bool)
-> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy ((Token Text -> Bool)
 -> ParsecT Void Text (Reader ParseConfig) (Token Text))
-> (Token Text -> Bool)
-> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Char -> Text
Text.singleton Char
Token Text
c Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
invalid Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
is_disallowed_literal_code_points) Char
Token Text
c
 where
  invalid :: Set Text
invalid =
    [Set Text] -> Set Text
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
      [ (Char -> Text) -> Set Char -> Set Text
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Char -> Text
Text.singleton Set Char
chars_unicode_space
      , Set Text
chars_newline
      , (Char -> Text) -> Set Char -> Set Text
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Char -> Text
Text.singleton (Set Char -> Set Text) -> Set Char -> Set Text
forall a b. (a -> b) -> a -> b
$ String -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList String
"\\/(){};[]\"#="
      ]

{----- (3.11) Quoted String -----}

-- | ref: (3.11) + (3.12)
-- quoted-string :=
--     '"' single-line-string-body '"' |
--     '"""' newline
--     (multi-line-string-body newline)?
--     (unicode-space | ws-escape)* '"""'
p_quoted_string :: Parser Text
p_quoted_string :: Parser Text
p_quoted_string = String -> Parser Text -> Parser Text
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"quoted string" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
  [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser Text
-> Parser Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
quotes3) (Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
quotes3) (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
        (forall end. Parser end -> Parser MultilineChars)
-> Parser Text -> Parser Text
parseMultilineString
          Parser end -> Parser MultilineChars
forall end. Parser end -> Parser MultilineChars
p_multi_line_string_body
          ( Parser Text -> Parser Text
forall a. Monoid a => Parser a -> Parser a
repeat0 (Parser Text -> Parser Text)
-> ([Parser Text] -> Parser Text) -> [Parser Text] -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser Text] -> Parser Text) -> [Parser Text] -> Parser Text
forall a b. (a -> b) -> a -> b
$
              [ Char -> Text
Text.singleton (Char -> Text)
-> ParsecT Void Text (Reader ParseConfig) Char -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader ParseConfig) Char
p_unicode_space
              , Text
"" Text -> Parser () -> Parser Text
forall a b.
a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
p_ws_escape
              ]
          )
    , ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser Text
-> Parser Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
quotes1) (Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
quotes1) (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
        Parser Text
p_single_line_string_body
    ]

-- | ref: (3.11)
-- single-line-string-body := (string-character - newline)*
p_single_line_string_body :: Parser Text
p_single_line_string_body :: Parser Text
p_single_line_string_body = String -> Parser Text -> Parser Text
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"quoted string line" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
  Parser Text -> Parser Text
forall a. Monoid a => Parser a -> Parser a
repeat0 (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Maybe (Parser Text) -> Parser Text
forall invalid. Maybe (Parser invalid) -> Parser Text
p_string_character (Parser Text -> Maybe (Parser Text)
forall a. a -> Maybe a
Just Parser Text
p_newline)

-- | ref: (3.11)
-- string-character :=
--     '\\' (["\\bfnrts] |
--     'u{' hex-unicode '}') |
--     ws-escape |
--     [^\\"] - disallowed-literal-code-points
p_string_character :: Maybe (Parser invalid) -> Parser Text
p_string_character :: forall invalid. Maybe (Parser invalid) -> Parser Text
p_string_character Maybe (Parser invalid)
invalid = String -> Parser Text -> Parser Text
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"string character" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
  [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser Text] -> Parser Text)
-> ([Parser Text] -> [Parser Text]) -> [Parser Text] -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser Text -> Parser Text) -> [Parser Text] -> [Parser Text]
forall a b. (a -> b) -> [a] -> [b]
map Parser Text -> Parser Text
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ([Parser Text] -> Parser Text) -> [Parser Text] -> Parser Text
forall a b. (a -> b) -> a -> b
$
    [ do
        Char
_ <- Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\'
        (Char -> Text)
-> ParsecT Void Text (Reader ParseConfig) Char -> Parser Text
forall a b.
(a -> b)
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Text
Text.singleton (ParsecT Void Text (Reader ParseConfig) Char -> Parser Text)
-> ([ParsecT Void Text (Reader ParseConfig) Char]
    -> ParsecT Void Text (Reader ParseConfig) Char)
-> [ParsecT Void Text (Reader ParseConfig) Char]
-> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT Void Text (Reader ParseConfig) Char]
-> ParsecT Void Text (Reader ParseConfig) Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT Void Text (Reader ParseConfig) Char] -> Parser Text)
-> [ParsecT Void Text (Reader ParseConfig) Char] -> Parser Text
forall a b. (a -> b) -> a -> b
$
          [ Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"'
          , Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\'
          , Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'b' ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Void Text (Reader ParseConfig) Char
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\b'
          , Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'f' ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Void Text (Reader ParseConfig) Char
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\f'
          , Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'n' ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Void Text (Reader ParseConfig) Char
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\n'
          , Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'r' ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Void Text (Reader ParseConfig) Char
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\r'
          , Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
't' ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Void Text (Reader ParseConfig) Char
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\t'
          , Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
's' ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Void Text (Reader ParseConfig) Char
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
' '
          , ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"u{") (Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"}") (ParsecT Void Text (Reader ParseConfig) Char
 -> ParsecT Void Text (Reader ParseConfig) Char)
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a b. (a -> b) -> a -> b
$ do
              Int -> Char
chr (Int -> Char)
-> ParsecT Void Text (Reader ParseConfig) Int
-> ParsecT Void Text (Reader ParseConfig) Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader ParseConfig) Int
p_hex_unicode
          ]
    , Text
"" Text -> Parser () -> Parser Text
forall a b.
a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
p_ws_escape
    , do
        (Parser invalid -> Parser ())
-> Maybe (Parser invalid) -> Parser ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Parser invalid -> Parser ()
forall a. ParsecT Void Text (Reader ParseConfig) a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Maybe (Parser invalid)
invalid
        Char
c <- (Token Text -> Bool)
-> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Token Text -> [Token Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\\', Char
'"'])
        Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
is_disallowed_literal_code_points Char
c
        Text -> Parser Text
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
Text.singleton Char
c
    ]

-- | ref: (3.11.1)
-- hex-unicode := hex-digit{1, 6} - surrogate - above-max-scalar
-- surrogate := [0]{0, 2} [dD] [8-9a-fA-F] hex-digit{2}
-- //  U+D800-DFFF:         D   8          00
-- //                       D   F          FF
-- above-max-scalar = [2-9a-fA-F] hex-digit{5} |
--     [1] [1-9a-fA-F] hex-digit{4}
p_hex_unicode :: Parser Int
p_hex_unicode :: ParsecT Void Text (Reader ParseConfig) Int
p_hex_unicode = String
-> ParsecT Void Text (Reader ParseConfig) Int
-> ParsecT Void Text (Reader ParseConfig) Int
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"hex unicode" (ParsecT Void Text (Reader ParseConfig) Int
 -> ParsecT Void Text (Reader ParseConfig) Int)
-> ParsecT Void Text (Reader ParseConfig) Int
-> ParsecT Void Text (Reader ParseConfig) Int
forall a b. (a -> b) -> a -> b
$ do
  [Int]
digits <- Int
-> Int
-> ParsecT Void Text (Reader ParseConfig) Int
-> Parser [Int]
forall a. Int -> Int -> Parser a -> Parser [a]
countBetween Int
1 Int
6 ParsecT Void Text (Reader ParseConfig) Int
p_hex_digit
  Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool
not (Bool -> Bool) -> ([Int] -> Bool) -> [Int] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [Int]
digits
  let x :: Int
x = Int -> [Int] -> Int
forall a. Num a => a -> [a] -> a
undigits Int
16 [Int]
digits
  Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Int -> Bool
is_unicode_scalar_value Int
x
  Int -> ParsecT Void Text (Reader ParseConfig) Int
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
x

-- | ref: (3.11.1.1)
-- ws-escape := '\\' (unicode-space | newline)+
p_ws_escape :: Parser ()
p_ws_escape :: Parser ()
p_ws_escape = String -> Parser () -> Parser ()
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"escaped Whitespace" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
  Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\' ParsecT Void Text (Reader ParseConfig) Char
-> Parser () -> Parser ()
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [()] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Parser () -> Parser [()]) -> Parser () -> Parser [()]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text (Reader ParseConfig) Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text (Reader ParseConfig) Char
p_unicode_space Parser () -> Parser () -> Parser ()
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text
p_newline)

{----- (3.12) Multi-line String -----}

-- | ref: (3.12)
-- multi-line-string-body := (('"' | '""')? string-character)*
--
-- Requires some changes to the grammar: https://github.com/kdl-org/kdl/pull/552
p_multi_line_string_body :: Parser end -> Parser MultilineChars
p_multi_line_string_body :: forall end. Parser end -> Parser MultilineChars
p_multi_line_string_body Parser end
end = String -> Parser MultilineChars -> Parser MultilineChars
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"quoted multiline string body" (Parser MultilineChars -> Parser MultilineChars)
-> Parser MultilineChars -> Parser MultilineChars
forall a b. (a -> b) -> a -> b
$ do
  Parser (Text, Text) -> Parser end -> Parser MultilineChars
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill (Parser Text -> Parser (Text, Text)
forall a. Parser a -> Parser (a, Text)
withSource Parser Text
validChar) (Parser end -> Parser end
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser end -> Parser end)
-> (Parser end -> Parser end) -> Parser end -> Parser end
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser end -> Parser end
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Parser end -> Parser end) -> Parser end -> Parser end
forall a b. (a -> b) -> a -> b
$ Parser end
end)
 where
  validChar :: Parser Text
validChar = do
    [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
"\"\"" Parser Text -> Parser () -> Parser Text
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text (Reader ParseConfig) Char -> Parser ()
forall a. ParsecT Void Text (Reader ParseConfig) a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"')
      , Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
"\"" Parser Text -> Parser () -> Parser Text
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text (Reader ParseConfig) Char -> Parser ()
forall a. ParsecT Void Text (Reader ParseConfig) a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"')
      , Maybe (Parser Any) -> Parser Text
forall invalid. Maybe (Parser invalid) -> Parser Text
p_string_character Maybe (Parser Any)
forall a. Maybe a
Nothing
      ]

-- | Characters in a multiline string.
--
-- In simple cases, the input is effectively [(Char, Text)], containing
-- each character in the multiline string and its raw representation. This
-- distinguishes what the user actually wrote vs its semantic value; e.g.
-- '\s' is represented as (" ", "\s").
--
-- It needs to be (Text, Text) instead of (Char, Text) because some character
-- sequences are semantically an empty string (e.g. p_ws_escape) and a few can
-- return multiple characters (e.g. p_newline).
type MultilineChars = [(Text, Text)]

type MultilineProcessorM a = StateT MultilineProcessorState Parser a
data MultilineProcessorState = MultilineProcessorState
  { MultilineProcessorState -> Text
wsPrefix :: Text
  , MultilineProcessorState -> Int
lineStartOffset :: Int
  }

-- | Parse a multiline string with the grammar:
--
--     '"""' newline
--     (<body> newline)?
--     <endSpace>* '"""'
parseMultilineString ::
  (forall end. Parser end -> Parser MultilineChars) ->
  Parser Text ->
  Parser Text
parseMultilineString :: (forall end. Parser end -> Parser MultilineChars)
-> Parser Text -> Parser Text
parseMultilineString forall end. Parser end -> Parser MultilineChars
parseBody Parser Text
parseEndSpace = do
  Text
_ <- Parser Text
p_newline -- Drop the first newline
  State{stateOffset :: forall s e. State s e -> Int
stateOffset = Int
startOffset} <- ParsecT Void Text (Reader ParseConfig) (State Text Void)
forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
getParserState
  Maybe MultilineChars
mBody <- Parser MultilineChars
-> ParsecT Void Text (Reader ParseConfig) (Maybe MultilineChars)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser MultilineChars
 -> ParsecT Void Text (Reader ParseConfig) (Maybe MultilineChars))
-> (Parser MultilineChars -> Parser MultilineChars)
-> Parser MultilineChars
-> ParsecT Void Text (Reader ParseConfig) (Maybe MultilineChars)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser MultilineChars -> Parser MultilineChars
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser MultilineChars
 -> ParsecT Void Text (Reader ParseConfig) (Maybe MultilineChars))
-> Parser MultilineChars
-> ParsecT Void Text (Reader ParseConfig) (Maybe MultilineChars)
forall a b. (a -> b) -> a -> b
$ do
    MultilineChars
body <- ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser MultilineChars
forall end. Parser end -> Parser MultilineChars
parseBody (Parser Text
p_newline Parser Text -> Parser Text -> Parser Text
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
parseEndSpace Parser Text
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
quotes3)
    Text
_ <- Parser Text
p_newline -- Drop the last newline
    MultilineChars -> Parser MultilineChars
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MultilineChars
body
  Text
end <- Parser Text
parseEndSpace
  case Maybe MultilineChars
mBody of
    Maybe MultilineChars
Nothing -> Text -> Parser Text
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
    Just MultilineChars
body -> do
      let state :: MultilineProcessorState
state =
            MultilineProcessorState
              { wsPrefix :: Text
wsPrefix = Text
end
              , lineStartOffset :: Int
lineStartOffset = Int
startOffset
              }
      MultilineChars
body' <- (MultilineProcessorM MultilineChars
 -> MultilineProcessorState -> Parser MultilineChars)
-> MultilineProcessorState
-> MultilineProcessorM MultilineChars
-> Parser MultilineChars
forall a b c. (a -> b -> c) -> b -> a -> c
flip MultilineProcessorM MultilineChars
-> MultilineProcessorState -> Parser MultilineChars
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT MultilineProcessorState
state (MultilineProcessorM MultilineChars -> Parser MultilineChars)
-> MultilineProcessorM MultilineChars -> Parser MultilineChars
forall a b. (a -> b) -> a -> b
$ (MultilineChars -> MultilineProcessorM MultilineChars)
-> MultilineChars -> MultilineProcessorM MultilineChars
mapLinesM MultilineChars -> MultilineProcessorM MultilineChars
processLine MultilineChars
body
      Text -> Parser Text
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Text) -> MultilineChars -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text, Text) -> Text
forall a b. (a, b) -> a
fst MultilineChars
body'
 where
  processLine :: MultilineChars -> MultilineProcessorM MultilineChars
processLine = MultilineChars -> MultilineProcessorM MultilineChars
forall {m :: * -> *} {s} {e} {s}.
(HasField "wsPrefix" s Text, HasField "lineStartOffset" s Int,
 MonadParsec e s m) =>
MultilineChars -> StateT s m MultilineChars
rmPrefix (MultilineChars -> MultilineProcessorM MultilineChars)
-> (MultilineChars -> MultilineChars)
-> MultilineChars
-> MultilineProcessorM MultilineChars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultilineChars -> MultilineChars
forall {a}. IsString a => [(a, Text)] -> [(a, Text)]
collapseWsOnlyLines

  collapseWsOnlyLines :: [(a, Text)] -> [(a, Text)]
collapseWsOnlyLines [(a, Text)]
line =
    let srcs :: Text
srcs = ((a, Text) -> Text) -> [(a, Text)] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a, Text) -> Text
forall a b. (a, b) -> b
snd [(a, Text)]
line
     in if (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isSpace Text
srcs
          then [(a
"", Text
srcs)]
          else [(a, Text)]
line

  rmPrefix :: MultilineChars -> StateT s m MultilineChars
rmPrefix MultilineChars
line0 = do
    let go :: Text -> [(a, Text)] -> StateT s m [(a, Text)]
go Text
pre = \case
          -- Consumed the full prefix, return the final line
          [(a, Text)]
line | Text -> Bool
Text.null Text
pre -> [(a, Text)] -> StateT s m [(a, Text)]
forall a. a -> StateT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(a, Text)]
line
          -- The prefix starts with the source text; consume and continue matching the rest of the prefix
          (a
_, Text
src) : [(a, Text)]
rest | Just Text
pre' <- Text -> Text -> Maybe Text
Text.stripPrefix Text
src Text
pre -> Text -> [(a, Text)] -> StateT s m [(a, Text)]
go Text
pre' [(a, Text)]
rest
          -- Prefix did not match, return the initial line unchanged
          [(a, Text)]
_ -> do
            Int
offset <- (s -> Int) -> StateT s m Int
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets (.lineStartOffset)
            ParseError s e -> StateT s m [(a, Text)]
forall a. ParseError s e -> StateT s m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
parseError (ParseError s e -> StateT s m [(a, Text)])
-> (ErrorFancy e -> ParseError s e)
-> ErrorFancy e
-> StateT s m [(a, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Set (ErrorFancy e) -> ParseError s e
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
offset (Set (ErrorFancy e) -> ParseError s e)
-> (ErrorFancy e -> Set (ErrorFancy e))
-> ErrorFancy e
-> ParseError s e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorFancy e -> Set (ErrorFancy e)
forall a. a -> Set a
Set.singleton (ErrorFancy e -> StateT s m [(a, Text)])
-> ErrorFancy e -> StateT s m [(a, Text)]
forall a b. (a -> b) -> a -> b
$
              String -> ErrorFancy e
forall e. String -> ErrorFancy e
ErrorFail String
"Line does not have the correct indentation"
    Text
pre0 <- (s -> Text) -> StateT s m Text
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets (.wsPrefix)
    -- If the line is completely empty (e.g. after collapseWsOnlyLines),
    -- there's no prefix to strip.
    if ((Text, Text) -> Bool) -> MultilineChars -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Bool
Text.null (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) MultilineChars
line0
      then MultilineChars -> StateT s m MultilineChars
forall a. a -> StateT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MultilineChars
line0
      else Text -> MultilineChars -> StateT s m MultilineChars
forall {m :: * -> *} {s} {e} {s} {a}.
(HasField "lineStartOffset" s Int, MonadParsec e s m) =>
Text -> [(a, Text)] -> StateT s m [(a, Text)]
go Text
pre0 MultilineChars
line0

  mapLinesM ::
    (MultilineChars -> MultilineProcessorM MultilineChars) ->
    MultilineChars ->
    MultilineProcessorM MultilineChars
  mapLinesM :: (MultilineChars -> MultilineProcessorM MultilineChars)
-> MultilineChars -> MultilineProcessorM MultilineChars
mapLinesM MultilineChars -> MultilineProcessorM MultilineChars
f =
    let resolveLine :: (Seq (Text, Text), Seq (Text, Text))
-> StateT
     MultilineProcessorState
     (ParsecT Void Text (Reader ParseConfig))
     (Seq (Text, Text))
resolveLine (Seq (Text, Text)
buf, Seq (Text, Text)
acc) = (Seq (Text, Text)
acc <>) (Seq (Text, Text) -> Seq (Text, Text))
-> (MultilineChars -> Seq (Text, Text))
-> MultilineChars
-> Seq (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultilineChars -> Seq (Text, Text)
forall a. [a] -> Seq a
Seq.fromList (MultilineChars -> Seq (Text, Text))
-> MultilineProcessorM MultilineChars
-> StateT
     MultilineProcessorState
     (ParsecT Void Text (Reader ParseConfig))
     (Seq (Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MultilineChars -> MultilineProcessorM MultilineChars
f (Seq (Text, Text) -> MultilineChars
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Seq.toList Seq (Text, Text)
buf)
        go :: (Seq (Text, Text), Seq (Text, Text))
-> (Text, Text)
-> StateT
     MultilineProcessorState
     (ParsecT Void Text (Reader ParseConfig))
     (Seq (Text, Text), Seq (Text, Text))
go (Seq (Text, Text)
buf, Seq (Text, Text)
acc) (Text
c, Text
src)
          -- If we're at a newline, `buf` contains the chars before the newline.
          -- Apply the function and reset the buffer. The newline should be added
          -- directly to the accumulator, since the newline isn't part of the line.
          -- Per (3.12.1), newline characters are normalized to LF.
          | Text
c Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
chars_newline = do
              Seq (Text, Text)
acc' <- (Seq (Text, Text), Seq (Text, Text))
-> StateT
     MultilineProcessorState
     (ParsecT Void Text (Reader ParseConfig))
     (Seq (Text, Text))
resolveLine (Seq (Text, Text)
buf, Seq (Text, Text)
acc)
              (MultilineProcessorState -> MultilineProcessorState)
-> StateT
     MultilineProcessorState (ParsecT Void Text (Reader ParseConfig)) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify ((MultilineProcessorState -> MultilineProcessorState)
 -> StateT
      MultilineProcessorState
      (ParsecT Void Text (Reader ParseConfig))
      ())
-> (MultilineProcessorState -> MultilineProcessorState)
-> StateT
     MultilineProcessorState (ParsecT Void Text (Reader ParseConfig)) ()
forall a b. (a -> b) -> a -> b
$ \MultilineProcessorState
s ->
                let lineLen :: Int
lineLen = Seq Int -> Int
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Seq Int -> Int) -> (Seq Text -> Seq Int) -> Seq Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Int) -> Seq Text -> Seq Int
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
Text.length (Seq Text -> Int) -> Seq Text -> Int
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Text) -> Seq (Text, Text) -> Seq Text
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Text) -> Text
forall a b. (a, b) -> b
snd Seq (Text, Text)
buf Seq Text -> Text -> Seq Text
forall a. Seq a -> a -> Seq a
Seq.|> Text
src
                 in MultilineProcessorState
s{lineStartOffset = s.lineStartOffset + lineLen}
              (Seq (Text, Text), Seq (Text, Text))
-> StateT
     MultilineProcessorState
     (ParsecT Void Text (Reader ParseConfig))
     (Seq (Text, Text), Seq (Text, Text))
forall a.
a
-> StateT
     MultilineProcessorState (ParsecT Void Text (Reader ParseConfig)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq (Text, Text)
forall a. Seq a
Seq.empty, Seq (Text, Text)
acc' Seq (Text, Text) -> (Text, Text) -> Seq (Text, Text)
forall a. Seq a -> a -> Seq a
Seq.|> (Text
"\n", Text
src))
          -- Otherwise, append to the buffer and continue
          | Bool
otherwise = do
              (Seq (Text, Text), Seq (Text, Text))
-> StateT
     MultilineProcessorState
     (ParsecT Void Text (Reader ParseConfig))
     (Seq (Text, Text), Seq (Text, Text))
forall a.
a
-> StateT
     MultilineProcessorState (ParsecT Void Text (Reader ParseConfig)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq (Text, Text)
buf Seq (Text, Text) -> (Text, Text) -> Seq (Text, Text)
forall a. Seq a -> a -> Seq a
Seq.|> (Text
c, Text
src), Seq (Text, Text)
acc)
     in ((Seq (Text, Text), Seq (Text, Text))
 -> (Text, Text)
 -> StateT
      MultilineProcessorState
      (ParsecT Void Text (Reader ParseConfig))
      (Seq (Text, Text), Seq (Text, Text)))
-> (Seq (Text, Text), Seq (Text, Text))
-> MultilineChars
-> StateT
     MultilineProcessorState
     (ParsecT Void Text (Reader ParseConfig))
     (Seq (Text, Text), Seq (Text, Text))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (Seq (Text, Text), Seq (Text, Text))
-> (Text, Text)
-> StateT
     MultilineProcessorState
     (ParsecT Void Text (Reader ParseConfig))
     (Seq (Text, Text), Seq (Text, Text))
go (Seq (Text, Text)
forall a. Seq a
Seq.empty, Seq (Text, Text)
forall a. Seq a
Seq.empty)
          -- Resolve line one last time to apply the function on the last line
          (MultilineChars
 -> StateT
      MultilineProcessorState
      (ParsecT Void Text (Reader ParseConfig))
      (Seq (Text, Text), Seq (Text, Text)))
-> ((Seq (Text, Text), Seq (Text, Text))
    -> MultilineProcessorM MultilineChars)
-> MultilineChars
-> MultilineProcessorM MultilineChars
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Seq (Text, Text), Seq (Text, Text))
-> StateT
     MultilineProcessorState
     (ParsecT Void Text (Reader ParseConfig))
     (Seq (Text, Text))
resolveLine
          ((Seq (Text, Text), Seq (Text, Text))
 -> StateT
      MultilineProcessorState
      (ParsecT Void Text (Reader ParseConfig))
      (Seq (Text, Text)))
-> (Seq (Text, Text) -> MultilineProcessorM MultilineChars)
-> (Seq (Text, Text), Seq (Text, Text))
-> MultilineProcessorM MultilineChars
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (MultilineChars -> MultilineProcessorM MultilineChars
forall a.
a
-> StateT
     MultilineProcessorState (ParsecT Void Text (Reader ParseConfig)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MultilineChars -> MultilineProcessorM MultilineChars)
-> (Seq (Text, Text) -> MultilineChars)
-> Seq (Text, Text)
-> MultilineProcessorM MultilineChars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Text, Text) -> MultilineChars
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Seq.toList)

{----- (3.13) Raw String -----}

-- | ref: (3.13)
-- raw-string := '#' raw-string-quotes '#' | '#' raw-string '#'
p_raw_string :: Parser Text
p_raw_string :: Parser Text
p_raw_string = String -> Parser Text -> Parser Text
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"raw string" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
  -- For efficiency, we'll implement this slightly differently than the grammar
  -- verbatim. Find all the hashes up front and use that to pass the closing
  -- delimiter to the inner parsers.
  Text
delim <- Parser [Tokens Text] -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser [Tokens Text] -> Parser Text)
-> (ParsecT Void Text (Reader ParseConfig) (Tokens Text)
    -> Parser [Tokens Text])
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser [Tokens Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text (Reader ParseConfig) (Tokens Text)
 -> Parser Text)
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser Text
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#"
  Text
s <- ParsecT Void Text (Reader ParseConfig) (Tokens Text) -> Parser Text
forall a. Parser a -> Parser Text
p_raw_string_quotes (Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
delim)
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
delim
  Text -> Parser Text
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s

-- | ref: (3.13)
-- raw-string-quotes :=
--     '"' single-line-raw-string-body '"' |
--     '"""' newline
--     (multi-line-raw-string-body newline)?
--     unicode-space* '"""'
p_raw_string_quotes :: Parser end -> Parser Text
p_raw_string_quotes :: forall a. Parser a -> Parser Text
p_raw_string_quotes Parser end
end = String -> Parser Text -> Parser Text
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"raw string quotes" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
  [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser Text
-> Parser Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
quotes3) (Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
quotes3) (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
        (forall end. Parser end -> Parser MultilineChars)
-> Parser Text -> Parser Text
parseMultilineString
          Parser end -> Parser MultilineChars
forall end. Parser end -> Parser MultilineChars
p_multi_line_raw_string_body
          (Parser Text -> Parser Text
forall a. Monoid a => Parser a -> Parser a
repeat0 (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
Text.singleton (Char -> Text)
-> ParsecT Void Text (Reader ParseConfig) Char -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader ParseConfig) Char
p_unicode_space)
    , ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser Text
-> Parser Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
quotes1) (Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
quotes1) (Parser Text -> Parser Text)
-> (Parser () -> Parser Text) -> Parser () -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser () -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser () -> Parser Text) -> Parser () -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
        Parser end -> Parser ()
forall a. ParsecT Void Text (Reader ParseConfig) a -> Parser ()
p_single_line_raw_string_body (Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
quotes1 ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser end -> Parser end
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser end
end)
    ]

-- | ref: (3.13)
-- single-line-raw-string-body :=
--     '' |
--     (single-line-raw-string-char - '"')
--         single-line-raw-string-char*? |
--     '"' (single-line-raw-string-char - '"')
--         single-line-raw-string-char*?
p_single_line_raw_string_body :: Parser end -> Parser ()
p_single_line_raw_string_body :: forall a. ParsecT Void Text (Reader ParseConfig) a -> Parser ()
p_single_line_raw_string_body Parser end
end = String -> Parser () -> Parser ()
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"raw string single line" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Void Text (Reader ParseConfig) (Maybe String) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text (Reader ParseConfig) (Maybe String)
 -> Parser ())
-> (ParsecT Void Text (Reader ParseConfig) String
    -> ParsecT Void Text (Reader ParseConfig) (Maybe String))
-> ParsecT Void Text (Reader ParseConfig) String
-> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text (Reader ParseConfig) String
-> ParsecT Void Text (Reader ParseConfig) (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text (Reader ParseConfig) String -> Parser ())
-> ParsecT Void Text (Reader ParseConfig) String -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe Char
_ <- ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text (Reader ParseConfig) Char
 -> ParsecT Void Text (Reader ParseConfig) (Maybe Char))
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"'
    Char
c <- ParsecT Void Text (Reader ParseConfig) Char
p_single_line_raw_string_char
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"'
    ParsecT Void Text (Reader ParseConfig) Char
-> Parser end -> ParsecT Void Text (Reader ParseConfig) String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text (Reader ParseConfig) Char
p_single_line_raw_string_char (Parser end -> Parser end
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser end -> Parser end) -> Parser end -> Parser end
forall a b. (a -> b) -> a -> b
$ Parser end -> Parser end
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead Parser end
end)

-- | ref: (3.13)
-- single-line-raw-string-char :=
--     unicode - newline - disallowed-literal-code-points
p_single_line_raw_string_char :: Parser Char
p_single_line_raw_string_char :: ParsecT Void Text (Reader ParseConfig) Char
p_single_line_raw_string_char = String
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"raw string character" (ParsecT Void Text (Reader ParseConfig) Char
 -> ParsecT Void Text (Reader ParseConfig) Char)
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a b. (a -> b) -> a -> b
$ do
  Char
c <- ParsecT Void Text (Reader ParseConfig) Char
p_unicode
  Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Text
Text.singleton Char
c Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
chars_newline
  Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
is_disallowed_literal_code_points Char
c
  Char -> ParsecT Void Text (Reader ParseConfig) Char
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c

-- | ref: (3.13)
-- multi-line-raw-string-body :=
--     (unicode - disallowed-literal-code-points)*?
p_multi_line_raw_string_body :: Parser end -> Parser MultilineChars
p_multi_line_raw_string_body :: forall end. Parser end -> Parser MultilineChars
p_multi_line_raw_string_body Parser end
end = String -> Parser MultilineChars -> Parser MultilineChars
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"raw string multiline body" (Parser MultilineChars -> Parser MultilineChars)
-> Parser MultilineChars -> Parser MultilineChars
forall a b. (a -> b) -> a -> b
$ do
  Parser (Text, Text) -> Parser end -> Parser MultilineChars
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill Parser (Text, Text)
validChar (Parser end -> Parser end
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser end -> Parser end)
-> (Parser end -> Parser end) -> Parser end -> Parser end
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser end -> Parser end
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Parser end -> Parser end) -> Parser end -> Parser end
forall a b. (a -> b) -> a -> b
$ Parser end
end)
 where
  validChar :: Parser (Text, Text)
validChar = do
    Char
c <- ParsecT Void Text (Reader ParseConfig) Char
p_unicode
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
is_disallowed_literal_code_points Char
c
    let s :: Text
s = Char -> Text
Text.singleton Char
c
    (Text, Text) -> Parser (Text, Text)
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
s, Text
s)

{----- (3.14) Number -----}

-- | ref: (3.14)
-- number := keyword-number | hex | octal | binary | decimal
p_number :: Parser ValueData
p_number :: Parser ValueData
p_number = String -> Parser ValueData -> Parser ValueData
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"number" (Parser ValueData -> Parser ValueData)
-> Parser ValueData -> Parser ValueData
forall a b. (a -> b) -> a -> b
$ do
  [Parser ValueData] -> Parser ValueData
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser ValueData] -> Parser ValueData)
-> ([Parser ValueData] -> [Parser ValueData])
-> [Parser ValueData]
-> Parser ValueData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser ValueData -> Parser ValueData)
-> [Parser ValueData] -> [Parser ValueData]
forall a b. (a -> b) -> [a] -> [b]
map Parser ValueData -> Parser ValueData
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ([Parser ValueData] -> Parser ValueData)
-> [Parser ValueData] -> Parser ValueData
forall a b. (a -> b) -> a -> b
$
    [ Parser ValueData
p_keyword_number
    , Scientific -> ValueData
Number (Scientific -> ValueData)
-> ParsecT Void Text (Reader ParseConfig) Scientific
-> Parser ValueData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader ParseConfig) Scientific
p_hex
    , Scientific -> ValueData
Number (Scientific -> ValueData)
-> ParsecT Void Text (Reader ParseConfig) Scientific
-> Parser ValueData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader ParseConfig) Scientific
p_octal
    , Scientific -> ValueData
Number (Scientific -> ValueData)
-> ParsecT Void Text (Reader ParseConfig) Scientific
-> Parser ValueData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader ParseConfig) Scientific
p_binary
    , Scientific -> ValueData
Number (Scientific -> ValueData)
-> ParsecT Void Text (Reader ParseConfig) Scientific
-> Parser ValueData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader ParseConfig) Scientific
p_decimal
    ]

-- | ref: (3.14)
-- hex := sign? '0x' hex-digit (hex-digit | '_')*
p_hex :: Parser Scientific
p_hex :: ParsecT Void Text (Reader ParseConfig) Scientific
p_hex = String
-> ParsecT Void Text (Reader ParseConfig) Scientific
-> ParsecT Void Text (Reader ParseConfig) Scientific
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"hex" (ParsecT Void Text (Reader ParseConfig) Scientific
 -> ParsecT Void Text (Reader ParseConfig) Scientific)
-> ParsecT Void Text (Reader ParseConfig) Scientific
-> ParsecT Void Text (Reader ParseConfig) Scientific
forall a b. (a -> b) -> a -> b
$ Text
-> Integer
-> (Char -> Bool)
-> ParsecT Void Text (Reader ParseConfig) Scientific
parseNumWith Text
"0x" Integer
16 Char -> Bool
isHexDigit

-- | ref: (3.14)
-- hex-digit := [0-9a-fA-F]
p_hex_digit :: Parser Int
p_hex_digit :: ParsecT Void Text (Reader ParseConfig) Int
p_hex_digit = String
-> ParsecT Void Text (Reader ParseConfig) Int
-> ParsecT Void Text (Reader ParseConfig) Int
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"hex digit" (ParsecT Void Text (Reader ParseConfig) Int
 -> ParsecT Void Text (Reader ParseConfig) Int)
-> ParsecT Void Text (Reader ParseConfig) Int
-> ParsecT Void Text (Reader ParseConfig) Int
forall a b. (a -> b) -> a -> b
$ do
  Char -> Int
digitToInt (Char -> Int)
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool)
-> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isHexDigit

-- | ref: (3.14)
-- octal := sign? '0o' [0-7] [0-7_]*
p_octal :: Parser Scientific
p_octal :: ParsecT Void Text (Reader ParseConfig) Scientific
p_octal = String
-> ParsecT Void Text (Reader ParseConfig) Scientific
-> ParsecT Void Text (Reader ParseConfig) Scientific
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"octal" (ParsecT Void Text (Reader ParseConfig) Scientific
 -> ParsecT Void Text (Reader ParseConfig) Scientific)
-> ParsecT Void Text (Reader ParseConfig) Scientific
-> ParsecT Void Text (Reader ParseConfig) Scientific
forall a b. (a -> b) -> a -> b
$ Text
-> Integer
-> (Char -> Bool)
-> ParsecT Void Text (Reader ParseConfig) Scientific
parseNumWith Text
"0o" Integer
8 Char -> Bool
isOctDigit

-- | ref: (3.14)
-- binary := sign? '0b' ('0' | '1') ('0' | '1' | '_')*
p_binary :: Parser Scientific
p_binary :: ParsecT Void Text (Reader ParseConfig) Scientific
p_binary = String
-> ParsecT Void Text (Reader ParseConfig) Scientific
-> ParsecT Void Text (Reader ParseConfig) Scientific
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"binary" (ParsecT Void Text (Reader ParseConfig) Scientific
 -> ParsecT Void Text (Reader ParseConfig) Scientific)
-> ParsecT Void Text (Reader ParseConfig) Scientific
-> ParsecT Void Text (Reader ParseConfig) Scientific
forall a b. (a -> b) -> a -> b
$ Text
-> Integer
-> (Char -> Bool)
-> ParsecT Void Text (Reader ParseConfig) Scientific
parseNumWith Text
"0b" Integer
2 Char -> Bool
isBinDigit
 where
  isBinDigit :: Char -> Bool
isBinDigit Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'1'

parseNumWith :: Text -> Integer -> (Char -> Bool) -> Parser Scientific
parseNumWith :: Text
-> Integer
-> (Char -> Bool)
-> ParsecT Void Text (Reader ParseConfig) Scientific
parseNumWith Text
prefix Integer
base Char -> Bool
isValid = do
  Scientific -> Scientific
signed <- Parser (Scientific -> Scientific)
forall a. Num a => Parser (a -> a)
parseSigned
  Tokens Text
_ <- Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
prefix
  (Integer
x, Int
_) <- Integer -> (Char -> Bool) -> Parser (Integer, Int)
p_digits Integer
base Char -> Bool
isValid
  Scientific -> ParsecT Void Text (Reader ParseConfig) Scientific
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> ParsecT Void Text (Reader ParseConfig) Scientific)
-> (Integer -> Scientific)
-> Integer
-> ParsecT Void Text (Reader ParseConfig) Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Scientific
signed (Scientific -> Scientific)
-> (Integer -> Scientific) -> Integer -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (Integer -> ParsecT Void Text (Reader ParseConfig) Scientific)
-> Integer -> ParsecT Void Text (Reader ParseConfig) Scientific
forall a b. (a -> b) -> a -> b
$ Integer
x

-- | ref: (3.14)
-- decimal := sign? integer ('.' integer)? exponent?
p_decimal :: Parser Scientific
p_decimal :: ParsecT Void Text (Reader ParseConfig) Scientific
p_decimal = String
-> ParsecT Void Text (Reader ParseConfig) Scientific
-> ParsecT Void Text (Reader ParseConfig) Scientific
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"decimal number" (ParsecT Void Text (Reader ParseConfig) Scientific
 -> ParsecT Void Text (Reader ParseConfig) Scientific)
-> ParsecT Void Text (Reader ParseConfig) Scientific
-> ParsecT Void Text (Reader ParseConfig) Scientific
forall a b. (a -> b) -> a -> b
$ do
  Scientific -> Scientific
signed <- Parser (Scientific -> Scientific)
forall a. Num a => Parser (a -> a)
parseSigned
  (Integer
i, Int
_) <- Parser (Integer, Int)
p_integer
  (Integer
f, Int
fdigits) <- (Integer, Int) -> Parser (Integer, Int) -> Parser (Integer, Int)
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option (Integer
0, Int
0) (Parser (Integer, Int) -> Parser (Integer, Int))
-> Parser (Integer, Int) -> Parser (Integer, Int)
forall a b. (a -> b) -> a -> b
$ String
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"decimal point" (Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.') ParsecT Void Text (Reader ParseConfig) Char
-> Parser (Integer, Int) -> Parser (Integer, Int)
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Integer, Int)
p_integer
  Int
e <- Int
-> ParsecT Void Text (Reader ParseConfig) Int
-> ParsecT Void Text (Reader ParseConfig) Int
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Int
0 ParsecT Void Text (Reader ParseConfig) Int
p_exponent
  Scientific -> ParsecT Void Text (Reader ParseConfig) Scientific
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> ParsecT Void Text (Reader ParseConfig) Scientific)
-> (Scientific -> Scientific)
-> Scientific
-> ParsecT Void Text (Reader ParseConfig) Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Scientific
signed (Scientific -> ParsecT Void Text (Reader ParseConfig) Scientific)
-> Scientific -> ParsecT Void Text (Reader ParseConfig) Scientific
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Scientific
Scientific.scientific (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
fdigits) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
f) (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fdigits)

-- | ref: (3.14)
-- integer := digit (digit | '_')*
p_integer :: Parser (Integer, Int)
p_integer :: Parser (Integer, Int)
p_integer = String -> Parser (Integer, Int) -> Parser (Integer, Int)
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"integer" (Parser (Integer, Int) -> Parser (Integer, Int))
-> Parser (Integer, Int) -> Parser (Integer, Int)
forall a b. (a -> b) -> a -> b
$ Integer -> (Char -> Bool) -> Parser (Integer, Int)
p_digits Integer
10 Char -> Bool
isDigit

p_digits :: Integer -> (Char -> Bool) -> Parser (Integer, Int)
p_digits :: Integer -> (Char -> Bool) -> Parser (Integer, Int)
p_digits Integer
base Char -> Bool
isValid = do
  Int
d <- ParsecT Void Text (Reader ParseConfig) Int
p_digit
  [Int]
ds <-
    ([Maybe Int] -> [Int])
-> ParsecT Void Text (Reader ParseConfig) [Maybe Int]
-> Parser [Int]
forall a b.
(a -> b)
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes (ParsecT Void Text (Reader ParseConfig) [Maybe Int]
 -> Parser [Int])
-> ([ParsecT Void Text (Reader ParseConfig) (Maybe Int)]
    -> ParsecT Void Text (Reader ParseConfig) [Maybe Int])
-> [ParsecT Void Text (Reader ParseConfig) (Maybe Int)]
-> Parser [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text (Reader ParseConfig) (Maybe Int)
-> ParsecT Void Text (Reader ParseConfig) [Maybe Int]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text (Reader ParseConfig) (Maybe Int)
 -> ParsecT Void Text (Reader ParseConfig) [Maybe Int])
-> ([ParsecT Void Text (Reader ParseConfig) (Maybe Int)]
    -> ParsecT Void Text (Reader ParseConfig) (Maybe Int))
-> [ParsecT Void Text (Reader ParseConfig) (Maybe Int)]
-> ParsecT Void Text (Reader ParseConfig) [Maybe Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParsecT Void Text (Reader ParseConfig) (Maybe Int)]
-> ParsecT Void Text (Reader ParseConfig) (Maybe Int)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT Void Text (Reader ParseConfig) (Maybe Int)]
 -> Parser [Int])
-> [ParsecT Void Text (Reader ParseConfig) (Maybe Int)]
-> Parser [Int]
forall a b. (a -> b) -> a -> b
$
      [ Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> ParsecT Void Text (Reader ParseConfig) Int
-> ParsecT Void Text (Reader ParseConfig) (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader ParseConfig) Int
p_digit
      , Maybe Int
forall a. Maybe a
Nothing Maybe Int
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) (Maybe Int)
forall a b.
a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_')
      ]
  let digits :: [Integer]
digits = (Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
d Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
ds)
  (Integer, Int) -> Parser (Integer, Int)
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> [Integer] -> Integer
forall a. Num a => a -> [a] -> a
undigits Integer
base [Integer]
digits, [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
digits)
 where
  p_digit :: ParsecT Void Text (Reader ParseConfig) Int
p_digit = Char -> Int
digitToInt (Char -> Int)
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool)
-> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isValid

-- | ref: (3.14)
-- exponent := ('e' | 'E') sign? integer
p_exponent :: Parser Int
p_exponent :: ParsecT Void Text (Reader ParseConfig) Int
p_exponent = String
-> ParsecT Void Text (Reader ParseConfig) Int
-> ParsecT Void Text (Reader ParseConfig) Int
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"exponent" (ParsecT Void Text (Reader ParseConfig) Int
 -> ParsecT Void Text (Reader ParseConfig) Int)
-> ParsecT Void Text (Reader ParseConfig) Int
-> ParsecT Void Text (Reader ParseConfig) Int
forall a b. (a -> b) -> a -> b
$ do
  Token Text
_ <- [Token Text] -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'e', Char
'E']
  Int -> Int
signed <- Parser (Int -> Int)
forall a. Num a => Parser (a -> a)
parseSigned
  (Integer
x, Int
_) <- Parser (Integer, Int)
p_integer
  case Integer -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized Integer
x of
    Just Int
x' -> Int -> ParsecT Void Text (Reader ParseConfig) Int
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ParsecT Void Text (Reader ParseConfig) Int)
-> Int -> ParsecT Void Text (Reader ParseConfig) Int
forall a b. (a -> b) -> a -> b
$ Int -> Int
signed Int
x'
    Maybe Int
Nothing -> String -> ParsecT Void Text (Reader ParseConfig) Int
forall a. String -> ParsecT Void Text (Reader ParseConfig) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT Void Text (Reader ParseConfig) Int)
-> String -> ParsecT Void Text (Reader ParseConfig) Int
forall a b. (a -> b) -> a -> b
$ String
"Exponent is too large: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
x

-- | ref: (3.14)
-- sign := '+' | '-'
p_sign :: Parser Char
p_sign :: ParsecT Void Text (Reader ParseConfig) Char
p_sign = String
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"sign" (ParsecT Void Text (Reader ParseConfig) Char
 -> ParsecT Void Text (Reader ParseConfig) Char)
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a b. (a -> b) -> a -> b
$ do
  [Token Text] -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'-', Char
'+']

parseSigned :: (Num a) => Parser (a -> a)
parseSigned :: forall a. Num a => Parser (a -> a)
parseSigned = Maybe Char -> a -> a
toSign (Maybe Char -> a -> a)
-> ParsecT Void Text (Reader ParseConfig) (Maybe Char)
-> ParsecT Void Text (Reader ParseConfig) (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text (Reader ParseConfig) Char
p_sign
 where
  toSign :: Maybe Char -> a -> a
toSign = \case
    Just Char
'-' -> a -> a
forall a. Num a => a -> a
negate
    Maybe Char
_ -> a -> a
forall a. a -> a
id

-- | ref: (3.14.1)
-- keyword-number := '#inf' | '#-inf' | '#nan'
p_keyword_number :: Parser ValueData
p_keyword_number :: Parser ValueData
p_keyword_number = do
  [Parser ValueData] -> Parser ValueData
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ValueData
Inf ValueData
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser ValueData
forall a b.
a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#inf"
    , ValueData
NegInf ValueData
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser ValueData
forall a b.
a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#-inf"
    , ValueData
NaN ValueData
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser ValueData
forall a b.
a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#nan"
    ]

{----- (3.15) Boolean -----}

-- | ref: (3.15)
-- boolean := '#true' | '#false'
p_boolean :: Parser Bool
p_boolean :: ParsecT Void Text (Reader ParseConfig) Bool
p_boolean = String
-> ParsecT Void Text (Reader ParseConfig) Bool
-> ParsecT Void Text (Reader ParseConfig) Bool
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"boolean" (ParsecT Void Text (Reader ParseConfig) Bool
 -> ParsecT Void Text (Reader ParseConfig) Bool)
-> ParsecT Void Text (Reader ParseConfig) Bool
-> ParsecT Void Text (Reader ParseConfig) Bool
forall a b. (a -> b) -> a -> b
$ do
  [ParsecT Void Text (Reader ParseConfig) Bool]
-> ParsecT Void Text (Reader ParseConfig) Bool
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Bool
True Bool
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> ParsecT Void Text (Reader ParseConfig) Bool
forall a b.
a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#true"
    , Bool
False Bool
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> ParsecT Void Text (Reader ParseConfig) Bool
forall a b.
a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#false"
    ]

{----- (3.17) Whitespace -----}

-- | ref: (3.17)
-- ws := unicode-space | multi-line-comment
p_ws :: Parser Text
p_ws :: Parser Text
p_ws = String -> Parser Text -> Parser Text
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"whitespace" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
  (Char -> Text
Text.singleton (Char -> Text)
-> ParsecT Void Text (Reader ParseConfig) Char -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (Reader ParseConfig) Char
p_unicode_space) Parser Text -> Parser Text -> Parser Text
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
p_multi_line_comment

-- | ref: (3.17)
-- unicode-space := See Table
--     (All White_Space unicode characters which are not `newline`)
p_unicode_space :: Parser Char
p_unicode_space :: ParsecT Void Text (Reader ParseConfig) Char
p_unicode_space = String
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"unicode space" (ParsecT Void Text (Reader ParseConfig) Char
 -> ParsecT Void Text (Reader ParseConfig) Char)
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a b. (a -> b) -> a -> b
$ do
  [ParsecT Void Text (Reader ParseConfig) Char]
-> ParsecT Void Text (Reader ParseConfig) Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
c ParsecT Void Text (Reader ParseConfig) Char
-> String -> ParsecT Void Text (Reader ParseConfig) Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
l
    | (Char
c, String
l) <- [(Char, String)]
chars_unicode_space'
    ]

-- | ref: (3.17)
chars_unicode_space :: Set Char
chars_unicode_space :: Set Char
chars_unicode_space = String -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList (String -> Set Char) -> String -> Set Char
forall a b. (a -> b) -> a -> b
$ ((Char, String) -> Char) -> [(Char, String)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char, String) -> Char
forall a b. (a, b) -> a
fst [(Char, String)]
chars_unicode_space'

-- | ref: (3.17)
chars_unicode_space' :: [(Char, String)]
chars_unicode_space' :: [(Char, String)]
chars_unicode_space' =
  [ (Char
'\x0009', String
"character tabulation")
  , (Char
'\x0020', String
"space")
  , (Char
'\x00A0', String
"no-break space")
  , (Char
'\x1680', String
"ogham space mark")
  , (Char
'\x2000', String
"en quad")
  , (Char
'\x2001', String
"em quad")
  , (Char
'\x2002', String
"en space")
  , (Char
'\x2003', String
"em space")
  , (Char
'\x2004', String
"three-per-em space")
  , (Char
'\x2005', String
"four-per-em space")
  , (Char
'\x2006', String
"six-per-em space")
  , (Char
'\x2007', String
"figure space")
  , (Char
'\x2008', String
"punctuation space")
  , (Char
'\x2009', String
"thin space")
  , (Char
'\x200A', String
"hair space")
  , (Char
'\x202F', String
"narrow no-break space")
  , (Char
'\x205F', String
"medium mathmatical space")
  , (Char
'\x3000', String
"ideographic space")
  ]

-- | ref: (3.17.1)
-- single-line-comment := '//' ^newline* (newline | eof)
p_single_line_comment :: Parser Text
p_single_line_comment :: Parser Text
p_single_line_comment = String -> Parser Text -> Parser Text
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"single-line comment" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
  Parser () -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser () -> Parser Text) -> Parser () -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
    Tokens Text
_ <- Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"//"
    Tokens Text
_ <- Maybe String
-> (Token Text -> Bool)
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token Text
'\n')
    Text
_ <- Parser Text
p_newline Parser Text -> Parser Text -> Parser Text
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
p_eof
    () -> Parser ()
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | ref: (3.17.2)
-- multi-line-comment := '/*' commented-block
p_multi_line_comment :: Parser Text
p_multi_line_comment :: Parser Text
p_multi_line_comment = String -> Parser Text -> Parser Text
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"multi-line comment" (Parser Text -> Parser Text)
-> (Parser () -> Parser Text) -> Parser () -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser () -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser () -> Parser Text) -> Parser () -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
  Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"/*" ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser () -> Parser ()
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
p_commented_block

-- | ref: (3.17.2)
-- commented-block :=
--     '*/' | (multi-line-comment | '*' | '/' | [^*/]+) commented-block
p_commented_block :: Parser ()
p_commented_block :: Parser ()
p_commented_block = String -> Parser () -> Parser ()
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"commented block" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
  [Parser ()] -> Parser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ParsecT Void Text (Reader ParseConfig) (Tokens Text) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text (Reader ParseConfig) (Tokens Text) -> Parser ())
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"*/"
    , do
        [Parser ()] -> Parser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Text
p_multi_line_comment
          , ParsecT Void Text (Reader ParseConfig) Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text (Reader ParseConfig) Char -> Parser ())
-> ParsecT Void Text (Reader ParseConfig) Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*'
          , ParsecT Void Text (Reader ParseConfig) Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text (Reader ParseConfig) Char -> Parser ())
-> ParsecT Void Text (Reader ParseConfig) Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/'
          , ParsecT Void Text (Reader ParseConfig) (Tokens Text) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text (Reader ParseConfig) (Tokens Text) -> Parser ())
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ Maybe String
-> (Token Text -> Bool)
-> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (Token Text -> [Token Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'*', Char
'/'])
          ]
        Parser ()
p_commented_block
    ]

data SlashdashResult = Slashdash Text | NoSlashdash

resolveSlashdash :: SlashdashResult -> Parser a -> Parser (Either Text a)
resolveSlashdash :: forall a. SlashdashResult -> Parser a -> Parser (Either Text a)
resolveSlashdash = \case
  Slashdash Text
sdash -> (Text -> Either Text a) -> Parser Text -> Parser (Either Text a)
forall a b.
(a -> b)
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> (Text -> Text) -> Text -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
sdash <>)) (Parser Text -> Parser (Either Text a))
-> (Parser a -> Parser Text) -> Parser a -> Parser (Either Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Parser Text
forall a. Parser a -> Parser Text
withSource_
  SlashdashResult
NoSlashdash -> (a -> Either Text a) -> Parser a -> Parser (Either Text a)
forall a b.
(a -> b)
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either Text a
forall a b. b -> Either a b
Right

-- | ref: (3.17.3)
-- slashdash := '/-' line-space*
p_slashdash :: Parser SlashdashResult
p_slashdash :: ParsecT Void Text (Reader ParseConfig) SlashdashResult
p_slashdash = ParsecT Void Text (Reader ParseConfig) SlashdashResult
-> ParsecT Void Text (Reader ParseConfig) SlashdashResult
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (ParsecT Void Text (Reader ParseConfig) SlashdashResult
 -> ParsecT Void Text (Reader ParseConfig) SlashdashResult)
-> ParsecT Void Text (Reader ParseConfig) SlashdashResult
-> ParsecT Void Text (Reader ParseConfig) SlashdashResult
forall a b. (a -> b) -> a -> b
$ do
  Text
sdash <- Parser [()] -> Parser Text
forall a. Parser a -> Parser Text
withSource_ (Parser [()] -> Parser Text) -> Parser [()] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"/-" ParsecT Void Text (Reader ParseConfig) (Tokens Text)
-> Parser [()] -> Parser [()]
forall a b.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
p_line_space
  SlashdashResult
-> ParsecT Void Text (Reader ParseConfig) SlashdashResult
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlashdashResult
 -> ParsecT Void Text (Reader ParseConfig) SlashdashResult)
-> SlashdashResult
-> ParsecT Void Text (Reader ParseConfig) SlashdashResult
forall a b. (a -> b) -> a -> b
$ Text -> SlashdashResult
Slashdash Text
sdash

{----- (3.18) Newline -----}

-- | ref: (3.18)
-- newline := See Table (All Newline White_Space)
p_newline :: Parser Text
p_newline :: Parser Text
p_newline = String -> Parser Text -> Parser Text
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"newline" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
  [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Tokens Text -> ParsecT Void Text (Reader ParseConfig) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
Text
s Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
l | (Text
s, String
l) <- [(Text, String)]
chars_newline']

-- | ref: (3.18)
chars_newline :: Set Text
chars_newline :: Set Text
chars_newline = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ ((Text, String) -> Text) -> [(Text, String)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, String) -> Text
forall a b. (a, b) -> a
fst [(Text, String)]
chars_newline'

-- | ref: (3.18)
chars_newline' :: [(Text, String)]
chars_newline' :: [(Text, String)]
chars_newline' =
  [ (Text
"\x000D\x000A", String
"CRLF")
  , (Text
"\x000D", String
"CR")
  , (Text
"\x000A", String
"LF")
  , (Text
"\x0085", String
"NEL")
  , (Text
"\x000B", String
"VT")
  , (Text
"\x000C", String
"FF")
  , (Text
"\x2028", String
"LS")
  , (Text
"\x2029", String
"PS")
  ]

{----- (3.19) Disallowed Literal Code Points -----}

-- | ref: (3.19)
-- disallowed-literal-code-points :=
--     See Table (Disallowed Literal Code Points)
is_disallowed_literal_code_points :: Char -> Bool
is_disallowed_literal_code_points :: Char -> Bool
is_disallowed_literal_code_points Char
c =
  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
    [ -- The codepoints U+0000-0008 or the codepoints U+000E-001F (various control characters).
      [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
        [ Char
'\x0000' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0008'
        , Char
'\x000E' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x001F'
        ]
    , Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x007F' -- U+007F (the Delete control character).
    , (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool
is_unicode_scalar_value (Int -> Bool) -> (Char -> Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) Char
c -- Any codepoint that is not a Unicode Scalar Value (U+D800-DFFF).
    , -- U+200E-200F, U+202A-202E, and U+2066-2069, the unicode "direction control" characters
      [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
        [ Char
'\x200E' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x200F'
        , Char
'\x202A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x202E'
        , Char
'\x2066' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2069'
        ]
    , -- U+FEFF, aka Zero-width Non-breaking Space (ZWNBSP)/Byte Order Mark (BOM), except as the first code point in a document.
      Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\xFEFF'
    ]

{----- Unicode -----}

-- | unicode := Any Unicode Scalar Value
p_unicode :: Parser Char
p_unicode :: ParsecT Void Text (Reader ParseConfig) Char
p_unicode = String
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a.
String
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"unicode scalar value" (ParsecT Void Text (Reader ParseConfig) Char
 -> ParsecT Void Text (Reader ParseConfig) Char)
-> ParsecT Void Text (Reader ParseConfig) Char
-> ParsecT Void Text (Reader ParseConfig) Char
forall a b. (a -> b) -> a -> b
$ do
  (Token Text -> Bool)
-> ParsecT Void Text (Reader ParseConfig) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Int -> Bool
is_unicode_scalar_value (Int -> Bool) -> (Char -> Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)

-- | https://unicode.org/glossary/#unicode_scalar_value
is_unicode_scalar_value :: Int -> Bool
is_unicode_scalar_value :: Int -> Bool
is_unicode_scalar_value Int
x =
  (Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xD7FF) Bool -> Bool -> Bool
|| (Int
0xE000 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10FFFF)

{----- Utilities -----}

withSource :: Parser a -> Parser (a, Text)
withSource :: forall a. Parser a -> Parser (a, Text)
withSource Parser a
p = do
  State Text Void
s <- ParsecT Void Text (Reader ParseConfig) (State Text Void)
forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
getParserState
  a
a <- Parser a
p
  State Text Void
s' <- ParsecT Void Text (Reader ParseConfig) (State Text Void)
forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
getParserState
  let n :: Int
n = State Text Void -> Int
forall s e. State s e -> Int
stateOffset State Text Void
s' Int -> Int -> Int
forall a. Num a => a -> a -> a
- State Text Void -> Int
forall s e. State s e -> Int
stateOffset State Text Void
s
  (a, Text) -> Parser (a, Text)
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, Int -> Text -> Text
Text.take Int
n (State Text Void -> Text
forall s e. State s e -> s
stateInput State Text Void
s))

withSource_ :: Parser a -> Parser Text
withSource_ :: forall a. Parser a -> Parser Text
withSource_ = ((a, Text) -> Text)
-> ParsecT Void Text (Reader ParseConfig) (a, Text) -> Parser Text
forall a b.
(a -> b)
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Text) -> Text
forall a b. (a, b) -> b
snd (ParsecT Void Text (Reader ParseConfig) (a, Text) -> Parser Text)
-> (Parser a -> ParsecT Void Text (Reader ParseConfig) (a, Text))
-> Parser a
-> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ParsecT Void Text (Reader ParseConfig) (a, Text)
forall a. Parser a -> Parser (a, Text)
withSource

newtype SpanStart = SpanStart (Maybe (State Text Void, SourcePos))

withSpan :: Parser a -> Parser (a, Span)
withSpan :: forall a. Parser a -> Parser (a, Span)
withSpan Parser a
p = do
  SpanStart
spanStart <- Parser SpanStart
startSpan
  a
a <- Parser a
p
  Span
span <- SpanStart -> Parser Span
finishSpan SpanStart
spanStart
  (a, Span) -> Parser (a, Span)
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, Span
span)

startSpan :: Parser SpanStart
startSpan :: Parser SpanStart
startSpan = do
  ParseConfig
config <- Reader ParseConfig ParseConfig
-> ParsecT Void Text (Reader ParseConfig) ParseConfig
forall (m :: * -> *) a. Monad m => m a -> ParsecT Void Text m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift Reader ParseConfig ParseConfig
forall (m :: * -> *) r. Monad m => ReaderT r m r
Reader.ask
  if Bool -> Bool
not ParseConfig
config.includeSpans
    then SpanStart -> Parser SpanStart
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpanStart -> Parser SpanStart)
-> (Maybe (State Text Void, SourcePos) -> SpanStart)
-> Maybe (State Text Void, SourcePos)
-> Parser SpanStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (State Text Void, SourcePos) -> SpanStart
SpanStart (Maybe (State Text Void, SourcePos) -> Parser SpanStart)
-> Maybe (State Text Void, SourcePos) -> Parser SpanStart
forall a b. (a -> b) -> a -> b
$ Maybe (State Text Void, SourcePos)
forall a. Maybe a
Nothing
    else do
      SourcePos
start <- ParsecT Void Text (Reader ParseConfig) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
      State Text Void
startState <- ParsecT Void Text (Reader ParseConfig) (State Text Void)
forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
getParserState
      SpanStart -> Parser SpanStart
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpanStart -> Parser SpanStart)
-> ((State Text Void, SourcePos) -> SpanStart)
-> (State Text Void, SourcePos)
-> Parser SpanStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (State Text Void, SourcePos) -> SpanStart
SpanStart (Maybe (State Text Void, SourcePos) -> SpanStart)
-> ((State Text Void, SourcePos)
    -> Maybe (State Text Void, SourcePos))
-> (State Text Void, SourcePos)
-> SpanStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State Text Void, SourcePos) -> Maybe (State Text Void, SourcePos)
forall a. a -> Maybe a
Just ((State Text Void, SourcePos) -> Parser SpanStart)
-> (State Text Void, SourcePos) -> Parser SpanStart
forall a b. (a -> b) -> a -> b
$ (State Text Void
startState, SourcePos
start)

finishSpan :: SpanStart -> Parser Span
finishSpan :: SpanStart -> Parser Span
finishSpan (SpanStart Maybe (State Text Void, SourcePos)
mStart) =
  case Maybe (State Text Void, SourcePos)
mStart of
    Maybe (State Text Void, SourcePos)
Nothing -> Span -> Parser Span
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Span
forall a. Default a => a
def
    Just (State Text Void
startState, SourcePos
start) -> do
      SourcePos
end <- ParsecT Void Text (Reader ParseConfig) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
      State Text Void
endState <- ParsecT Void Text (Reader ParseConfig) (State Text Void)
forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
getParserState
      let startLine :: Int
startLine = Pos -> Int
unPos SourcePos
start.sourceLine
          startCol :: Int
startCol = Pos -> Int
unPos SourcePos
start.sourceColumn
          (Int
endLine, Int
endCol) =
            State Text Void
-> State Text Void -> Int -> (Int, Int) -> (Int, Int)
forall {r} {r} {a}.
(HasField "stateOffset" r Int, HasField "stateOffset" r Int,
 HasField "stateInput" r Text, Num a) =>
r -> r -> Int -> (a, Int) -> (a, Int)
getEnd
              State Text Void
startState
              State Text Void
endState
              Int
startCol
              (Pos -> Int
unPos SourcePos
end.sourceLine, Pos -> Int
unPos SourcePos
end.sourceColumn)
      Span -> Parser Span
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Span{Int
startLine :: Int
startCol :: Int
endLine :: Int
endCol :: Int
endCol :: Int
endLine :: Int
startCol :: Int
startLine :: Int
..}
 where
  -- end.sourceColumn is off by 1, since the parser has already incremented
  -- past the parsed element. So we need to simply subtract 1. However, if
  -- end.sourceColumn == 1, it's at the start of a new line, and we need to
  -- calculate the last column of the previous line.
  getEnd :: r -> r -> Int -> (a, Int) -> (a, Int)
getEnd r
startState r
endState Int
startCol (a
endLine, Int
endCol) =
    if Int
endCol Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
      then (a
endLine, Int
endCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      else
        let len :: Int
len = r
endState.stateOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
- r
startState.stateOffset
            source :: Text
source = Int -> Text -> Text
Text.take Int
len r
startState.stateInput
            endCol' :: Int
endCol' = case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty ([Text] -> Maybe (NonEmpty Text))
-> [Text] -> Maybe (NonEmpty Text)
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.lines Text
source of
              -- source was empty, i.e. len == 0, so endCol := startCol
              Maybe (NonEmpty Text)
Nothing -> Int
startCol
              -- there were no newlines other than the last newline, so we're
              -- offset from startCol
              Just (Text
line NonEmpty.:| []) -> Int
startCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
Text.length Text
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
              -- source had multiple newlines, endCol is simply the length of the last line
              Just NonEmpty Text
sourceLines -> Text -> Int
Text.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> Text
forall a. NonEmpty a -> a
NonEmpty.last NonEmpty Text
sourceLines
         in (a
endLine a -> a -> a
forall a. Num a => a -> a -> a
- a
1, Int
endCol')

repeat0 :: (Monoid a) => Parser a -> Parser a
repeat0 :: forall a. Monoid a => Parser a -> Parser a
repeat0 = ([a] -> a)
-> ParsecT Void Text (Reader ParseConfig) [a]
-> ParsecT Void Text (Reader ParseConfig) a
forall a b.
(a -> b)
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a. Monoid a => [a] -> a
mconcat (ParsecT Void Text (Reader ParseConfig) [a]
 -> ParsecT Void Text (Reader ParseConfig) a)
-> (ParsecT Void Text (Reader ParseConfig) a
    -> ParsecT Void Text (Reader ParseConfig) [a])
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many

quotes1 :: Text
quotes1 :: Text
quotes1 = Text
"\""

quotes3 :: Text
quotes3 :: Text
quotes3 = Text
"\"\"\""

-- | Return a list whose length is in the range [lo, hi], inclusive.
countBetween :: Int -> Int -> Parser a -> Parser [a]
countBetween :: forall a. Int -> Int -> Parser a -> Parser [a]
countBetween Int
lo Int
hi Parser a
m = Int -> ParsecT Void Text (Reader ParseConfig) [a]
go Int
0
 where
  go :: Int -> ParsecT Void Text (Reader ParseConfig) [a]
go Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lo = (:) (a -> [a] -> [a])
-> Parser a -> ParsecT Void Text (Reader ParseConfig) ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
m ParsecT Void Text (Reader ParseConfig) ([a] -> [a])
-> ParsecT Void Text (Reader ParseConfig) [a]
-> ParsecT Void Text (Reader ParseConfig) [a]
forall a b.
ParsecT Void Text (Reader ParseConfig) (a -> b)
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ParsecT Void Text (Reader ParseConfig) [a]
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
hi = ((:) (a -> [a] -> [a])
-> Parser a -> ParsecT Void Text (Reader ParseConfig) ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
m ParsecT Void Text (Reader ParseConfig) ([a] -> [a])
-> ParsecT Void Text (Reader ParseConfig) [a]
-> ParsecT Void Text (Reader ParseConfig) [a]
forall a b.
ParsecT Void Text (Reader ParseConfig) (a -> b)
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ParsecT Void Text (Reader ParseConfig) [a]
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) ParsecT Void Text (Reader ParseConfig) [a]
-> ParsecT Void Text (Reader ParseConfig) [a]
-> ParsecT Void Text (Reader ParseConfig) [a]
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> ParsecT Void Text (Reader ParseConfig) [a]
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    | Bool
otherwise = [a] -> ParsecT Void Text (Reader ParseConfig) [a]
forall a. a -> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

p_eof :: Parser Text
p_eof :: Parser Text
p_eof = Parser Text -> Parser Text
forall a.
ParsecT Void Text (Reader ParseConfig) a
-> ParsecT Void Text (Reader ParseConfig) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Text
"" Text -> Parser () -> Parser Text
forall a b.
a
-> ParsecT Void Text (Reader ParseConfig) b
-> ParsecT Void Text (Reader ParseConfig) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

undigits :: (Num a) => a -> [a] -> a
undigits :: forall a. Num a => a -> [a] -> a
undigits a
base = (a -> a -> a) -> a -> [a] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\a
acc a
x -> a
acc a -> a -> a
forall a. Num a => a -> a -> a
* a
base a -> a -> a
forall a. Num a => a -> a -> a
+ a
x) a
0

-- | Group all 'Left' values and put it in the leading whitespace of the next
-- element. Return any leftover whitespace (i.e. the list ends with 'Left'
-- values).
mergeLeadingWS :: (HasWsFormat a) => Text -> [Either Text a] -> ([a], Text)
mergeLeadingWS :: forall a. HasWsFormat a => Text -> [Either Text a] -> ([a], Text)
mergeLeadingWS Text
initialLeading =
  (Seq a -> [a])
-> (Seq Text -> Text) -> (Seq a, Seq Text) -> ([a], Text)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Seq.toList Seq Text -> Text
toText ((Seq a, Seq Text) -> ([a], Text))
-> ([Either Text a] -> (Seq a, Seq Text))
-> [Either Text a]
-> ([a], Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Seq a, Seq Text) -> Either Text a -> (Seq a, Seq Text))
-> (Seq a, Seq Text) -> [Either Text a] -> (Seq a, Seq Text)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Seq a, Seq Text) -> Either Text a -> (Seq a, Seq Text)
go (Seq a
forall a. Seq a
Seq.empty, Text -> Seq Text
forall a. a -> Seq a
Seq.singleton Text
initialLeading)
 where
  toText :: Seq Text -> Text
toText = [Text] -> Text
Text.concat ([Text] -> Text) -> (Seq Text -> [Text]) -> Seq Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Text -> [Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Seq.toList
  go :: (Seq a, Seq Text) -> Either Text a -> (Seq a, Seq Text)
go (Seq a
nodes, Seq Text
buf) = \case
    Left Text
t -> (Seq a
nodes, Seq Text
buf Seq Text -> Text -> Seq Text
forall a. Seq a -> a -> Seq a
Seq.|> Text
t)
    Right a
node -> (Seq a
nodes Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> Text -> a -> a
forall a. HasWsFormat a => Text -> a -> a
prependLeading (Seq Text -> Text
toText Seq Text
buf) a
node, Seq Text
forall a. Seq a
Seq.empty)

class HasFormat a where
  type KdlFormat a
  mapFormat :: (KdlFormat a -> KdlFormat a) -> a -> a
instance HasFormat NodeList where
  type KdlFormat NodeList = NodeListFormat
  mapFormat :: (KdlFormat Document -> KdlFormat Document) -> Document -> Document
mapFormat KdlFormat Document -> KdlFormat Document
f NodeList{[Node]
NodeListExtension
ext :: Document -> NodeListExtension
nodes :: Document -> [Node]
nodes :: [Node]
ext :: NodeListExtension
..} = NodeList{ext :: NodeListExtension
ext = NodeListExtension
ext{NodeListExtension.format = f <$> ext.format}, [Node]
nodes :: [Node]
nodes :: [Node]
..}
instance HasFormat Node where
  type KdlFormat Node = NodeFormat
  mapFormat :: (KdlFormat Node -> KdlFormat Node) -> Node -> Node
mapFormat KdlFormat Node -> KdlFormat Node
f Node{[Entry]
Maybe Ann
Maybe Document
Identifier
NodeExtension
ext :: Node -> NodeExtension
children :: Node -> Maybe Document
entries :: Node -> [Entry]
name :: Node -> Identifier
ann :: Node -> Maybe Ann
ann :: Maybe Ann
name :: Identifier
entries :: [Entry]
children :: Maybe Document
ext :: NodeExtension
..} = Node{ext :: NodeExtension
ext = NodeExtension
ext{NodeExtension.format = f <$> ext.format}, [Entry]
Maybe Ann
Maybe Document
Identifier
children :: Maybe Document
entries :: [Entry]
name :: Identifier
ann :: Maybe Ann
ann :: Maybe Ann
name :: Identifier
entries :: [Entry]
children :: Maybe Document
..}
instance HasFormat Ann where
  type KdlFormat Ann = AnnFormat
  mapFormat :: (KdlFormat Ann -> KdlFormat Ann) -> Ann -> Ann
mapFormat KdlFormat Ann -> KdlFormat Ann
f Ann{Identifier
AnnExtension
identifier :: Ann -> Identifier
ext :: Ann -> AnnExtension
identifier :: Identifier
ext :: AnnExtension
..} = Ann{ext :: AnnExtension
ext = AnnExtension
ext{AnnExtension.format = f <$> ext.format}, Identifier
identifier :: Identifier
identifier :: Identifier
..}
instance HasFormat Entry where
  type KdlFormat Entry = EntryFormat
  mapFormat :: (KdlFormat Entry -> KdlFormat Entry) -> Entry -> Entry
mapFormat KdlFormat Entry -> KdlFormat Entry
f Entry{Maybe Identifier
Value
EntryExtension
name :: Entry -> Maybe Identifier
ext :: Entry -> EntryExtension
value :: Entry -> Value
name :: Maybe Identifier
value :: Value
ext :: EntryExtension
..} = Entry{ext :: EntryExtension
ext = EntryExtension
ext{EntryExtension.format = f <$> ext.format}, Maybe Identifier
Value
name :: Maybe Identifier
value :: Value
name :: Maybe Identifier
value :: Value
..}

class (HasFormat a) => HasWsFormat a where
  mapLeading :: (Text -> Text) -> a -> a
  mapTrailing :: (Text -> Text) -> a -> a
  prependLeading :: Text -> a -> a
  prependLeading Text
s = (Text -> Text) -> a -> a
forall a. HasWsFormat a => (Text -> Text) -> a -> a
mapLeading (Text
s <>)
  appendTrailing :: Text -> a -> a
  appendTrailing Text
s = (Text -> Text) -> a -> a
forall a. HasWsFormat a => (Text -> Text) -> a -> a
mapTrailing (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s)
instance HasWsFormat NodeList where
  mapLeading :: (Text -> Text) -> Document -> Document
mapLeading Text -> Text
f = (KdlFormat Document -> KdlFormat Document) -> Document -> Document
forall a. HasFormat a => (KdlFormat a -> KdlFormat a) -> a -> a
mapFormat ((KdlFormat Document -> KdlFormat Document)
 -> Document -> Document)
-> (KdlFormat Document -> KdlFormat Document)
-> Document
-> Document
forall a b. (a -> b) -> a -> b
$ \KdlFormat Document
format -> KdlFormat Document
format{NodeListFormat.leading = f format.leading}
  mapTrailing :: (Text -> Text) -> Document -> Document
mapTrailing Text -> Text
f = (KdlFormat Document -> KdlFormat Document) -> Document -> Document
forall a. HasFormat a => (KdlFormat a -> KdlFormat a) -> a -> a
mapFormat ((KdlFormat Document -> KdlFormat Document)
 -> Document -> Document)
-> (KdlFormat Document -> KdlFormat Document)
-> Document
-> Document
forall a b. (a -> b) -> a -> b
$ \KdlFormat Document
format -> KdlFormat Document
format{NodeListFormat.trailing = f format.trailing}
instance HasWsFormat Node where
  mapLeading :: (Text -> Text) -> Node -> Node
mapLeading Text -> Text
f = (KdlFormat Node -> KdlFormat Node) -> Node -> Node
forall a. HasFormat a => (KdlFormat a -> KdlFormat a) -> a -> a
mapFormat ((KdlFormat Node -> KdlFormat Node) -> Node -> Node)
-> (KdlFormat Node -> KdlFormat Node) -> Node -> Node
forall a b. (a -> b) -> a -> b
$ \KdlFormat Node
format -> KdlFormat Node
format{NodeFormat.leading = f format.leading}
  mapTrailing :: (Text -> Text) -> Node -> Node
mapTrailing Text -> Text
f = (KdlFormat Node -> KdlFormat Node) -> Node -> Node
forall a. HasFormat a => (KdlFormat a -> KdlFormat a) -> a -> a
mapFormat ((KdlFormat Node -> KdlFormat Node) -> Node -> Node)
-> (KdlFormat Node -> KdlFormat Node) -> Node -> Node
forall a b. (a -> b) -> a -> b
$ \KdlFormat Node
format -> KdlFormat Node
format{NodeFormat.trailing = f format.trailing}
instance HasWsFormat Ann where
  mapLeading :: (Text -> Text) -> Ann -> Ann
mapLeading Text -> Text
f = (KdlFormat Ann -> KdlFormat Ann) -> Ann -> Ann
forall a. HasFormat a => (KdlFormat a -> KdlFormat a) -> a -> a
mapFormat ((KdlFormat Ann -> KdlFormat Ann) -> Ann -> Ann)
-> (KdlFormat Ann -> KdlFormat Ann) -> Ann -> Ann
forall a b. (a -> b) -> a -> b
$ \KdlFormat Ann
format -> KdlFormat Ann
format{AnnFormat.leading = f format.leading}
  mapTrailing :: (Text -> Text) -> Ann -> Ann
mapTrailing Text -> Text
f = (KdlFormat Ann -> KdlFormat Ann) -> Ann -> Ann
forall a. HasFormat a => (KdlFormat a -> KdlFormat a) -> a -> a
mapFormat ((KdlFormat Ann -> KdlFormat Ann) -> Ann -> Ann)
-> (KdlFormat Ann -> KdlFormat Ann) -> Ann -> Ann
forall a b. (a -> b) -> a -> b
$ \KdlFormat Ann
format -> KdlFormat Ann
format{AnnFormat.trailing = f format.trailing}
instance HasWsFormat Entry where
  mapLeading :: (Text -> Text) -> Entry -> Entry
mapLeading Text -> Text
f = (KdlFormat Entry -> KdlFormat Entry) -> Entry -> Entry
forall a. HasFormat a => (KdlFormat a -> KdlFormat a) -> a -> a
mapFormat ((KdlFormat Entry -> KdlFormat Entry) -> Entry -> Entry)
-> (KdlFormat Entry -> KdlFormat Entry) -> Entry -> Entry
forall a b. (a -> b) -> a -> b
$ \KdlFormat Entry
format -> KdlFormat Entry
format{EntryFormat.leading = f format.leading}
  mapTrailing :: (Text -> Text) -> Entry -> Entry
mapTrailing Text -> Text
f = (KdlFormat Entry -> KdlFormat Entry) -> Entry -> Entry
forall a. HasFormat a => (KdlFormat a -> KdlFormat a) -> a -> a
mapFormat ((KdlFormat Entry -> KdlFormat Entry) -> Entry -> Entry)
-> (KdlFormat Entry -> KdlFormat Entry) -> Entry -> Entry
forall a b. (a -> b) -> a -> b
$ \KdlFormat Entry
format -> KdlFormat Entry
format{EntryFormat.trailing = f format.trailing}