{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}

module Data.NestedText.Parse
  ( ParseError(..)
  , parse
  , parse'
  , parseDocument
  ) where

import Control.Monad (when)
import Control.Monad.Trans.Class (MonadTrans(..))
import qualified Control.Monad.Trans.State.Strict as StateT
import qualified Data.Char as C
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Vector as V
import Data.Void
import Generic.Data
import qualified Pipes as P
import qualified Pipes.Parse as PP
import qualified Pipes.Prelude as P
import qualified Pipes.Text as PT
import Prelude hiding (readList)

import Data.NestedText.To (ToItem(..), ToKey(..))
import Data.NestedText.Type
import Data.NestedText.Util

data Line
  = Line'Blank
  | Line'Comment Int T.Text
  | Line'StringItem Int T.Text
  | Line'ListItem Int T.Text
  | Line'DictItem Int T.Text (Maybe T.Text)
  | Line'KeyItem Int T.Text
  | Line'InlineList Int T.Text
  | Line'InlineDict Int T.Text
  deriving ((forall x. Line -> Rep Line x)
-> (forall x. Rep Line x -> Line) -> Generic Line
forall x. Rep Line x -> Line
forall x. Line -> Rep Line x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Line -> Rep Line x
from :: forall x. Line -> Rep Line x
$cto :: forall x. Rep Line x -> Line
to :: forall x. Rep Line x -> Line
Generic, Line -> Line -> Bool
(Line -> Line -> Bool) -> (Line -> Line -> Bool) -> Eq Line
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
/= :: Line -> Line -> Bool
Eq, Eq Line
Eq Line =>
(Line -> Line -> Ordering)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Line)
-> (Line -> Line -> Line)
-> Ord Line
Line -> Line -> Bool
Line -> Line -> Ordering
Line -> Line -> Line
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Line -> Line -> Ordering
compare :: Line -> Line -> Ordering
$c< :: Line -> Line -> Bool
< :: Line -> Line -> Bool
$c<= :: Line -> Line -> Bool
<= :: Line -> Line -> Bool
$c> :: Line -> Line -> Bool
> :: Line -> Line -> Bool
$c>= :: Line -> Line -> Bool
>= :: Line -> Line -> Bool
$cmax :: Line -> Line -> Line
max :: Line -> Line -> Line
$cmin :: Line -> Line -> Line
min :: Line -> Line -> Line
Ord, Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Line -> ShowS
showsPrec :: Int -> Line -> ShowS
$cshow :: Line -> String
show :: Line -> String
$cshowList :: [Line] -> ShowS
showList :: [Line] -> ShowS
Show)

data ValidLine
  = ValidLine'StringItem Int T.Text
  | ValidLine'ListItem Int T.Text
  | ValidLine'DictItem Int T.Text (Maybe T.Text)
  | ValidLine'KeyItem Int T.Text
  | ValidLine'InlineList Int T.Text
  | ValidLine'InlineDict Int T.Text
  deriving ((forall x. ValidLine -> Rep ValidLine x)
-> (forall x. Rep ValidLine x -> ValidLine) -> Generic ValidLine
forall x. Rep ValidLine x -> ValidLine
forall x. ValidLine -> Rep ValidLine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ValidLine -> Rep ValidLine x
from :: forall x. ValidLine -> Rep ValidLine x
$cto :: forall x. Rep ValidLine x -> ValidLine
to :: forall x. Rep ValidLine x -> ValidLine
Generic, ValidLine -> ValidLine -> Bool
(ValidLine -> ValidLine -> Bool)
-> (ValidLine -> ValidLine -> Bool) -> Eq ValidLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidLine -> ValidLine -> Bool
== :: ValidLine -> ValidLine -> Bool
$c/= :: ValidLine -> ValidLine -> Bool
/= :: ValidLine -> ValidLine -> Bool
Eq, Eq ValidLine
Eq ValidLine =>
(ValidLine -> ValidLine -> Ordering)
-> (ValidLine -> ValidLine -> Bool)
-> (ValidLine -> ValidLine -> Bool)
-> (ValidLine -> ValidLine -> Bool)
-> (ValidLine -> ValidLine -> Bool)
-> (ValidLine -> ValidLine -> ValidLine)
-> (ValidLine -> ValidLine -> ValidLine)
-> Ord ValidLine
ValidLine -> ValidLine -> Bool
ValidLine -> ValidLine -> Ordering
ValidLine -> ValidLine -> ValidLine
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ValidLine -> ValidLine -> Ordering
compare :: ValidLine -> ValidLine -> Ordering
$c< :: ValidLine -> ValidLine -> Bool
< :: ValidLine -> ValidLine -> Bool
$c<= :: ValidLine -> ValidLine -> Bool
<= :: ValidLine -> ValidLine -> Bool
$c> :: ValidLine -> ValidLine -> Bool
> :: ValidLine -> ValidLine -> Bool
$c>= :: ValidLine -> ValidLine -> Bool
>= :: ValidLine -> ValidLine -> Bool
$cmax :: ValidLine -> ValidLine -> ValidLine
max :: ValidLine -> ValidLine -> ValidLine
$cmin :: ValidLine -> ValidLine -> ValidLine
min :: ValidLine -> ValidLine -> ValidLine
Ord, Int -> ValidLine -> ShowS
[ValidLine] -> ShowS
ValidLine -> String
(Int -> ValidLine -> ShowS)
-> (ValidLine -> String)
-> ([ValidLine] -> ShowS)
-> Show ValidLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidLine -> ShowS
showsPrec :: Int -> ValidLine -> ShowS
$cshow :: ValidLine -> String
show :: ValidLine -> String
$cshowList :: [ValidLine] -> ShowS
showList :: [ValidLine] -> ShowS
Show)

data ParseError
  = ParseError'BreakingLinesError
  | ParseError'UnrecognizedLine
  | ParseError'InvalidLine
  | ParseError'InvalidIndent
  | ParseError'InvalidChar
  | ParseError'InvalidEndOfLine
  | ParseError'RemainingInlineContent
  | ParseError'DuplicateKey
  | ParseError'RemainingContent
  | ParseError'Empty
  deriving ((forall x. ParseError -> Rep ParseError x)
-> (forall x. Rep ParseError x -> ParseError) -> Generic ParseError
forall x. Rep ParseError x -> ParseError
forall x. ParseError -> Rep ParseError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParseError -> Rep ParseError x
from :: forall x. ParseError -> Rep ParseError x
$cto :: forall x. Rep ParseError x -> ParseError
to :: forall x. Rep ParseError x -> ParseError
Generic, ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
/= :: ParseError -> ParseError -> Bool
Eq, Eq ParseError
Eq ParseError =>
(ParseError -> ParseError -> Ordering)
-> (ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> ParseError)
-> (ParseError -> ParseError -> ParseError)
-> Ord ParseError
ParseError -> ParseError -> Bool
ParseError -> ParseError -> Ordering
ParseError -> ParseError -> ParseError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ParseError -> ParseError -> Ordering
compare :: ParseError -> ParseError -> Ordering
$c< :: ParseError -> ParseError -> Bool
< :: ParseError -> ParseError -> Bool
$c<= :: ParseError -> ParseError -> Bool
<= :: ParseError -> ParseError -> Bool
$c> :: ParseError -> ParseError -> Bool
> :: ParseError -> ParseError -> Bool
$c>= :: ParseError -> ParseError -> Bool
>= :: ParseError -> ParseError -> Bool
$cmax :: ParseError -> ParseError -> ParseError
max :: ParseError -> ParseError -> ParseError
$cmin :: ParseError -> ParseError -> ParseError
min :: ParseError -> ParseError -> ParseError
Ord, Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseError -> ShowS
showsPrec :: Int -> ParseError -> ShowS
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> ShowS
showList :: [ParseError] -> ShowS
Show)

toLine :: T.Text -> Either ParseError Line
toLine :: Text -> Either ParseError Line
toLine Text
ts =
  let ts0 :: String
ts0 = Text -> String
T.unpack Text
ts
      countPrefixSpaces :: String -> Int
countPrefixSpaces = Int -> String -> Int
forall {t}. Enum t => t -> String -> t
go Int
0
       where
        go :: t -> String -> t
go !t
n (Char
' ':String
xs) = t -> String -> t
go (t -> t
forall a. Enum a => a -> a
succ t
n) String
xs
        go !t
n String
_ = t
n
      indentLevel :: Int
indentLevel = String -> Int
countPrefixSpaces String
ts0
      spanByFirstColon :: String -> Maybe (String, Maybe String)
spanByFirstColon = String -> String -> Maybe (String, Maybe String)
go []
       where
        go :: String -> String -> Maybe (String, Maybe String)
go String
_ [] = Maybe (String, Maybe String)
forall a. Maybe a
Nothing
        go String
revks (Char
':':Char
' ':String
vs) = (String, Maybe String) -> Maybe (String, Maybe String)
forall a. a -> Maybe a
Just
          ( ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isTabOrSpace String
revks
          , String -> Maybe String
forall a. a -> Maybe a
Just String
vs
          )
        go String
revks [Char
':'] = (String, Maybe String) -> Maybe (String, Maybe String)
forall a. a -> Maybe a
Just
          ( ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isTabOrSpace String
revks
          , Maybe String
forall a. Maybe a
Nothing
          )
        go String
revks (Char
x:String
xs) = String -> String -> Maybe (String, Maybe String)
go (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
revks) String
xs
   in case Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
indentLevel String
ts0 of
        [] -> Line -> Either ParseError Line
forall a b. b -> Either a b
Right (Line -> Either ParseError Line) -> Line -> Either ParseError Line
forall a b. (a -> b) -> a -> b
$ Line
Line'Blank
        Char
'#':Char
' ':String
cs1 -> Line -> Either ParseError Line
forall a b. b -> Either a b
Right (Line -> Either ParseError Line) -> Line -> Either ParseError Line
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Line
Line'Comment Int
indentLevel (Text -> Line) -> Text -> Line
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
cs1
        Char
'#':String
cs1 -> Line -> Either ParseError Line
forall a b. b -> Either a b
Right (Line -> Either ParseError Line) -> Line -> Either ParseError Line
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Line
Line'Comment Int
indentLevel (Text -> Line) -> Text -> Line
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
cs1
        [Char
'>'] -> Line -> Either ParseError Line
forall a b. b -> Either a b
Right (Line -> Either ParseError Line) -> Line -> Either ParseError Line
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Line
Line'StringItem Int
indentLevel Text
T.empty
        Char
'>':Char
' ':String
cs1 -> Line -> Either ParseError Line
forall a b. b -> Either a b
Right (Line -> Either ParseError Line) -> Line -> Either ParseError Line
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Line
Line'StringItem Int
indentLevel (Text -> Line) -> Text -> Line
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
cs1
        [Char
'-'] -> Line -> Either ParseError Line
forall a b. b -> Either a b
Right (Line -> Either ParseError Line) -> Line -> Either ParseError Line
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Line
Line'ListItem Int
indentLevel Text
T.empty
        Char
'-':Char
' ':String
cs1 -> Line -> Either ParseError Line
forall a b. b -> Either a b
Right (Line -> Either ParseError Line) -> Line -> Either ParseError Line
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Line
Line'ListItem Int
indentLevel (Text -> Line) -> Text -> Line
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
cs1
        Char
'[':String
_ -> Line -> Either ParseError Line
forall a b. b -> Either a b
Right (Line -> Either ParseError Line) -> Line -> Either ParseError Line
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Line
Line'InlineList Int
indentLevel Text
ts
        Char
'{':String
_ -> Line -> Either ParseError Line
forall a b. b -> Either a b
Right (Line -> Either ParseError Line) -> Line -> Either ParseError Line
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Line
Line'InlineDict Int
indentLevel Text
ts
        [Char
':'] -> Line -> Either ParseError Line
forall a b. b -> Either a b
Right (Line -> Either ParseError Line) -> Line -> Either ParseError Line
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Line
Line'KeyItem Int
indentLevel Text
T.empty
        Char
':':Char
' ':String
cs1 -> Line -> Either ParseError Line
forall a b. b -> Either a b
Right (Line -> Either ParseError Line) -> Line -> Either ParseError Line
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Line
Line'KeyItem Int
indentLevel (Text -> Line) -> Text -> Line
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
cs1
        Char
'\t':String
_ -> ParseError -> Either ParseError Line
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidIndent
        String
cs0 -> case String -> Maybe (String, Maybe String)
spanByFirstColon String
cs0 of
          Just (String
k, Maybe String
mv) -> Line -> Either ParseError Line
forall a b. b -> Either a b
Right (Line -> Either ParseError Line) -> Line -> Either ParseError Line
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Maybe Text -> Line
Line'DictItem Int
indentLevel (String -> Text
T.pack String
k) (String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
mv)
          Maybe (String, Maybe String)
Nothing -> ParseError -> Either ParseError Line
forall a b. a -> Either a b
Left ParseError
ParseError'UnrecognizedLine

toValidLine :: Line -> Maybe ValidLine
toValidLine :: Line -> Maybe ValidLine
toValidLine (Line'StringItem Int
i Text
ts) = ValidLine -> Maybe ValidLine
forall a. a -> Maybe a
Just (ValidLine -> Maybe ValidLine) -> ValidLine -> Maybe ValidLine
forall a b. (a -> b) -> a -> b
$ Int -> Text -> ValidLine
ValidLine'StringItem Int
i Text
ts
toValidLine (Line'ListItem Int
i Text
ts) = ValidLine -> Maybe ValidLine
forall a. a -> Maybe a
Just (ValidLine -> Maybe ValidLine) -> ValidLine -> Maybe ValidLine
forall a b. (a -> b) -> a -> b
$ Int -> Text -> ValidLine
ValidLine'ListItem Int
i Text
ts
toValidLine (Line'DictItem Int
i Text
ts Maybe Text
mts) = ValidLine -> Maybe ValidLine
forall a. a -> Maybe a
Just (ValidLine -> Maybe ValidLine) -> ValidLine -> Maybe ValidLine
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Maybe Text -> ValidLine
ValidLine'DictItem Int
i Text
ts Maybe Text
mts
toValidLine (Line'KeyItem Int
i Text
ts) = ValidLine -> Maybe ValidLine
forall a. a -> Maybe a
Just (ValidLine -> Maybe ValidLine) -> ValidLine -> Maybe ValidLine
forall a b. (a -> b) -> a -> b
$ Int -> Text -> ValidLine
ValidLine'KeyItem Int
i Text
ts
toValidLine (Line'InlineList Int
i Text
ts) = ValidLine -> Maybe ValidLine
forall a. a -> Maybe a
Just (ValidLine -> Maybe ValidLine) -> ValidLine -> Maybe ValidLine
forall a b. (a -> b) -> a -> b
$ Int -> Text -> ValidLine
ValidLine'InlineList Int
i Text
ts
toValidLine (Line'InlineDict Int
i Text
ts) = ValidLine -> Maybe ValidLine
forall a. a -> Maybe a
Just (ValidLine -> Maybe ValidLine) -> ValidLine -> Maybe ValidLine
forall a b. (a -> b) -> a -> b
$ Int -> Text -> ValidLine
ValidLine'InlineDict Int
i Text
ts
toValidLine Line
_ = Maybe ValidLine
forall a. Maybe a
Nothing

validLine'Indent :: ValidLine -> Int
validLine'Indent :: ValidLine -> Int
validLine'Indent (ValidLine'StringItem Int
i Text
_) = Int
i
validLine'Indent (ValidLine'ListItem Int
i Text
_) = Int
i
validLine'Indent (ValidLine'DictItem Int
i Text
_ Maybe Text
_) = Int
i
validLine'Indent (ValidLine'KeyItem Int
i Text
_) = Int
i
validLine'Indent (ValidLine'InlineList Int
i Text
_) = Int
i
validLine'Indent (ValidLine'InlineDict Int
i Text
_) = Int
i

data WaitingCharList
  = WaitingCharList'ValueOrEnd
  | WaitingCharList'Value
  | WaitingCharList'CommaOrEnd
  deriving ((forall x. WaitingCharList -> Rep WaitingCharList x)
-> (forall x. Rep WaitingCharList x -> WaitingCharList)
-> Generic WaitingCharList
forall x. Rep WaitingCharList x -> WaitingCharList
forall x. WaitingCharList -> Rep WaitingCharList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WaitingCharList -> Rep WaitingCharList x
from :: forall x. WaitingCharList -> Rep WaitingCharList x
$cto :: forall x. Rep WaitingCharList x -> WaitingCharList
to :: forall x. Rep WaitingCharList x -> WaitingCharList
Generic, WaitingCharList -> WaitingCharList -> Bool
(WaitingCharList -> WaitingCharList -> Bool)
-> (WaitingCharList -> WaitingCharList -> Bool)
-> Eq WaitingCharList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WaitingCharList -> WaitingCharList -> Bool
== :: WaitingCharList -> WaitingCharList -> Bool
$c/= :: WaitingCharList -> WaitingCharList -> Bool
/= :: WaitingCharList -> WaitingCharList -> Bool
Eq, Eq WaitingCharList
Eq WaitingCharList =>
(WaitingCharList -> WaitingCharList -> Ordering)
-> (WaitingCharList -> WaitingCharList -> Bool)
-> (WaitingCharList -> WaitingCharList -> Bool)
-> (WaitingCharList -> WaitingCharList -> Bool)
-> (WaitingCharList -> WaitingCharList -> Bool)
-> (WaitingCharList -> WaitingCharList -> WaitingCharList)
-> (WaitingCharList -> WaitingCharList -> WaitingCharList)
-> Ord WaitingCharList
WaitingCharList -> WaitingCharList -> Bool
WaitingCharList -> WaitingCharList -> Ordering
WaitingCharList -> WaitingCharList -> WaitingCharList
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WaitingCharList -> WaitingCharList -> Ordering
compare :: WaitingCharList -> WaitingCharList -> Ordering
$c< :: WaitingCharList -> WaitingCharList -> Bool
< :: WaitingCharList -> WaitingCharList -> Bool
$c<= :: WaitingCharList -> WaitingCharList -> Bool
<= :: WaitingCharList -> WaitingCharList -> Bool
$c> :: WaitingCharList -> WaitingCharList -> Bool
> :: WaitingCharList -> WaitingCharList -> Bool
$c>= :: WaitingCharList -> WaitingCharList -> Bool
>= :: WaitingCharList -> WaitingCharList -> Bool
$cmax :: WaitingCharList -> WaitingCharList -> WaitingCharList
max :: WaitingCharList -> WaitingCharList -> WaitingCharList
$cmin :: WaitingCharList -> WaitingCharList -> WaitingCharList
min :: WaitingCharList -> WaitingCharList -> WaitingCharList
Ord, Int -> WaitingCharList -> ShowS
[WaitingCharList] -> ShowS
WaitingCharList -> String
(Int -> WaitingCharList -> ShowS)
-> (WaitingCharList -> String)
-> ([WaitingCharList] -> ShowS)
-> Show WaitingCharList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WaitingCharList -> ShowS
showsPrec :: Int -> WaitingCharList -> ShowS
$cshow :: WaitingCharList -> String
show :: WaitingCharList -> String
$cshowList :: [WaitingCharList] -> ShowS
showList :: [WaitingCharList] -> ShowS
Show)

data WaitingCharDict
  = WaitingCharDict'KeyOrEnd
  | WaitingCharDict'Key
  | WaitingCharDict'Colon Key
  | WaitingCharDict'Value Key
  | WaitingCharDict'CommaOrEnd
  deriving ((forall x. WaitingCharDict -> Rep WaitingCharDict x)
-> (forall x. Rep WaitingCharDict x -> WaitingCharDict)
-> Generic WaitingCharDict
forall x. Rep WaitingCharDict x -> WaitingCharDict
forall x. WaitingCharDict -> Rep WaitingCharDict x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WaitingCharDict -> Rep WaitingCharDict x
from :: forall x. WaitingCharDict -> Rep WaitingCharDict x
$cto :: forall x. Rep WaitingCharDict x -> WaitingCharDict
to :: forall x. Rep WaitingCharDict x -> WaitingCharDict
Generic, WaitingCharDict -> WaitingCharDict -> Bool
(WaitingCharDict -> WaitingCharDict -> Bool)
-> (WaitingCharDict -> WaitingCharDict -> Bool)
-> Eq WaitingCharDict
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WaitingCharDict -> WaitingCharDict -> Bool
== :: WaitingCharDict -> WaitingCharDict -> Bool
$c/= :: WaitingCharDict -> WaitingCharDict -> Bool
/= :: WaitingCharDict -> WaitingCharDict -> Bool
Eq, Eq WaitingCharDict
Eq WaitingCharDict =>
(WaitingCharDict -> WaitingCharDict -> Ordering)
-> (WaitingCharDict -> WaitingCharDict -> Bool)
-> (WaitingCharDict -> WaitingCharDict -> Bool)
-> (WaitingCharDict -> WaitingCharDict -> Bool)
-> (WaitingCharDict -> WaitingCharDict -> Bool)
-> (WaitingCharDict -> WaitingCharDict -> WaitingCharDict)
-> (WaitingCharDict -> WaitingCharDict -> WaitingCharDict)
-> Ord WaitingCharDict
WaitingCharDict -> WaitingCharDict -> Bool
WaitingCharDict -> WaitingCharDict -> Ordering
WaitingCharDict -> WaitingCharDict -> WaitingCharDict
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WaitingCharDict -> WaitingCharDict -> Ordering
compare :: WaitingCharDict -> WaitingCharDict -> Ordering
$c< :: WaitingCharDict -> WaitingCharDict -> Bool
< :: WaitingCharDict -> WaitingCharDict -> Bool
$c<= :: WaitingCharDict -> WaitingCharDict -> Bool
<= :: WaitingCharDict -> WaitingCharDict -> Bool
$c> :: WaitingCharDict -> WaitingCharDict -> Bool
> :: WaitingCharDict -> WaitingCharDict -> Bool
$c>= :: WaitingCharDict -> WaitingCharDict -> Bool
>= :: WaitingCharDict -> WaitingCharDict -> Bool
$cmax :: WaitingCharDict -> WaitingCharDict -> WaitingCharDict
max :: WaitingCharDict -> WaitingCharDict -> WaitingCharDict
$cmin :: WaitingCharDict -> WaitingCharDict -> WaitingCharDict
min :: WaitingCharDict -> WaitingCharDict -> WaitingCharDict
Ord, Int -> WaitingCharDict -> ShowS
[WaitingCharDict] -> ShowS
WaitingCharDict -> String
(Int -> WaitingCharDict -> ShowS)
-> (WaitingCharDict -> String)
-> ([WaitingCharDict] -> ShowS)
-> Show WaitingCharDict
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WaitingCharDict -> ShowS
showsPrec :: Int -> WaitingCharDict -> ShowS
$cshow :: WaitingCharDict -> String
show :: WaitingCharDict -> String
$cshowList :: [WaitingCharDict] -> ShowS
showList :: [WaitingCharDict] -> ShowS
Show)

parse :: TL.Text -> Either ParseError Item
parse :: Text -> Either ParseError Item
parse Text
ts0 = StateT
  (Producer ValidLine (Either ParseError) ())
  (Either ParseError)
  Item
-> Producer ValidLine (Either ParseError) ()
-> Either ParseError Item
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
StateT.evalStateT StateT
  (Producer ValidLine (Either ParseError) ())
  (Either ParseError)
  Item
parser
  (Producer ValidLine (Either ParseError) ()
 -> Either ParseError Item)
-> Producer ValidLine (Either ParseError) ()
-> Either ParseError Item
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Text)
-> Text
-> (Text -> Text)
-> FreeT (Producer Text (Either ParseError)) (Either ParseError) ()
-> Producer Text (Either ParseError) ()
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x)
-> x -> (x -> b) -> FreeT (Producer a m) m r -> Producer b m r
PT.folds Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
T.empty Text -> Text
forall a. a -> a
id (Producer Text (Either ParseError) ()
-> FreeT (Producer Text (Either ParseError)) (Either ParseError) ()
forall (m :: * -> *) r.
Monad m =>
Producer Text m r -> FreeT (Producer Text m) m r
splitLines (Producer Text (Either ParseError) ()
 -> FreeT
      (Producer Text (Either ParseError)) (Either ParseError) ())
-> Producer Text (Either ParseError) ()
-> FreeT (Producer Text (Either ParseError)) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ Text -> Producer' Text (Either ParseError) ()
forall (m :: * -> *). Monad m => Text -> Producer' Text m ()
PT.fromLazy Text
ts0)
  Producer Text (Either ParseError) ()
-> Proxy () Text () Line (Either ParseError) ()
-> Proxy X () () Line (Either ParseError) ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
P.>-> (Text -> Either ParseError Line)
-> Proxy () Text () Line (Either ParseError) ()
forall (m :: * -> *) a b r. Monad m => (a -> m b) -> Pipe a b m r
P.mapM Text -> Either ParseError Line
toLine
  Proxy X () () Line (Either ParseError) ()
-> Proxy () Line () ValidLine (Either ParseError) ()
-> Producer ValidLine (Either ParseError) ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
P.>-> (Line -> Maybe ValidLine)
-> Proxy () Line () ValidLine (Either ParseError) ()
forall (m :: * -> *) a b r.
Functor m =>
(a -> Maybe b) -> Pipe a b m r
P.mapMaybe Line -> Maybe ValidLine
toValidLine
 where
  parser :: StateT
  (Producer ValidLine (Either ParseError) ())
  (Either ParseError)
  Item
parser = do
    Item
xi <- [Ordering]
-> Int
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     Item
readItemIndent [Ordering
EQ] Int
0
    Bool
b <- StateT
  (Producer ValidLine (Either ParseError) ())
  (Either ParseError)
  Bool
Parser ValidLine (Either ParseError) Bool
forall (m :: * -> *) a. Monad m => Parser a m Bool
PP.isEndOfInput
    Bool
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
b) (StateT
   (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
ParseError'RemainingContent
    Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     Item
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return Item
xi
  toItemWithoutError :: (ToItem a, ToItemError a ~ Void) => a -> Item
  toItemWithoutError :: forall a. (ToItem a, ToItemError a ~ X) => a -> Item
toItemWithoutError a
x = case a -> Either (ToItemError a) Item
forall a. ToItem a => a -> Either (ToItemError a) Item
toItem a
x of
    Right Item
y -> Item
y
    Left ToItemError a
_ -> String -> Item
forall a. HasCallStack => String -> a
error String
"toItemWithoutError: unreachable Left"
  toKeyWithoutError :: (ToKey a, ToKeyError a ~ Void) => a -> Key
  toKeyWithoutError :: forall a. (ToKey a, ToKeyError a ~ X) => a -> Key
toKeyWithoutError a
x = case a -> Either (ToKeyError a) Key
forall a. ToKey a => a -> Either (ToKeyError a) Key
toKey a
x of
    Right Key
y -> Key
y
    Left ToKeyError a
_ -> String -> Key
forall a. HasCallStack => String -> a
error String
"toKeyWithoutError: unreachable Left"
  removeEnclosingSpace :: Text -> Text
removeEnclosingSpace = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
C.isSpace (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
C.isSpace

  readItemIndent :: [Ordering]
-> Int
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     Item
readItemIndent [Ordering]
cs Int
i = do
    (Item
item, Int
j) <- StateT
  (Producer ValidLine (Either ParseError) ())
  (Either ParseError)
  (Item, Int)
readItem
    Bool
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Int
i Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
j) Ordering -> [Ordering] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Ordering]
cs) (StateT
   (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidIndent
    Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     Item
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return Item
item
  readItem :: StateT
  (Producer ValidLine (Either ParseError) ())
  (Either ParseError)
  (Item, Int)
readItem = do
    Maybe ValidLine
ml <- StateT
  (Producer ValidLine (Either ParseError) ())
  (Either ParseError)
  (Maybe ValidLine)
Parser ValidLine (Either ParseError) (Maybe ValidLine)
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
PP.peek
    case Maybe ValidLine
ml of
      Maybe ValidLine
Nothing -> Either ParseError (Item, Int)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Item, Int)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Item, Int)
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Item, Int))
-> Either ParseError (Item, Int)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Item, Int)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Item, Int)
forall a b. a -> Either a b
Left ParseError
ParseError'Empty
      Just ValidLine
l -> case ValidLine
l of
        ValidLine'StringItem Int
i Text
_ts -> do
          Text
ts <- Int
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     Text
forall {x}.
Int
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
readString Int
i
          (Item, Int)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Item, Int)
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Item
forall a. (ToItem a, ToItemError a ~ X) => a -> Item
toItemWithoutError Text
ts, Int
i)
        ValidLine'ListItem Int
i Text
_ts -> do
          Vector Item
vs <- Int
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
readList Int
i
          (Item, Int)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Item, Int)
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Item -> Item
Item'List Vector Item
vs, Int
i)
        ValidLine'DictItem Int
i Text
_kts Maybe Text
_mvts -> do
          Map Key Item
dic <- Int
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
readDict Int
i
          (Item, Int)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Item, Int)
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Key Item -> Item
Item'Dictionary Map Key Item
dic, Int
i)
        ValidLine'KeyItem Int
i Text
_ts -> do
          Map Key Item
dic <- Int
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
readDict Int
i
          (Item, Int)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Item, Int)
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Key Item -> Item
Item'Dictionary Map Key Item
dic, Int
i)
        ValidLine'InlineList Int
i Text
ts -> do
          Maybe ValidLine
_ <- StateT
  (Producer ValidLine (Either ParseError) ())
  (Either ParseError)
  (Maybe ValidLine)
Parser ValidLine (Either ParseError) (Maybe ValidLine)
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
PP.draw
          Vector Item
vs <- Text
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
parseInlineList Text
ts
          (Item, Int)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Item, Int)
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Item -> Item
Item'List Vector Item
vs, Int
i)
        ValidLine'InlineDict Int
i Text
ts -> do
          Maybe ValidLine
_ <- StateT
  (Producer ValidLine (Either ParseError) ())
  (Either ParseError)
  (Maybe ValidLine)
Parser ValidLine (Either ParseError) (Maybe ValidLine)
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
PP.draw
          Map Key Item
dic <- Text
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
parseInlineDict Text
ts
          (Item, Int)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Item, Int)
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Key Item -> Item
Item'Dictionary Map Key Item
dic, Int
i)
  readString :: Int
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
readString Int
i = [Text]
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
forall {x}.
[Text]
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
go []
   where
    go :: [Text]
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
go [Text]
ys = do
      Maybe ValidLine
ml <- StateT
  (Producer ValidLine (Either ParseError) x)
  (Either ParseError)
  (Maybe ValidLine)
Parser ValidLine (Either ParseError) (Maybe ValidLine)
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
PP.draw
      case Maybe ValidLine
ml of
        Maybe ValidLine
Nothing -> Text
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
 -> StateT
      (Producer ValidLine (Either ParseError) x)
      (Either ParseError)
      Text)
-> Text
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
osNewline ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
ys
        Just ValidLine
x -> case Int
i Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ValidLine -> Int
validLine'Indent ValidLine
x of
          Ordering
EQ -> case ValidLine
x of
            ValidLine'StringItem Int
_ Text
ts -> [Text]
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
go ([Text]
 -> StateT
      (Producer ValidLine (Either ParseError) x)
      (Either ParseError)
      Text)
-> [Text]
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
forall a b. (a -> b) -> a -> b
$ Text
ts Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ys
            ValidLine
_ -> Either ParseError Text
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError Text
 -> StateT
      (Producer ValidLine (Either ParseError) x)
      (Either ParseError)
      Text)
-> Either ParseError Text
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError Text
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidLine
          Ordering
LT -> Either ParseError Text
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError Text
 -> StateT
      (Producer ValidLine (Either ParseError) x)
      (Either ParseError)
      Text)
-> Either ParseError Text
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError Text
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidIndent
          Ordering
GT -> do
            ValidLine -> Parser ValidLine (Either ParseError) ()
forall (m :: * -> *) a. Monad m => a -> Parser a m ()
PP.unDraw ValidLine
x
            Text
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
 -> StateT
      (Producer ValidLine (Either ParseError) x)
      (Either ParseError)
      Text)
-> Text
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
osNewline ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
ys
  readList :: Int
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
readList Int
i = [Item]
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
go []
   where
    go :: [Item]
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
go [Item]
ys = do
      Maybe ValidLine
ml <- StateT
  (Producer ValidLine (Either ParseError) ())
  (Either ParseError)
  (Maybe ValidLine)
Parser ValidLine (Either ParseError) (Maybe ValidLine)
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
PP.draw
      case Maybe ValidLine
ml of
        Maybe ValidLine
Nothing -> Vector Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Item
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Vector Item))
-> Vector Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ [Item] -> Vector Item
forall a. [a] -> Vector a
V.fromList ([Item] -> Vector Item) -> [Item] -> Vector Item
forall a b. (a -> b) -> a -> b
$ [Item] -> [Item]
forall a. [a] -> [a]
reverse [Item]
ys
        Just ValidLine
x -> case Int
i Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ValidLine -> Int
validLine'Indent ValidLine
x of
          Ordering
EQ -> case ValidLine
x of
            ValidLine'ListItem Int
_ Text
ts -> do
              let yys :: [Item]
yys = Text -> Item
forall a. (ToItem a, ToItemError a ~ X) => a -> Item
toItemWithoutError Text
ts Item -> [Item] -> [Item]
forall a. a -> [a] -> [a]
: [Item]
ys
              Maybe ValidLine
ml2 <- StateT
  (Producer ValidLine (Either ParseError) ())
  (Either ParseError)
  (Maybe ValidLine)
Parser ValidLine (Either ParseError) (Maybe ValidLine)
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
PP.peek
              case Maybe ValidLine
ml2 of
                Maybe ValidLine
Nothing -> [Item]
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
go [Item]
yys
                Just ValidLine
x2 -> case Int
i Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ValidLine -> Int
validLine'Indent ValidLine
x2 of
                  Ordering
EQ -> [Item]
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
go [Item]
yys
                  Ordering
LT -> if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
ts then [Item]
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
go [Item]
yys else do
                    Item
item <- [Ordering]
-> Int
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     Item
readItemIndent [Ordering
LT] Int
i
                    [Item]
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
go ([Item]
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Vector Item))
-> [Item]
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ Item
item Item -> [Item] -> [Item]
forall a. a -> [a] -> [a]
: [Item]
ys
                  Ordering
GT -> Vector Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Item
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Vector Item))
-> Vector Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ [Item] -> Vector Item
forall a. [a] -> Vector a
V.fromList ([Item] -> Vector Item) -> [Item] -> Vector Item
forall a b. (a -> b) -> a -> b
$ [Item] -> [Item]
forall a. [a] -> [a]
reverse [Item]
yys
            ValidLine
_ -> Either ParseError (Vector Item)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Vector Item)
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Vector Item))
-> Either ParseError (Vector Item)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Vector Item)
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidLine
          Ordering
LT -> Either ParseError (Vector Item)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Vector Item)
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Vector Item))
-> Either ParseError (Vector Item)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Vector Item)
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidIndent
          Ordering
GT -> do
            ValidLine -> Parser ValidLine (Either ParseError) ()
forall (m :: * -> *) a. Monad m => a -> Parser a m ()
PP.unDraw ValidLine
x
            Vector Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Item
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Vector Item))
-> Vector Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ [Item] -> Vector Item
forall a. [a] -> Vector a
V.fromList ([Item] -> Vector Item) -> [Item] -> Vector Item
forall a b. (a -> b) -> a -> b
$ [Item] -> [Item]
forall a. [a] -> [a]
reverse [Item]
ys
  readDict :: Int
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
readDict Int
i = Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
go Map Key Item
forall k a. Map k a
M.empty
   where
    go :: Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
go Map Key Item
m0 = do
      Maybe ValidLine
ml <- StateT
  (Producer ValidLine (Either ParseError) ())
  (Either ParseError)
  (Maybe ValidLine)
Parser ValidLine (Either ParseError) (Maybe ValidLine)
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
PP.draw
      case Maybe ValidLine
ml of
        Maybe ValidLine
Nothing -> Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Key Item
m0
        Just ValidLine
x -> case Int
i Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ValidLine -> Int
validLine'Indent ValidLine
x of
          Ordering
EQ -> case ValidLine
x of
            ValidLine'DictItem Int
_ Text
k0 Maybe Text
mv ->
              let k :: Key
k = Text -> Key
forall a. (ToKey a, ToKeyError a ~ X) => a -> Key
toKeyWithoutError Text
k0 in case Maybe Text
mv of
                Just Text
v -> do
                  Bool
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key -> Map Key Item -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Key
k Map Key Item
m0) (StateT
   (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
ParseError'DuplicateKey
                  Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
go (Map Key Item
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Map Key Item))
-> Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ Key -> Item -> Map Key Item -> Map Key Item
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
k (Text -> Item
forall a. (ToItem a, ToItemError a ~ X) => a -> Item
toItemWithoutError Text
v) Map Key Item
m0
                Maybe Text
Nothing -> do
                  Maybe ValidLine
ml2 <- StateT
  (Producer ValidLine (Either ParseError) ())
  (Either ParseError)
  (Maybe ValidLine)
Parser ValidLine (Either ParseError) (Maybe ValidLine)
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
PP.peek
                  case Maybe ValidLine
ml2 of
                    Maybe ValidLine
Nothing -> do
                      Bool
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key -> Map Key Item -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Key
k Map Key Item
m0) (StateT
   (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
ParseError'DuplicateKey
                      Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
go (Map Key Item
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Map Key Item))
-> Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ Key -> Item -> Map Key Item -> Map Key Item
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
k (Text -> Item
forall a. (ToItem a, ToItemError a ~ X) => a -> Item
toItemWithoutError Text
T.empty) Map Key Item
m0
                    Just ValidLine
x2 -> case Int
i Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ValidLine -> Int
validLine'Indent ValidLine
x2 of
                      Ordering
EQ -> do
                        Bool
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key -> Map Key Item -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Key
k Map Key Item
m0) (StateT
   (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
ParseError'DuplicateKey
                        Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
go (Map Key Item
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Map Key Item))
-> Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ Key -> Item -> Map Key Item -> Map Key Item
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
k (Text -> Item
forall a. (ToItem a, ToItemError a ~ X) => a -> Item
toItemWithoutError Text
T.empty) Map Key Item
m0
                      Ordering
LT -> do
                        Item
vi <- [Ordering]
-> Int
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     Item
readItemIndent [Ordering
LT] Int
i
                        Bool
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key -> Map Key Item -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Key
k Map Key Item
m0) (StateT
   (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
ParseError'DuplicateKey
                        Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
go (Map Key Item
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Map Key Item))
-> Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ Key -> Item -> Map Key Item -> Map Key Item
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
k Item
vi Map Key Item
m0
                      Ordering
GT -> do
                        Bool
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key -> Map Key Item -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Key
k Map Key Item
m0) (StateT
   (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
ParseError'DuplicateKey
                        Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Key Item
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Map Key Item))
-> Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ Key -> Item -> Map Key Item -> Map Key Item
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
k (Text -> Item
forall a. (ToItem a, ToItemError a ~ X) => a -> Item
toItemWithoutError Text
T.empty) Map Key Item
m0
            ValidLine'KeyItem Int
_ Text
_ts -> do
              ValidLine -> Parser ValidLine (Either ParseError) ()
forall (m :: * -> *) a. Monad m => a -> Parser a m ()
PP.unDraw ValidLine
x
              Key
k <- Int
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) Key
forall {x}.
Int
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Key
readKey Int
i
              Item
vi <- [Ordering]
-> Int
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     Item
readItemIndent [Ordering
LT] Int
i
              Bool
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key -> Map Key Item -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Key
k Map Key Item
m0) (StateT
   (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError ()
 -> StateT
      (Producer ValidLine (Either ParseError) ()) (Either ParseError) ())
-> Either ParseError ()
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
ParseError'DuplicateKey
              Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
go (Map Key Item
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Map Key Item))
-> Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ Key -> Item -> Map Key Item -> Map Key Item
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
k Item
vi Map Key Item
m0
            ValidLine
_ -> Either ParseError (Map Key Item)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Map Key Item)
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Map Key Item))
-> Either ParseError (Map Key Item)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Map Key Item)
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidLine
          Ordering
LT -> Either ParseError (Map Key Item)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Map Key Item)
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Map Key Item))
-> Either ParseError (Map Key Item)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Map Key Item)
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidIndent
          Ordering
GT -> do
            ValidLine -> Parser ValidLine (Either ParseError) ()
forall (m :: * -> *) a. Monad m => a -> Parser a m ()
PP.unDraw ValidLine
x
            Map Key Item
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) ()) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Key Item
m0
  readKey :: Int
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Key
readKey Int
i = [Text]
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Key
forall {x}.
[Text]
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Key
go []
   where
    go :: [Text]
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Key
go [Text]
ys = do
      Maybe ValidLine
ml <- StateT
  (Producer ValidLine (Either ParseError) x)
  (Either ParseError)
  (Maybe ValidLine)
Parser ValidLine (Either ParseError) (Maybe ValidLine)
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
PP.draw
      case Maybe ValidLine
ml of
        Maybe ValidLine
Nothing -> Key
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Key
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return
          (Key
 -> StateT
      (Producer ValidLine (Either ParseError) x) (Either ParseError) Key)
-> Key
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Key
forall a b. (a -> b) -> a -> b
$ Text -> Key
forall a. (ToKey a, ToKeyError a ~ X) => a -> Key
toKeyWithoutError (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
osNewline ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
ys
        Just ValidLine
x -> case Int
i Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ValidLine -> Int
validLine'Indent ValidLine
x of
          Ordering
EQ -> case ValidLine
x of
            ValidLine'KeyItem Int
_ Text
ts -> [Text]
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Key
go ([Text]
 -> StateT
      (Producer ValidLine (Either ParseError) x) (Either ParseError) Key)
-> [Text]
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Key
forall a b. (a -> b) -> a -> b
$ Text
ts Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ys
            ValidLine
_ -> Either ParseError Key
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Key
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError Key
 -> StateT
      (Producer ValidLine (Either ParseError) x) (Either ParseError) Key)
-> Either ParseError Key
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Key
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError Key
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidLine
          Ordering
_ -> do
            ValidLine -> Parser ValidLine (Either ParseError) ()
forall (m :: * -> *) a. Monad m => a -> Parser a m ()
PP.unDraw ValidLine
x
            Key
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Key
forall a.
a
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Key
 -> StateT
      (Producer ValidLine (Either ParseError) x) (Either ParseError) Key)
-> Key
-> StateT
     (Producer ValidLine (Either ParseError) x) (Either ParseError) Key
forall a b. (a -> b) -> a -> b
$ Text -> Key
forall a. (ToKey a, ToKeyError a ~ X) => a -> Key
toKeyWithoutError (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
osNewline ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
ys

  parseInlineList :: Text
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
parseInlineList = Either ParseError (Vector Item)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Vector Item)
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Vector Item))
-> (Text -> Either ParseError (Vector Item))
-> Text
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Vector Item)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT
  (Producer Char (Either ParseError) ())
  (Either ParseError)
  (Vector Item)
-> Producer Char (Either ParseError) ()
-> Either ParseError (Vector Item)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
StateT.evalStateT StateT
  (Producer Char (Either ParseError) ())
  (Either ParseError)
  (Vector Item)
forall {x}.
StateT
  (Producer Char (Either ParseError) x)
  (Either ParseError)
  (Vector Item)
go (Producer Char (Either ParseError) ()
 -> Either ParseError (Vector Item))
-> (Text -> Producer Char (Either ParseError) ())
-> Text
-> Either ParseError (Vector Item)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Producer Char (Either ParseError) ())
-> String -> Producer Char (Either ParseError) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> Producer Char (Either ParseError) ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
P.yield (String -> Producer Char (Either ParseError) ())
-> (Text -> String) -> Text -> Producer Char (Either ParseError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
   where
    go :: StateT
  (Producer Char (Either ParseError) x)
  (Either ParseError)
  (Vector Item)
go = do
      Vector Item
vs <- StateT
  (Producer Char (Either ParseError) x)
  (Either ParseError)
  (Vector Item)
forall {x}.
StateT
  (Producer Char (Either ParseError) x)
  (Either ParseError)
  (Vector Item)
readInlineList0
      StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
forall {x}.
StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
readInlineSpace
      Bool
b <- StateT
  (Producer Char (Either ParseError) x) (Either ParseError) Bool
Parser Char (Either ParseError) Bool
forall (m :: * -> *) a. Monad m => Parser a m Bool
PP.isEndOfInput
      Bool
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
b) (StateT
   (Producer Char (Either ParseError) x) (Either ParseError) ()
 -> StateT
      (Producer Char (Either ParseError) x) (Either ParseError) ())
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ Either ParseError ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer Char (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError ()
 -> StateT
      (Producer Char (Either ParseError) x) (Either ParseError) ())
-> Either ParseError ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
ParseError'RemainingInlineContent
      Vector Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a.
a
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Item
vs
  parseInlineDict :: Text
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
parseInlineDict = Either ParseError (Map Key Item)
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer ValidLine (Either ParseError) ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Map Key Item)
 -> StateT
      (Producer ValidLine (Either ParseError) ())
      (Either ParseError)
      (Map Key Item))
-> (Text -> Either ParseError (Map Key Item))
-> Text
-> StateT
     (Producer ValidLine (Either ParseError) ())
     (Either ParseError)
     (Map Key Item)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT
  (Producer Char (Either ParseError) ())
  (Either ParseError)
  (Map Key Item)
-> Producer Char (Either ParseError) ()
-> Either ParseError (Map Key Item)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
StateT.evalStateT StateT
  (Producer Char (Either ParseError) ())
  (Either ParseError)
  (Map Key Item)
forall {x}.
StateT
  (Producer Char (Either ParseError) x)
  (Either ParseError)
  (Map Key Item)
go (Producer Char (Either ParseError) ()
 -> Either ParseError (Map Key Item))
-> (Text -> Producer Char (Either ParseError) ())
-> Text
-> Either ParseError (Map Key Item)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Producer Char (Either ParseError) ())
-> String -> Producer Char (Either ParseError) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> Producer Char (Either ParseError) ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
P.yield (String -> Producer Char (Either ParseError) ())
-> (Text -> String) -> Text -> Producer Char (Either ParseError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
   where
    go :: StateT
  (Producer Char (Either ParseError) x)
  (Either ParseError)
  (Map Key Item)
go = do
      Map Key Item
dic <- StateT
  (Producer Char (Either ParseError) x)
  (Either ParseError)
  (Map Key Item)
forall {x}.
StateT
  (Producer Char (Either ParseError) x)
  (Either ParseError)
  (Map Key Item)
readInlineDict0
      StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
forall {x}.
StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
readInlineSpace
      Bool
b <- StateT
  (Producer Char (Either ParseError) x) (Either ParseError) Bool
Parser Char (Either ParseError) Bool
forall (m :: * -> *) a. Monad m => Parser a m Bool
PP.isEndOfInput
      Bool
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
b) (StateT
   (Producer Char (Either ParseError) x) (Either ParseError) ()
 -> StateT
      (Producer Char (Either ParseError) x) (Either ParseError) ())
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ Either ParseError ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer Char (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError ()
 -> StateT
      (Producer Char (Either ParseError) x) (Either ParseError) ())
-> Either ParseError ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
ParseError'RemainingInlineContent
      Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall a.
a
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Key Item
dic
  readInlineChar :: a
-> StateT (Producer a (Either ParseError) x) (Either ParseError) ()
readInlineChar a
x = do
    Maybe a
mc <- StateT
  (Producer a (Either ParseError) x) (Either ParseError) (Maybe a)
Parser a (Either ParseError) (Maybe a)
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
PP.draw
    case Maybe a
mc of
      Maybe a
Nothing -> Either ParseError ()
-> StateT (Producer a (Either ParseError) x) (Either ParseError) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer a (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError ()
 -> StateT
      (Producer a (Either ParseError) x) (Either ParseError) ())
-> Either ParseError ()
-> StateT (Producer a (Either ParseError) x) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidEndOfLine
      Just a
c | a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x -> ()
-> StateT (Producer a (Either ParseError) x) (Either ParseError) ()
forall a.
a
-> StateT (Producer a (Either ParseError) x) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just a
_ -> Either ParseError ()
-> StateT (Producer a (Either ParseError) x) (Either ParseError) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer a (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError ()
 -> StateT
      (Producer a (Either ParseError) x) (Either ParseError) ())
-> Either ParseError ()
-> StateT (Producer a (Either ParseError) x) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidChar
  readInlineSpace :: StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
readInlineSpace = do
    Maybe Char
mc <- StateT
  (Producer Char (Either ParseError) x)
  (Either ParseError)
  (Maybe Char)
Parser Char (Either ParseError) (Maybe Char)
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
PP.draw
    case Maybe Char
mc of
      Maybe Char
Nothing -> ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall a.
a
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just Char
c | Char -> Bool
isTabOrSpace Char
c -> StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
readInlineSpace
      Just Char
c -> do
        Char
-> forall {x}.
   StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
forall (m :: * -> *) a. Monad m => a -> Parser a m ()
PP.unDraw Char
c
        ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall a.
a
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  readInlineString :: Set Char -> StateT (Producer Char m x) m Text
readInlineString Set Char
scs = String -> StateT (Producer Char m x) m Text
forall {m :: * -> *} {x}.
Monad m =>
String -> StateT (Producer Char m x) m Text
go []
   where
    go :: String -> StateT (Producer Char m x) m Text
go String
ys = do
      Maybe Char
mc <- StateT (Producer Char m x) m (Maybe Char)
Parser Char m (Maybe Char)
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
PP.draw
      case Maybe Char
mc of
        Maybe Char
Nothing -> Text -> StateT (Producer Char m x) m Text
forall a. a -> StateT (Producer Char m x) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> StateT (Producer Char m x) m Text)
-> Text -> StateT (Producer Char m x) m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
removeEnclosingSpace (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
ys
        Just Char
c -> if Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
S.notMember Char
c Set Char
scs then String -> StateT (Producer Char m x) m Text
go (String -> StateT (Producer Char m x) m Text)
-> String -> StateT (Producer Char m x) m Text
forall a b. (a -> b) -> a -> b
$ Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
ys else do
          Char -> Parser Char m ()
forall (m :: * -> *) a. Monad m => a -> Parser a m ()
PP.unDraw Char
c
          Text -> StateT (Producer Char m x) m Text
forall a. a -> StateT (Producer Char m x) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> StateT (Producer Char m x) m Text)
-> Text -> StateT (Producer Char m x) m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
removeEnclosingSpace (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
ys
  readInlineList0 :: StateT
  (Producer Char (Either ParseError) x)
  (Either ParseError)
  (Vector Item)
readInlineList0 = do
    StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
forall {x}.
StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
readInlineSpace
    Char
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall {a} {x}.
Eq a =>
a
-> StateT (Producer a (Either ParseError) x) (Either ParseError) ()
readInlineChar Char
'['
    WaitingCharList
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall {x}.
WaitingCharList
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
readInlineList1 WaitingCharList
WaitingCharList'ValueOrEnd []
  readInlineList1 :: WaitingCharList
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
readInlineList1 WaitingCharList
wcl [Item]
ys = do
    StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
forall {x}.
StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
readInlineSpace
    Maybe Char
mc <- StateT
  (Producer Char (Either ParseError) x)
  (Either ParseError)
  (Maybe Char)
Parser Char (Either ParseError) (Maybe Char)
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
PP.draw
    case Maybe Char
mc of
      Maybe Char
Nothing -> Either ParseError (Vector Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer Char (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Vector Item)
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Vector Item))
-> Either ParseError (Vector Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Vector Item)
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidEndOfLine
      Just Char
c -> case WaitingCharList
wcl of
        WaitingCharList
WaitingCharList'ValueOrEnd -> case Char
c of
          Char
']' -> Vector Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a.
a
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Item
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Vector Item))
-> Vector Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ [Item] -> Vector Item
forall a. [a] -> Vector a
V.fromList ([Item] -> Vector Item) -> [Item] -> Vector Item
forall a b. (a -> b) -> a -> b
$ [Item] -> [Item]
forall a. [a] -> [a]
reverse [Item]
ys
          Char
'[' -> do
            Item
item <- Vector Item -> Item
Item'List (Vector Item -> Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WaitingCharList
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
readInlineList1 WaitingCharList
WaitingCharList'ValueOrEnd []
            WaitingCharList
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
readInlineList1 WaitingCharList
WaitingCharList'CommaOrEnd ([Item]
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Vector Item))
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ Item
item Item -> [Item] -> [Item]
forall a. a -> [a] -> [a]
: [Item]
ys
          Char
'{' -> do
            Item
item <- Map Key Item -> Item
Item'Dictionary
              (Map Key Item -> Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WaitingCharDict
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
readInlineDict1 WaitingCharDict
WaitingCharDict'KeyOrEnd Map Key Item
forall k a. Map k a
M.empty
            WaitingCharList
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
readInlineList1 WaitingCharList
WaitingCharList'CommaOrEnd ([Item]
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Vector Item))
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ Item
item Item -> [Item] -> [Item]
forall a. a -> [a] -> [a]
: [Item]
ys
          Char
_ | Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Char
c Set Char
specialCharsList ->
            Either ParseError (Vector Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer Char (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Vector Item)
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Vector Item))
-> Either ParseError (Vector Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Vector Item)
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidChar
          Char
_ -> do
            Char
-> forall {x}.
   StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
forall (m :: * -> *) a. Monad m => a -> Parser a m ()
PP.unDraw Char
c
            Item
item <- Text -> Item
forall a. (ToItem a, ToItemError a ~ X) => a -> Item
toItemWithoutError (Text -> Item)
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Text
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Char
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Text
forall {m :: * -> *} {x}.
Monad m =>
Set Char -> StateT (Producer Char m x) m Text
readInlineString Set Char
specialCharsList
            WaitingCharList
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
readInlineList1 WaitingCharList
WaitingCharList'CommaOrEnd ([Item]
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Vector Item))
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ Item
item Item -> [Item] -> [Item]
forall a. a -> [a] -> [a]
: [Item]
ys
        WaitingCharList
WaitingCharList'Value -> case Char
c of
          Char
'[' -> do
            Item
item <- Vector Item -> Item
Item'List (Vector Item -> Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WaitingCharList
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
readInlineList1 WaitingCharList
WaitingCharList'ValueOrEnd []
            WaitingCharList
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
readInlineList1 WaitingCharList
WaitingCharList'CommaOrEnd ([Item]
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Vector Item))
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ Item
item Item -> [Item] -> [Item]
forall a. a -> [a] -> [a]
: [Item]
ys
          Char
'{' -> do
            Item
item <- Map Key Item -> Item
Item'Dictionary
              (Map Key Item -> Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WaitingCharDict
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
readInlineDict1 WaitingCharDict
WaitingCharDict'KeyOrEnd Map Key Item
forall k a. Map k a
M.empty
            WaitingCharList
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
readInlineList1 WaitingCharList
WaitingCharList'CommaOrEnd ([Item]
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Vector Item))
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ Item
item Item -> [Item] -> [Item]
forall a. a -> [a] -> [a]
: [Item]
ys
          Char
_ | Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Char
c Set Char
specialCharsList ->
            Either ParseError (Vector Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer Char (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Vector Item)
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Vector Item))
-> Either ParseError (Vector Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Vector Item)
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidChar
          Char
_ -> do
            Char
-> forall {x}.
   StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
forall (m :: * -> *) a. Monad m => a -> Parser a m ()
PP.unDraw Char
c
            Item
item <- Text -> Item
forall a. (ToItem a, ToItemError a ~ X) => a -> Item
toItemWithoutError (Text -> Item)
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Text
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Char
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Text
forall {m :: * -> *} {x}.
Monad m =>
Set Char -> StateT (Producer Char m x) m Text
readInlineString Set Char
specialCharsList
            WaitingCharList
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
readInlineList1 WaitingCharList
WaitingCharList'CommaOrEnd ([Item]
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Vector Item))
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ Item
item Item -> [Item] -> [Item]
forall a. a -> [a] -> [a]
: [Item]
ys
        WaitingCharList
WaitingCharList'CommaOrEnd -> case Char
c of
          Char
',' -> WaitingCharList
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
readInlineList1 WaitingCharList
WaitingCharList'Value [Item]
ys
          Char
']' -> Vector Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a.
a
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Item
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Vector Item))
-> Vector Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ [Item] -> Vector Item
forall a. [a] -> Vector a
V.fromList ([Item] -> Vector Item) -> [Item] -> Vector Item
forall a b. (a -> b) -> a -> b
$ [Item] -> [Item]
forall a. [a] -> [a]
reverse [Item]
ys
          Char
_ -> Either ParseError (Vector Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer Char (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Vector Item)
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Vector Item))
-> Either ParseError (Vector Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Vector Item)
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidChar
  readInlineDict0 :: StateT
  (Producer Char (Either ParseError) x)
  (Either ParseError)
  (Map Key Item)
readInlineDict0 = do
    StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
forall {x}.
StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
readInlineSpace
    Char
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall {a} {x}.
Eq a =>
a
-> StateT (Producer a (Either ParseError) x) (Either ParseError) ()
readInlineChar Char
'{'
    WaitingCharDict
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall {x}.
WaitingCharDict
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
readInlineDict1 WaitingCharDict
WaitingCharDict'KeyOrEnd Map Key Item
forall k a. Map k a
M.empty
  readInlineDict1 :: WaitingCharDict
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
readInlineDict1 WaitingCharDict
wcd Map Key Item
m0 = do
    StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
forall {x}.
StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
readInlineSpace
    Maybe Char
mc <- StateT
  (Producer Char (Either ParseError) x)
  (Either ParseError)
  (Maybe Char)
Parser Char (Either ParseError) (Maybe Char)
forall (m :: * -> *) a. Monad m => Parser a m (Maybe a)
PP.draw
    case Maybe Char
mc of
      Maybe Char
Nothing -> Either ParseError (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer Char (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Map Key Item)
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Map Key Item))
-> Either ParseError (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Map Key Item)
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidEndOfLine
      Just Char
c -> case WaitingCharDict
wcd of
        WaitingCharDict
WaitingCharDict'KeyOrEnd -> case Char
c of
          Char
'}' -> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall a.
a
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Key Item
m0
          Char
_ | Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Char
c Set Char
specialCharsDict ->
            Either ParseError (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer Char (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Map Key Item)
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Map Key Item))
-> Either ParseError (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Map Key Item)
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidChar
          Char
_ -> do
            Char
-> forall {x}.
   StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
forall (m :: * -> *) a. Monad m => a -> Parser a m ()
PP.unDraw Char
c
            Key
key <- Text -> Key
forall a. (ToKey a, ToKeyError a ~ X) => a -> Key
toKeyWithoutError (Text -> Key)
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Text
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Char
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Text
forall {m :: * -> *} {x}.
Monad m =>
Set Char -> StateT (Producer Char m x) m Text
readInlineString Set Char
specialCharsDict
            Bool
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key -> Map Key Item -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Key
key Map Key Item
m0) (StateT
   (Producer Char (Either ParseError) x) (Either ParseError) ()
 -> StateT
      (Producer Char (Either ParseError) x) (Either ParseError) ())
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ Either ParseError ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer Char (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError ()
 -> StateT
      (Producer Char (Either ParseError) x) (Either ParseError) ())
-> Either ParseError ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
ParseError'DuplicateKey
            WaitingCharDict
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
readInlineDict1 (Key -> WaitingCharDict
WaitingCharDict'Colon Key
key) Map Key Item
m0
        WaitingCharDict
WaitingCharDict'Key -> case Char
c of
          Char
_ | Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Char
c Set Char
specialCharsDict ->
            Either ParseError (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer Char (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Map Key Item)
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Map Key Item))
-> Either ParseError (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Map Key Item)
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidChar
          Char
_ -> do
            Char
-> forall {x}.
   StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
forall (m :: * -> *) a. Monad m => a -> Parser a m ()
PP.unDraw Char
c
            Key
key <- Text -> Key
forall a. (ToKey a, ToKeyError a ~ X) => a -> Key
toKeyWithoutError (Text -> Key)
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Text
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Char
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Text
forall {m :: * -> *} {x}.
Monad m =>
Set Char -> StateT (Producer Char m x) m Text
readInlineString Set Char
specialCharsDict
            Bool
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key -> Map Key Item -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Key
key Map Key Item
m0) (StateT
   (Producer Char (Either ParseError) x) (Either ParseError) ()
 -> StateT
      (Producer Char (Either ParseError) x) (Either ParseError) ())
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ Either ParseError ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer Char (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError ()
 -> StateT
      (Producer Char (Either ParseError) x) (Either ParseError) ())
-> Either ParseError ()
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
ParseError'DuplicateKey
            WaitingCharDict
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
readInlineDict1 (Key -> WaitingCharDict
WaitingCharDict'Colon Key
key) Map Key Item
m0
        WaitingCharDict'Colon Key
k -> case Char
c of
          Char
':' -> WaitingCharDict
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
readInlineDict1 (Key -> WaitingCharDict
WaitingCharDict'Value Key
k) Map Key Item
m0
          Char
_ -> Either ParseError (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer Char (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Map Key Item)
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Map Key Item))
-> Either ParseError (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Map Key Item)
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidChar
        WaitingCharDict'Value Key
k -> case Char
c of
          Char
'[' -> do
            Item
vi <- Vector Item -> Item
Item'List (Vector Item -> Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WaitingCharList
-> [Item]
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Vector Item)
readInlineList1 WaitingCharList
WaitingCharList'ValueOrEnd []
            WaitingCharDict
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
readInlineDict1 WaitingCharDict
WaitingCharDict'CommaOrEnd (Map Key Item
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Map Key Item))
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ Key -> Item -> Map Key Item -> Map Key Item
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
k Item
vi Map Key Item
m0
          Char
'{' -> do
            Item
vi <- Map Key Item -> Item
Item'Dictionary
              (Map Key Item -> Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WaitingCharDict
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
readInlineDict1 WaitingCharDict
WaitingCharDict'KeyOrEnd Map Key Item
forall k a. Map k a
M.empty
            WaitingCharDict
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
readInlineDict1 WaitingCharDict
WaitingCharDict'CommaOrEnd (Map Key Item
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Map Key Item))
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ Key -> Item -> Map Key Item -> Map Key Item
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
k Item
vi Map Key Item
m0
          Char
_ | Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Char
c Set Char
specialCharsDict ->
            Either ParseError (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer Char (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Map Key Item)
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Map Key Item))
-> Either ParseError (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Map Key Item)
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidChar
          Char
_ -> do
            Char
-> forall {x}.
   StateT (Producer Char (Either ParseError) x) (Either ParseError) ()
forall (m :: * -> *) a. Monad m => a -> Parser a m ()
PP.unDraw Char
c
            Item
vi <- Text -> Item
forall a. (ToItem a, ToItemError a ~ X) => a -> Item
toItemWithoutError (Text -> Item)
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Text
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Char
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) Text
forall {m :: * -> *} {x}.
Monad m =>
Set Char -> StateT (Producer Char m x) m Text
readInlineString Set Char
specialCharsDict
            WaitingCharDict
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
readInlineDict1 WaitingCharDict
WaitingCharDict'CommaOrEnd (Map Key Item
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Map Key Item))
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ Key -> Item -> Map Key Item -> Map Key Item
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Key
k Item
vi Map Key Item
m0
        WaitingCharDict
WaitingCharDict'CommaOrEnd -> case Char
c of
          Char
',' -> WaitingCharDict
-> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
readInlineDict1 WaitingCharDict
WaitingCharDict'Key Map Key Item
m0
          Char
'}' -> Map Key Item
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall a.
a
-> StateT
     (Producer Char (Either ParseError) x) (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Key Item
m0
          Char
_ -> Either ParseError (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Producer Char (Either ParseError) x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError (Map Key Item)
 -> StateT
      (Producer Char (Either ParseError) x)
      (Either ParseError)
      (Map Key Item))
-> Either ParseError (Map Key Item)
-> StateT
     (Producer Char (Either ParseError) x)
     (Either ParseError)
     (Map Key Item)
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (Map Key Item)
forall a b. a -> Either a b
Left ParseError
ParseError'InvalidChar

parse' :: T.Text -> Either ParseError Item
parse' :: Text -> Either ParseError Item
parse' = Text -> Either ParseError Item
parse (Text -> Either ParseError Item)
-> (Text -> Text) -> Text -> Either ParseError Item
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict

parseDocument :: TL.Text -> Either ParseError Document
parseDocument :: Text -> Either ParseError Document
parseDocument Text
ts = case Text -> Either ParseError Item
parse Text
ts of
  Left ParseError
ParseError'Empty -> Document -> Either ParseError Document
forall a b. b -> Either a b
Right Document
Document'Empty
  Right Item
i -> Document -> Either ParseError Document
forall a b. b -> Either a b
Right (Document -> Either ParseError Document)
-> Document -> Either ParseError Document
forall a b. (a -> b) -> a -> b
$ Item -> Document
Document'Item Item
i
  Left ParseError
err -> ParseError -> Either ParseError Document
forall a b. a -> Either a b
Left ParseError
err