module YamlUnscrambler
  ( -- * Execution
    parseText,
    parseByteString,
    getExpectations,

    -- * DSL

    -- ** Value
    Value,
    value,
    nullableValue,

    -- *** Helpers
    sequenceValue,
    mappingValue,
    scalarsValue,

    -- ** Scalar
    Scalar,
    stringScalar,
    nullScalar,
    boolScalar,
    scientificScalar,
    doubleScalar,
    rationalScalar,
    boundedIntegerScalar,
    unboundedIntegerScalar,
    timestampScalar,
    dayScalar,
    timeScalar,
    uuidScalar,
    binaryScalar,

    -- ** Mapping
    Mapping,
    foldMapping,
    byKeyMapping,

    -- ** Sequence
    Sequence,
    foldSequence,
    byOrderSequence,
    byKeySequence,

    -- ** String
    String,
    textString,
    enumString,
    formattedString,
    attoparsedString,

    -- ** ByKey
    ByKey,
    atByKey,
    atOneOfByKey,

    -- ** ByOrder
    ByOrder,
    fetchByOrder,

    -- * Value types
    MaxInputSize (..),
    Signed (..),
    NumeralSystem (..),
    CaseSensitive (..),
  )
where

import qualified Attoparsec.Time.ByteString as AsciiAtto
import qualified Control.Foldl as Fold
import qualified Data.Attoparsec.ByteString.Char8 as AsciiAtto
import qualified Data.Attoparsec.Text as TextAtto
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Base64 as Base64
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.UUID as UUID
import qualified Data.Vector as Vector
import qualified Data.Vector.Generic as GenericVector
import qualified Data.Yaml.Parser as Yaml
import qualified Text.Libyaml as Libyaml
import qualified YamlUnscrambler.AsciiAtto as AsciiAtto
import qualified YamlUnscrambler.CompactErrRendering as CompactErrRendering
import qualified YamlUnscrambler.Err as Err
import qualified YamlUnscrambler.Expectations as Ex
import YamlUnscrambler.Model
import YamlUnscrambler.Prelude hiding (String)
import qualified YamlUnscrambler.Util.ByteString as ByteString
import qualified YamlUnscrambler.Util.HashMap as HashMap
import qualified YamlUnscrambler.Util.Text as Text
import qualified YamlUnscrambler.Util.Vector as Vector
import qualified YamlUnscrambler.Util.Yaml as Yaml

-- * Execution

parseText :: Value a -> Text -> Either Text a
parseText :: Value a -> Text -> Either Text a
parseText Value a
value =
  Value a -> ByteString -> Either Text a
forall a. Value a -> ByteString -> Either Text a
parseByteString Value a
value (ByteString -> Either Text a)
-> (Text -> ByteString) -> Text -> Either Text a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
Text.encodeUtf8

parseByteString :: Value a -> ByteString -> Either Text a
parseByteString :: Value a -> ByteString -> Either Text a
parseByteString (Value {Value
YamlValue -> AnchorMap -> Either ErrAtPath a
valueParser :: forall a. Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
valueExpectation :: forall a. Value a -> Value
valueParser :: YamlValue -> AnchorMap -> Either ErrAtPath a
valueExpectation :: Value
..}) ByteString
input =
  do
    Yaml.RawDoc YamlValue
value AnchorMap
map <- ByteString -> Either Text RawDoc
Yaml.parseByteStringToRawDoc ByteString
input
    YamlValue -> AnchorMap -> Either ErrAtPath a
valueParser YamlValue
value AnchorMap
map Either ErrAtPath a
-> (Either ErrAtPath a -> Either Text a) -> Either Text a
forall a b. a -> (a -> b) -> b
& (ErrAtPath -> Text) -> Either ErrAtPath a -> Either Text a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ErrAtPath -> Text
CompactErrRendering.renderErrAtPath

-- |
-- Get a tree of expectations, which can then be converted into
-- documentation for people working with the YAML document or
-- into one of the spec formats (e.g., YAML Spec, JSON Spec).
getExpectations :: Value a -> Ex.Value
getExpectations :: Value a -> Value
getExpectations =
  Value a -> Value
forall a. Value a -> Value
valueExpectation

-- *

data Value a = Value
  { Value a -> Value
valueExpectation :: Ex.Value,
    Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
valueParser :: Yaml.YamlValue -> Yaml.AnchorMap -> Either Err.ErrAtPath a
  }
  deriving (a -> Value b -> Value a
(a -> b) -> Value a -> Value b
(forall a b. (a -> b) -> Value a -> Value b)
-> (forall a b. a -> Value b -> Value a) -> Functor Value
forall a b. a -> Value b -> Value a
forall a b. (a -> b) -> Value a -> Value b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Value b -> Value a
$c<$ :: forall a b. a -> Value b -> Value a
fmap :: (a -> b) -> Value a -> Value b
$cfmap :: forall a b. (a -> b) -> Value a -> Value b
Functor)

value :: [Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value :: [Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value [Scalar a]
scalars Maybe (Mapping a)
mappings Maybe (Sequence a)
sequences =
  Value -> (YamlValue -> AnchorMap -> Either ErrAtPath a) -> Value a
forall a.
Value -> (YamlValue -> AnchorMap -> Either ErrAtPath a) -> Value a
Value Value
expectations YamlValue -> AnchorMap -> Either ErrAtPath a
parse
  where
    expectations :: Value
expectations =
      [Scalar] -> Maybe Mapping -> Maybe Sequence -> Value
Ex.Value
        [Scalar]
scalarExpectations
        ((Mapping a -> Mapping) -> Maybe (Mapping a) -> Maybe Mapping
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mapping a -> Mapping
forall a. Mapping a -> Mapping
mappingExpectation Maybe (Mapping a)
mappings)
        ((Sequence a -> Sequence) -> Maybe (Sequence a) -> Maybe Sequence
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sequence a -> Sequence
forall a. Sequence a -> Sequence
sequenceExpectation Maybe (Sequence a)
sequences)
    scalarExpectations :: [Scalar]
scalarExpectations =
      (Scalar a -> Scalar) -> [Scalar a] -> [Scalar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scalar a -> Scalar
forall a. Scalar a -> Scalar
scalarExpectation [Scalar a]
scalars
    parse :: YamlValue -> AnchorMap -> Either ErrAtPath a
parse YamlValue
input AnchorMap
anchorMap =
      case YamlValue
input of
        Yaml.Scalar ByteString
bytes Tag
tag Style
style Anchor
_ ->
          case [Scalar a]
scalars of
            [] ->
              ErrAtPath -> Either ErrAtPath a
forall a b. a -> Either a b
Left ([Text] -> Err -> ErrAtPath
Err.ErrAtPath [] (Value -> Err
Err.UnexpectedScalarErr Value
expectations))
            [Scalar a]
_ ->
              Except (Last Text) a -> Either (Last Text) a
forall e a. Except e a -> Either e a
runExcept ([Except (Last Text) a] -> Except (Last Text) a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((Scalar a -> Except (Last Text) a)
-> [Scalar a] -> [Except (Last Text) a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scalar a -> Except (Last Text) a
parse [Scalar a]
scalars))
                Either (Last Text) a
-> (Either (Last Text) a -> Either ErrAtPath a)
-> Either ErrAtPath a
forall a b. a -> (a -> b) -> b
& (Last Text -> ErrAtPath)
-> Either (Last Text) a -> Either ErrAtPath a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Last Text -> ErrAtPath
convErr
              where
                parse :: Scalar a -> Except (Last Text) a
parse Scalar a
scalar =
                  Either (Last Text) a -> Except (Last Text) a
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either (Last Text) a -> Except (Last Text) a)
-> Either (Last Text) a -> Except (Last Text) a
forall a b. (a -> b) -> a -> b
$ (Text -> Last Text) -> Either Text a -> Either (Last Text) a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Maybe Text -> Last Text
forall a. Maybe a -> Last a
Last (Maybe Text -> Last Text)
-> (Text -> Maybe Text) -> Text -> Last Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Maybe Text
forall a. a -> Maybe a
Just) (Either Text a -> Either (Last Text) a)
-> Either Text a -> Either (Last Text) a
forall a b. (a -> b) -> a -> b
$ Scalar a -> ByteString -> Tag -> Style -> Either Text a
forall a. Scalar a -> ByteString -> Tag -> Style -> Either Text a
scalarParser Scalar a
scalar ByteString
bytes Tag
tag Style
style
                convErr :: Last Text -> ErrAtPath
convErr (Last Maybe Text
msg) =
                  [Text] -> Err -> ErrAtPath
Err.ErrAtPath [] ([Scalar] -> ByteString -> Tag -> Style -> Maybe Text -> Err
Err.ScalarErr [Scalar]
scalarExpectations ByteString
bytes Tag
tag Style
style Maybe Text
msg)
        Yaml.Mapping [(Text, YamlValue)]
input Anchor
_ ->
          case Maybe (Mapping a)
mappings of
            Just Mapping a
mapping ->
              Mapping a -> [(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a
forall a.
Mapping a -> [(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a
mappingParser Mapping a
mapping [(Text, YamlValue)]
input AnchorMap
anchorMap
            Maybe (Mapping a)
Nothing ->
              ErrAtPath -> Either ErrAtPath a
forall a b. a -> Either a b
Left ([Text] -> Err -> ErrAtPath
Err.ErrAtPath [] (Value -> Err
Err.UnexpectedMappingErr Value
expectations))
        Yaml.Sequence [YamlValue]
input Anchor
_ ->
          case Maybe (Sequence a)
sequences of
            Just Sequence a
sequence ->
              Sequence a -> [YamlValue] -> AnchorMap -> Either ErrAtPath a
forall a.
Sequence a -> [YamlValue] -> AnchorMap -> Either ErrAtPath a
sequenceParser Sequence a
sequence [YamlValue]
input AnchorMap
anchorMap
            Maybe (Sequence a)
Nothing ->
              ErrAtPath -> Either ErrAtPath a
forall a b. a -> Either a b
Left ([Text] -> Err -> ErrAtPath
Err.ErrAtPath [] (Value -> Err
Err.UnexpectedSequenceErr Value
expectations))
        Yaml.Alias AnchorName
anchorName ->
          case AnchorName -> AnchorMap -> Maybe YamlValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AnchorName
anchorName AnchorMap
anchorMap of
            Just YamlValue
value ->
              YamlValue -> AnchorMap -> Either ErrAtPath a
parse YamlValue
value AnchorMap
anchorMap
            Maybe YamlValue
Nothing ->
              ErrAtPath -> Either ErrAtPath a
forall a b. a -> Either a b
Left ([Text] -> Err -> ErrAtPath
Err.ErrAtPath [] (Text -> Err
Err.UnknownAnchorErr (AnchorName -> Text
forall a. IsString a => AnchorName -> a
fromString AnchorName
anchorName)))

nullableValue :: [Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value (Maybe a)
nullableValue :: [Scalar a]
-> Maybe (Mapping a) -> Maybe (Sequence a) -> Value (Maybe a)
nullableValue [Scalar a]
scalars Maybe (Mapping a)
mappings Maybe (Sequence a)
sequences =
  [Scalar (Maybe a)]
-> Maybe (Mapping (Maybe a))
-> Maybe (Sequence (Maybe a))
-> Value (Maybe a)
forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value
    ((Maybe a -> Scalar (Maybe a)
forall a. a -> Scalar a
nullScalar Maybe a
forall a. Maybe a
Nothing) Scalar (Maybe a) -> [Scalar (Maybe a)] -> [Scalar (Maybe a)]
forall a. a -> [a] -> [a]
: (Scalar a -> Scalar (Maybe a)) -> [Scalar a] -> [Scalar (Maybe a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Maybe a) -> Scalar a -> Scalar (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just) [Scalar a]
scalars)
    ((Mapping a -> Mapping (Maybe a))
-> Maybe (Mapping a) -> Maybe (Mapping (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Maybe a) -> Mapping a -> Mapping (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just) Maybe (Mapping a)
mappings)
    ((Sequence a -> Sequence (Maybe a))
-> Maybe (Sequence a) -> Maybe (Sequence (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Maybe a) -> Sequence a -> Sequence (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just) Maybe (Sequence a)
sequences)

-- ** Helpers

sequenceValue :: Sequence a -> Value a
sequenceValue :: Sequence a -> Value a
sequenceValue Sequence a
sequence =
  [Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value [] Maybe (Mapping a)
forall a. Maybe a
Nothing (Sequence a -> Maybe (Sequence a)
forall a. a -> Maybe a
Just Sequence a
sequence)

mappingValue :: Mapping a -> Value a
mappingValue :: Mapping a -> Value a
mappingValue Mapping a
mapping =
  [Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value [] (Mapping a -> Maybe (Mapping a)
forall a. a -> Maybe a
Just Mapping a
mapping) Maybe (Sequence a)
forall a. Maybe a
Nothing

scalarsValue :: [Scalar a] -> Value a
scalarsValue :: [Scalar a] -> Value a
scalarsValue [Scalar a]
scalars =
  [Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value [Scalar a]
scalars Maybe (Mapping a)
forall a. Maybe a
Nothing Maybe (Sequence a)
forall a. Maybe a
Nothing

-- *

data Scalar a = Scalar
  { Scalar a -> Scalar
scalarExpectation :: Ex.Scalar,
    Scalar a -> ByteString -> Tag -> Style -> Either Text a
scalarParser :: ByteString -> Libyaml.Tag -> Libyaml.Style -> Either Text a
  }
  deriving (a -> Scalar b -> Scalar a
(a -> b) -> Scalar a -> Scalar b
(forall a b. (a -> b) -> Scalar a -> Scalar b)
-> (forall a b. a -> Scalar b -> Scalar a) -> Functor Scalar
forall a b. a -> Scalar b -> Scalar a
forall a b. (a -> b) -> Scalar a -> Scalar b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Scalar b -> Scalar a
$c<$ :: forall a b. a -> Scalar b -> Scalar a
fmap :: (a -> b) -> Scalar a -> Scalar b
$cfmap :: forall a b. (a -> b) -> Scalar a -> Scalar b
Functor)

bytesParsingScalar :: Ex.Scalar -> (ByteString -> Either Text a) -> Scalar a
bytesParsingScalar :: Scalar -> (ByteString -> Either Text a) -> Scalar a
bytesParsingScalar Scalar
expectation ByteString -> Either Text a
parser =
  Scalar -> (ByteString -> Tag -> Style -> Either Text a) -> Scalar a
forall a.
Scalar -> (ByteString -> Tag -> Style -> Either Text a) -> Scalar a
Scalar Scalar
expectation (\ByteString
bytes Tag
_ Style
_ -> ByteString -> Either Text a
parser ByteString
bytes)

attoparsedScalar :: Ex.Scalar -> AsciiAtto.Parser a -> Scalar a
attoparsedScalar :: Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
expectation Parser a
parser =
  Scalar -> (ByteString -> Either Text a) -> Scalar a
forall a. Scalar -> (ByteString -> Either Text a) -> Scalar a
bytesParsingScalar Scalar
expectation ((ByteString -> Either Text a) -> Scalar a)
-> (ByteString -> Either Text a) -> Scalar a
forall a b. (a -> b) -> a -> b
$
    (AnchorName -> Text) -> Either AnchorName a -> Either Text a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> AnchorName -> Text
forall a b. a -> b -> a
const Text
"") (Either AnchorName a -> Either Text a)
-> (ByteString -> Either AnchorName a)
-> ByteString
-> Either Text a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parser a -> ByteString -> Either AnchorName a
forall a. Parser a -> ByteString -> Either AnchorName a
AsciiAtto.parseOnly (Parser a
parser Parser a -> Parser ByteString () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
AsciiAtto.endOfInput)

sizedScalar :: MaxInputSize -> Scalar a -> Scalar a
sizedScalar :: MaxInputSize -> Scalar a -> Scalar a
sizedScalar (MaxInputSize Int
maxInputSize) (Scalar {Scalar
ByteString -> Tag -> Style -> Either Text a
scalarParser :: ByteString -> Tag -> Style -> Either Text a
scalarExpectation :: Scalar
scalarParser :: forall a. Scalar a -> ByteString -> Tag -> Style -> Either Text a
scalarExpectation :: forall a. Scalar a -> Scalar
..}) =
  Scalar -> (ByteString -> Tag -> Style -> Either Text a) -> Scalar a
forall a.
Scalar -> (ByteString -> Tag -> Style -> Either Text a) -> Scalar a
Scalar Scalar
scalarExpectation ((ByteString -> Tag -> Style -> Either Text a) -> Scalar a)
-> (ByteString -> Tag -> Style -> Either Text a) -> Scalar a
forall a b. (a -> b) -> a -> b
$ \ByteString
bytes Tag
tag Style
style ->
    if ByteString -> Int
ByteString.length ByteString
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxInputSize
      then ByteString -> Tag -> Style -> Either Text a
scalarParser ByteString
bytes Tag
tag Style
style
      else Text -> Either Text a
forall a b. a -> Either a b
Left (Text
"Input is longer then the expected maximum of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showAsText Int
maxInputSize Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" bytes")

stringScalar :: String a -> Scalar a
stringScalar :: String a -> Scalar a
stringScalar (String String
exp Text -> Either Text a
parse) =
  Scalar -> (ByteString -> Either Text a) -> Scalar a
forall a. Scalar -> (ByteString -> Either Text a) -> Scalar a
bytesParsingScalar
    (String -> Scalar
Ex.StringScalar String
exp)
    (\ByteString
bytes -> (UnicodeException -> Text)
-> Either UnicodeException Text -> Either Text Text
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first UnicodeException -> Text
forall a. Show a => a -> Text
showAsText (ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
bytes) Either Text Text -> (Text -> Either Text a) -> Either Text a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Either Text a
parse)

nullScalar :: a -> Scalar a
nullScalar :: a -> Scalar a
nullScalar a
a =
  Scalar -> (ByteString -> Tag -> Style -> Either Text a) -> Scalar a
forall a.
Scalar -> (ByteString -> Tag -> Style -> Either Text a) -> Scalar a
Scalar Scalar
Ex.NullScalar ((ByteString -> Tag -> Style -> Either Text a) -> Scalar a)
-> (ByteString -> Tag -> Style -> Either Text a) -> Scalar a
forall a b. (a -> b) -> a -> b
$ \ByteString
bytes Tag
tag Style
_ ->
    if Tag
tag Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
Libyaml.NullTag
      Bool -> Bool -> Bool
|| ByteString -> Bool
ByteString.null ByteString
bytes
      Bool -> Bool -> Bool
|| ByteString
bytes ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"~"
      Bool -> Bool -> Bool
|| ByteString -> Bool
ByteString.saysNullInCiAscii ByteString
bytes
      then a -> Either Text a
forall a b. b -> Either a b
Right a
a
      else Text -> Either Text a
forall a b. a -> Either a b
Left Text
"Not null"

boolScalar :: Scalar Bool
boolScalar :: Scalar Bool
boolScalar =
  Scalar -> (ByteString -> Either Text Bool) -> Scalar Bool
forall a. Scalar -> (ByteString -> Either Text a) -> Scalar a
bytesParsingScalar Scalar
Ex.BoolScalar ((ByteString -> Either Text Bool) -> Scalar Bool)
-> (ByteString -> Either Text Bool) -> Scalar Bool
forall a b. (a -> b) -> a -> b
$ \ByteString
bytes ->
    if ByteString -> Int
ByteString.length ByteString
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
5
      then
        let lowercased :: ByteString
lowercased =
              ByteString -> ByteString
ByteString.lowercaseInAscii ByteString
bytes
         in if ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ByteString
lowercased [ByteString
"y", ByteString
"yes", ByteString
"on", ByteString
"true", ByteString
"t", ByteString
"1"]
              then Bool -> Either Text Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
              else
                if ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ByteString
lowercased [ByteString
"n", ByteString
"no", ByteString
"off", ByteString
"false", ByteString
"f", ByteString
"0"]
                  then Bool -> Either Text Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                  else Text -> Either Text Bool
forall a b. a -> Either a b
Left Text
"Not a boolean"
      else Text -> Either Text Bool
forall a b. a -> Either a b
Left Text
"Not a boolean"

scientificScalar :: Scalar Scientific
scientificScalar :: Scalar Scientific
scientificScalar =
  Scalar -> Parser Scientific -> Scalar Scientific
forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
Ex.ScientificScalar Parser Scientific
AsciiAtto.scientific

doubleScalar :: Scalar Double
doubleScalar :: Scalar Double
doubleScalar =
  Scalar -> Parser Double -> Scalar Double
forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
Ex.DoubleScalar Parser Double
AsciiAtto.double

rationalScalar :: MaxInputSize -> Scalar Rational
rationalScalar :: MaxInputSize -> Scalar Rational
rationalScalar MaxInputSize
a =
  MaxInputSize -> Scalar Rational -> Scalar Rational
forall a. MaxInputSize -> Scalar a -> Scalar a
sizedScalar MaxInputSize
a (Scalar Rational -> Scalar Rational)
-> Scalar Rational -> Scalar Rational
forall a b. (a -> b) -> a -> b
$
    Scalar -> Parser Rational -> Scalar Rational
forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar (MaxInputSize -> Scalar
Ex.RationalScalar MaxInputSize
a) Parser Rational
forall a. Fractional a => Parser a
AsciiAtto.rational

-- |
-- E.g., 'Int', 'Int64', 'Word', but not 'Integer'.
boundedIntegerScalar :: (Integral a, FiniteBits a) => Signed -> NumeralSystem -> Scalar a
boundedIntegerScalar :: Signed -> NumeralSystem -> Scalar a
boundedIntegerScalar Signed
a NumeralSystem
b =
  Scalar -> Parser a -> Scalar a
forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar (Signed -> NumeralSystem -> Scalar
Ex.BoundedIntegerScalar Signed
a NumeralSystem
b) (Signed -> NumeralSystem -> Parser a
forall a.
(Integral a, Bits a) =>
Signed -> NumeralSystem -> Parser a
AsciiAtto.integralScalar Signed
a NumeralSystem
b)

unboundedIntegerScalar :: MaxInputSize -> Signed -> NumeralSystem -> Scalar Integer
unboundedIntegerScalar :: MaxInputSize -> Signed -> NumeralSystem -> Scalar Integer
unboundedIntegerScalar MaxInputSize
a Signed
b NumeralSystem
c =
  MaxInputSize -> Scalar Integer -> Scalar Integer
forall a. MaxInputSize -> Scalar a -> Scalar a
sizedScalar MaxInputSize
a (Scalar Integer -> Scalar Integer)
-> Scalar Integer -> Scalar Integer
forall a b. (a -> b) -> a -> b
$
    Scalar -> Parser Integer -> Scalar Integer
forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar (MaxInputSize -> Signed -> NumeralSystem -> Scalar
Ex.UnboundedIntegerScalar MaxInputSize
a Signed
b NumeralSystem
c) (Signed -> NumeralSystem -> Parser Integer
forall a.
(Integral a, Bits a) =>
Signed -> NumeralSystem -> Parser a
AsciiAtto.integralScalar Signed
b NumeralSystem
c)

timestampScalar :: Scalar UTCTime
timestampScalar :: Scalar UTCTime
timestampScalar =
  Scalar -> Parser UTCTime -> Scalar UTCTime
forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
Ex.Iso8601TimestampScalar Parser UTCTime
AsciiAtto.utcTimeInISO8601

dayScalar :: Scalar Day
dayScalar :: Scalar Day
dayScalar =
  Scalar -> Parser Day -> Scalar Day
forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
Ex.Iso8601DayScalar Parser Day
AsciiAtto.dayInISO8601

timeScalar :: Scalar TimeOfDay
timeScalar :: Scalar TimeOfDay
timeScalar =
  Scalar -> Parser TimeOfDay -> Scalar TimeOfDay
forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
Ex.Iso8601TimeScalar Parser TimeOfDay
AsciiAtto.timeOfDayInISO8601

uuidScalar :: Scalar UUID
uuidScalar :: Scalar UUID
uuidScalar =
  Scalar -> (ByteString -> Either Text UUID) -> Scalar UUID
forall a. Scalar -> (ByteString -> Either Text a) -> Scalar a
bytesParsingScalar Scalar
Ex.UuidScalar ((ByteString -> Either Text UUID) -> Scalar UUID)
-> (ByteString -> Either Text UUID) -> Scalar UUID
forall a b. (a -> b) -> a -> b
$ \ByteString
bytes ->
    case ByteString -> Maybe UUID
UUID.fromASCIIBytes ByteString
bytes of
      Just UUID
uuid ->
        UUID -> Either Text UUID
forall (m :: * -> *) a. Monad m => a -> m a
return UUID
uuid
      Maybe UUID
Nothing ->
        Text -> Either Text UUID
forall a b. a -> Either a b
Left Text
"Invalid UUID"

binaryScalar :: Scalar ByteString
binaryScalar :: Scalar ByteString
binaryScalar =
  Scalar
-> (ByteString -> Either Text ByteString) -> Scalar ByteString
forall a. Scalar -> (ByteString -> Either Text a) -> Scalar a
bytesParsingScalar Scalar
Ex.Base64BinaryScalar ((ByteString -> Either Text ByteString) -> Scalar ByteString)
-> (ByteString -> Either Text ByteString) -> Scalar ByteString
forall a b. (a -> b) -> a -> b
$ \ByteString
bytes ->
    let bytesWithoutNewlines :: ByteString
bytesWithoutNewlines =
          (Word8 -> Bool) -> ByteString -> ByteString
ByteString.filter (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
10) ByteString
bytes
     in case ByteString -> Either AnchorName ByteString
Base64.decode ByteString
bytesWithoutNewlines of
          Right ByteString
res ->
            ByteString -> Either Text ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
res
          Left AnchorName
err ->
            Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ AnchorName -> Text
forall a. IsString a => AnchorName -> a
fromString AnchorName
err

-- *

data Mapping a = Mapping
  { Mapping a -> Mapping
mappingExpectation :: Ex.Mapping,
    Mapping a -> [(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a
mappingParser :: [(Text, Yaml.YamlValue)] -> Yaml.AnchorMap -> Either Err.ErrAtPath a
  }
  deriving (a -> Mapping b -> Mapping a
(a -> b) -> Mapping a -> Mapping b
(forall a b. (a -> b) -> Mapping a -> Mapping b)
-> (forall a b. a -> Mapping b -> Mapping a) -> Functor Mapping
forall a b. a -> Mapping b -> Mapping a
forall a b. (a -> b) -> Mapping a -> Mapping b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Mapping b -> Mapping a
$c<$ :: forall a b. a -> Mapping b -> Mapping a
fmap :: (a -> b) -> Mapping a -> Mapping b
$cfmap :: forall a b. (a -> b) -> Mapping a -> Mapping b
Functor)

foldMapping :: (key -> val -> assoc) -> Fold assoc a -> String key -> Value val -> Mapping a
foldMapping :: (key -> val -> assoc)
-> Fold assoc a -> String key -> Value val -> Mapping a
foldMapping key -> val -> assoc
zip (Fold x -> assoc -> x
foldStep x
foldInit x -> a
foldExtract) String key
key Value val
val =
  Mapping
-> ([(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a)
-> Mapping a
forall a.
Mapping
-> ([(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a)
-> Mapping a
Mapping
    (String -> Value -> Mapping
Ex.MonomorphicMapping (String key -> String
forall a. String a -> String
stringExpectation String key
key) (Value val -> Value
forall a. Value a -> Value
valueExpectation Value val
val))
    [(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a
parser
  where
    parser :: [(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a
parser [(Text, YamlValue)]
input AnchorMap
anchorMap =
      (x -> (Text, YamlValue) -> Either ErrAtPath x)
-> x -> [(Text, YamlValue)] -> Either ErrAtPath x
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM x -> (Text, YamlValue) -> Either ErrAtPath x
step x
foldInit [(Text, YamlValue)]
input
        Either ErrAtPath x
-> (Either ErrAtPath x -> Either ErrAtPath a) -> Either ErrAtPath a
forall a b. a -> (a -> b) -> b
& (x -> a) -> Either ErrAtPath x -> Either ErrAtPath a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> a
foldExtract
      where
        step :: x -> (Text, YamlValue) -> Either ErrAtPath x
step x
state (Text
keyInput, YamlValue
valInput) =
          do
            key
parsedKey <- (Text -> ErrAtPath) -> Either Text key -> Either ErrAtPath key
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> ErrAtPath
keyErr (String key -> Text -> Either Text key
forall a. String a -> Text -> Either Text a
stringParser String key
key Text
keyInput)
            val
parsedVal <- (ErrAtPath -> ErrAtPath)
-> Either ErrAtPath val -> Either ErrAtPath val
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> ErrAtPath -> ErrAtPath
Err.atSegment Text
keyInput) (Value val -> YamlValue -> AnchorMap -> Either ErrAtPath val
forall a. Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
valueParser Value val
val YamlValue
valInput AnchorMap
anchorMap)
            x -> Either ErrAtPath x
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> Either ErrAtPath x) -> x -> Either ErrAtPath x
forall a b. (a -> b) -> a -> b
$! x -> assoc -> x
foldStep x
state (key -> val -> assoc
zip key
parsedKey val
parsedVal)
          where
            keyErr :: Text -> ErrAtPath
keyErr =
              [Text] -> Err -> ErrAtPath
Err.ErrAtPath []
                (Err -> ErrAtPath) -> (Text -> Err) -> Text -> ErrAtPath
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text -> Text -> Err
Err.KeyErr (String key -> String
forall a. String a -> String
stringExpectation String key
key) Text
keyInput

byKeyMapping :: CaseSensitive -> ByKey Text a -> Mapping a
byKeyMapping :: CaseSensitive -> ByKey Text a -> Mapping a
byKeyMapping CaseSensitive
caseSensitive ByKey Text a
byKey =
  Mapping
-> ([(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a)
-> Mapping a
forall a.
Mapping
-> ([(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a)
-> Mapping a
Mapping Mapping
expectation [(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a
parser
  where
    expectation :: Mapping
expectation =
      CaseSensitive -> ByKey Text -> Mapping
Ex.ByKeyMapping CaseSensitive
caseSensitive (ByKey Text a -> ByKey Text
forall key a. ByKey key a -> ByKey key
byKeyExpectation ByKey Text a
byKey)
    parser :: [(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a
parser [(Text, YamlValue)]
input =
      (ErrAtPath -> Either ErrAtPath a)
-> (Either (Acc Text) a -> Either ErrAtPath a)
-> Either ErrAtPath (Either (Acc Text) a)
-> Either ErrAtPath a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ErrAtPath -> Either ErrAtPath a
forall a b. a -> Either a b
Left ((Acc Text -> ErrAtPath)
-> Either (Acc Text) a -> Either ErrAtPath a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Acc Text -> ErrAtPath
keysErr) (Either ErrAtPath (Either (Acc Text) a) -> Either ErrAtPath a)
-> (AnchorMap -> Either ErrAtPath (Either (Acc Text) a))
-> AnchorMap
-> Either ErrAtPath a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExceptT (Acc Text) (Either ErrAtPath) a
-> Either ErrAtPath (Either (Acc Text) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (Acc Text) (Either ErrAtPath) a
 -> Either ErrAtPath (Either (Acc Text) a))
-> (AnchorMap -> ExceptT (Acc Text) (Either ErrAtPath) a)
-> AnchorMap
-> Either ErrAtPath (Either (Acc Text) a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AnchorMap -> ExceptT (Acc Text) (Either ErrAtPath) a
parser
      where
        parser :: AnchorMap -> ExceptT (Acc Text) (Either ErrAtPath) a
parser =
          if CaseSensitive -> Bool
coerce CaseSensitive
caseSensitive
            then
              let map :: HashMap Text YamlValue
map =
                    [(Text, YamlValue)] -> HashMap Text YamlValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, YamlValue)]
input
                  lookup :: Text -> Maybe YamlValue
lookup Text
k =
                    Text -> HashMap Text YamlValue -> Maybe YamlValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
k HashMap Text YamlValue
map
                  lookupFirst :: [Text] -> Maybe (Text, YamlValue)
lookupFirst [Text]
kl =
                    [Text] -> HashMap Text YamlValue -> Maybe (Text, YamlValue)
forall k v.
(Hashable k, Eq k) =>
[k] -> HashMap k v -> Maybe (k, v)
HashMap.lookupFirst [Text]
kl HashMap Text YamlValue
map
               in ByKey Text a
-> (Text -> Text)
-> (Text -> Maybe YamlValue)
-> ([Text] -> Maybe (Text, YamlValue))
-> AnchorMap
-> ExceptT (Acc Text) (Either ErrAtPath) a
forall key a.
ByKey key a
-> (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
byKeyParser ByKey Text a
byKey Text -> Text
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Text -> Maybe YamlValue
lookup [Text] -> Maybe (Text, YamlValue)
lookupFirst
            else
              let map :: HashMap Text YamlValue
map =
                    [(Text, YamlValue)] -> HashMap Text YamlValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (((Text, YamlValue) -> (Text, YamlValue))
-> [(Text, YamlValue)] -> [(Text, YamlValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text) -> (Text, YamlValue) -> (Text, YamlValue)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> Text
Text.toLower) [(Text, YamlValue)]
input)
                  lookup :: Text -> Maybe YamlValue
lookup Text
k =
                    Text -> HashMap Text YamlValue -> Maybe YamlValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Text -> Text
Text.toLower Text
k) HashMap Text YamlValue
map
                  lookupFirst :: [Text] -> Maybe (Text, YamlValue)
lookupFirst [Text]
kl =
                    [Text] -> HashMap Text YamlValue -> Maybe (Text, YamlValue)
forall k v.
(Hashable k, Eq k) =>
[k] -> HashMap k v -> Maybe (k, v)
HashMap.lookupFirst ((Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
Text.toLower [Text]
kl) HashMap Text YamlValue
map
               in ByKey Text a
-> (Text -> Text)
-> (Text -> Maybe YamlValue)
-> ([Text] -> Maybe (Text, YamlValue))
-> AnchorMap
-> ExceptT (Acc Text) (Either ErrAtPath) a
forall key a.
ByKey key a
-> (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
byKeyParser ByKey Text a
byKey Text -> Text
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Text -> Maybe YamlValue
lookup [Text] -> Maybe (Text, YamlValue)
lookupFirst
        keysErr :: Acc Text -> ErrAtPath
keysErr Acc Text
keys =
          [Text] -> Err -> ErrAtPath
Err.ErrAtPath [] (Err -> ErrAtPath) -> Err -> ErrAtPath
forall a b. (a -> b) -> a -> b
$
            ByKey Text -> CaseSensitive -> [Text] -> [Text] -> Err
Err.NoneOfMappingKeysFoundErr (ByKey Text a -> ByKey Text
forall key a. ByKey key a -> ByKey key
byKeyExpectation ByKey Text a
byKey) CaseSensitive
caseSensitive [Text]
keysAvail (Acc Text -> [Item (Acc Text)]
forall l. IsList l => l -> [Item l]
toList Acc Text
keys)
          where
            keysAvail :: [Text]
keysAvail =
              ((Text, YamlValue) -> Text) -> [(Text, YamlValue)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, YamlValue) -> Text
forall a b. (a, b) -> a
fst [(Text, YamlValue)]
input

-- *

data Sequence a = Sequence
  { Sequence a -> Sequence
sequenceExpectation :: Ex.Sequence,
    Sequence a -> [YamlValue] -> AnchorMap -> Either ErrAtPath a
sequenceParser :: [Yaml.YamlValue] -> Yaml.AnchorMap -> Either Err.ErrAtPath a
  }
  deriving (a -> Sequence b -> Sequence a
(a -> b) -> Sequence a -> Sequence b
(forall a b. (a -> b) -> Sequence a -> Sequence b)
-> (forall a b. a -> Sequence b -> Sequence a) -> Functor Sequence
forall a b. a -> Sequence b -> Sequence a
forall a b. (a -> b) -> Sequence a -> Sequence b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Sequence b -> Sequence a
$c<$ :: forall a b. a -> Sequence b -> Sequence a
fmap :: (a -> b) -> Sequence a -> Sequence b
$cfmap :: forall a b. (a -> b) -> Sequence a -> Sequence b
Functor)

foldSequence :: Fold a b -> Value a -> Sequence b
foldSequence :: Fold a b -> Value a -> Sequence b
foldSequence (Fold x -> a -> x
foldStep x
foldInit x -> b
foldExtract) Value a
value =
  Sequence
-> ([YamlValue] -> AnchorMap -> Either ErrAtPath b) -> Sequence b
forall a.
Sequence
-> ([YamlValue] -> AnchorMap -> Either ErrAtPath a) -> Sequence a
Sequence
    (Value -> Sequence
Ex.MonomorphicSequence (Value a -> Value
forall a. Value a -> Value
valueExpectation Value a
value))
    [YamlValue] -> AnchorMap -> Either ErrAtPath b
parser
  where
    parser :: [YamlValue] -> AnchorMap -> Either ErrAtPath b
parser [YamlValue]
input AnchorMap
anchorMap =
      ((Int, x) -> YamlValue -> Either ErrAtPath (Int, x))
-> (Int, x) -> [YamlValue] -> Either ErrAtPath (Int, x)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Int, x) -> YamlValue -> Either ErrAtPath (Int, x)
step (Int
0 :: Int, x
foldInit) [YamlValue]
input
        Either ErrAtPath (Int, x)
-> (Either ErrAtPath (Int, x) -> Either ErrAtPath b)
-> Either ErrAtPath b
forall a b. a -> (a -> b) -> b
& ((Int, x) -> b) -> Either ErrAtPath (Int, x) -> Either ErrAtPath b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x -> b
foldExtract (x -> b) -> ((Int, x) -> x) -> (Int, x) -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int, x) -> x
forall a b. (a, b) -> b
snd)
      where
        step :: (Int, x) -> YamlValue -> Either ErrAtPath (Int, x)
step (!Int
index, !x
state) YamlValue
input =
          Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
forall a. Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
valueParser Value a
value YamlValue
input AnchorMap
anchorMap
            Either ErrAtPath a
-> (Either ErrAtPath a -> Either ErrAtPath a) -> Either ErrAtPath a
forall a b. a -> (a -> b) -> b
& (ErrAtPath -> ErrAtPath)
-> Either ErrAtPath a -> Either ErrAtPath a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> ErrAtPath -> ErrAtPath
Err.atSegment (Int -> Text
forall a. Show a => a -> Text
showAsText Int
index))
            Either ErrAtPath a
-> (Either ErrAtPath a -> Either ErrAtPath (Int, x))
-> Either ErrAtPath (Int, x)
forall a b. a -> (a -> b) -> b
& (a -> (Int, x)) -> Either ErrAtPath a -> Either ErrAtPath (Int, x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (Int -> Int
forall a. Enum a => a -> a
succ Int
index, x -> a -> x
foldStep x
state a
a))

byOrderSequence :: ByOrder a -> Sequence a
byOrderSequence :: ByOrder a -> Sequence a
byOrderSequence (ByOrder {StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  a
ByOrder
byOrderParser :: forall a.
ByOrder a
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
byOrderExpectation :: forall a. ByOrder a -> ByOrder
byOrderParser :: StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  a
byOrderExpectation :: ByOrder
..}) =
  Sequence
-> ([YamlValue] -> AnchorMap -> Either ErrAtPath a) -> Sequence a
forall a.
Sequence
-> ([YamlValue] -> AnchorMap -> Either ErrAtPath a) -> Sequence a
Sequence
    (ByOrder -> Sequence
Ex.ByOrderSequence ByOrder
byOrderExpectation)
    [YamlValue] -> AnchorMap -> Either ErrAtPath a
parser
  where
    parser :: [YamlValue] -> AnchorMap -> Either ErrAtPath a
parser [YamlValue]
input AnchorMap
anchorMap =
      ExceptT ByOrderErr (Either ErrAtPath) a
-> Either ErrAtPath (Either ByOrderErr a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)) a
-> AnchorMap -> ExceptT ByOrderErr (Either ErrAtPath) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  a
-> (Int, [YamlValue])
-> ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)) a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  a
byOrderParser (Int
0, [YamlValue]
input)) AnchorMap
anchorMap)
        Either ErrAtPath (Either ByOrderErr a)
-> (Either ErrAtPath (Either ByOrderErr a) -> Either ErrAtPath a)
-> Either ErrAtPath a
forall a b. a -> (a -> b) -> b
& (ErrAtPath -> Either ErrAtPath a)
-> (Either ByOrderErr a -> Either ErrAtPath a)
-> Either ErrAtPath (Either ByOrderErr a)
-> Either ErrAtPath a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ErrAtPath -> Either ErrAtPath a
forall a b. a -> Either a b
Left ((ByOrderErr -> ErrAtPath)
-> Either ByOrderErr a -> Either ErrAtPath a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ByOrderErr -> ErrAtPath
mapErr)
      where
        mapErr :: ByOrderErr -> ErrAtPath
mapErr =
          \case
            NotEnoughElementsByOrderErr Int
a ->
              [Text] -> Err -> ErrAtPath
Err.ErrAtPath [] (Err -> ErrAtPath) -> Err -> ErrAtPath
forall a b. (a -> b) -> a -> b
$
                ByOrder -> Int -> Err
Err.NotEnoughElementsErr ByOrder
byOrderExpectation Int
a

byKeySequence :: ByKey Int a -> Sequence a
byKeySequence :: ByKey Int a -> Sequence a
byKeySequence (ByKey {ByKey Int
(Int -> Text)
-> (Int -> Maybe YamlValue)
-> ([Int] -> Maybe (Int, YamlValue))
-> AnchorMap
-> ExceptT (Acc Int) (Either ErrAtPath) a
byKeyParser :: (Int -> Text)
-> (Int -> Maybe YamlValue)
-> ([Int] -> Maybe (Int, YamlValue))
-> AnchorMap
-> ExceptT (Acc Int) (Either ErrAtPath) a
byKeyExpectation :: ByKey Int
byKeyParser :: forall key a.
ByKey key a
-> (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
byKeyExpectation :: forall key a. ByKey key a -> ByKey key
..}) =
  Sequence
-> ([YamlValue] -> AnchorMap -> Either ErrAtPath a) -> Sequence a
forall a.
Sequence
-> ([YamlValue] -> AnchorMap -> Either ErrAtPath a) -> Sequence a
Sequence Sequence
expectation [YamlValue] -> AnchorMap -> Either ErrAtPath a
parser
  where
    expectation :: Sequence
expectation =
      ByKey Int -> Sequence
Ex.ByKeySequence ByKey Int
byKeyExpectation
    parser :: [YamlValue] -> AnchorMap -> Either ErrAtPath a
parser [YamlValue]
input =
      let vector :: Vector YamlValue
vector =
            [YamlValue] -> Vector YamlValue
forall a. [a] -> Vector a
Vector.fromList [YamlValue]
input
          lookup :: Int -> Maybe YamlValue
lookup Int
k =
            Vector YamlValue
vector Vector YamlValue -> Int -> Maybe YamlValue
forall a. Vector a -> Int -> Maybe a
Vector.!? Int
k
          lookupFirst :: [Int] -> Maybe (Int, YamlValue)
lookupFirst [Int]
kl =
            [Int] -> Vector YamlValue -> Maybe (Int, YamlValue)
forall a. [Int] -> Vector a -> Maybe (Int, a)
Vector.lookupFirst [Int]
kl Vector YamlValue
vector
       in \AnchorMap
anchorMap ->
            ExceptT (Acc Int) (Either ErrAtPath) a
-> Either ErrAtPath (Either (Acc Int) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ((Int -> Text)
-> (Int -> Maybe YamlValue)
-> ([Int] -> Maybe (Int, YamlValue))
-> AnchorMap
-> ExceptT (Acc Int) (Either ErrAtPath) a
byKeyParser Int -> Text
forall a. Show a => a -> Text
showAsText Int -> Maybe YamlValue
lookup [Int] -> Maybe (Int, YamlValue)
lookupFirst AnchorMap
anchorMap)
              Either ErrAtPath (Either (Acc Int) a)
-> (Either ErrAtPath (Either (Acc Int) a) -> Either ErrAtPath a)
-> Either ErrAtPath a
forall a b. a -> (a -> b) -> b
& (ErrAtPath -> Either ErrAtPath a)
-> (Either (Acc Int) a -> Either ErrAtPath a)
-> Either ErrAtPath (Either (Acc Int) a)
-> Either ErrAtPath a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ErrAtPath -> Either ErrAtPath a
forall a b. a -> Either a b
Left ((Acc Int -> ErrAtPath) -> Either (Acc Int) a -> Either ErrAtPath a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Acc Int -> ErrAtPath
keysErr)
      where
        keysErr :: Acc Int -> ErrAtPath
keysErr Acc Int
keys =
          [Text] -> Err -> ErrAtPath
Err.ErrAtPath [] (Err -> ErrAtPath) -> Err -> ErrAtPath
forall a b. (a -> b) -> a -> b
$
            ByKey Int -> [Int] -> Err
Err.NoneOfSequenceKeysFoundErr ByKey Int
byKeyExpectation (Acc Int -> [Item (Acc Int)]
forall l. IsList l => l -> [Item l]
toList Acc Int
keys)

-- *

data String a = String
  { String a -> String
stringExpectation :: Ex.String,
    String a -> Text -> Either Text a
stringParser :: Text -> Either Text a
  }
  deriving (a -> String b -> String a
(a -> b) -> String a -> String b
(forall a b. (a -> b) -> String a -> String b)
-> (forall a b. a -> String b -> String a) -> Functor String
forall a b. a -> String b -> String a
forall a b. (a -> b) -> String a -> String b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> String b -> String a
$c<$ :: forall a b. a -> String b -> String a
fmap :: (a -> b) -> String a -> String b
$cfmap :: forall a b. (a -> b) -> String a -> String b
Functor)

textString :: String Text
textString :: String Text
textString =
  String -> (Text -> Either Text Text) -> String Text
forall a. String -> (Text -> Either Text a) -> String a
String String
Ex.AnyString Text -> Either Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return

enumString :: CaseSensitive -> [(Text, a)] -> String a
enumString :: CaseSensitive -> [(Text, a)] -> String a
enumString (CaseSensitive Bool
caseSensitive) [(Text, a)]
assocList =
  String -> (Text -> Either Text a) -> String a
forall a. String -> (Text -> Either Text a) -> String a
String String
expectation Text -> Either Text a
parser
  where
    expectation :: String
expectation =
      CaseSensitive -> [Text] -> String
Ex.OneOfString (Bool -> CaseSensitive
CaseSensitive Bool
caseSensitive) (((Text, a) -> Text) -> [(Text, a)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, a) -> Text
forall a b. (a, b) -> a
fst [(Text, a)]
assocList)
    {-# NOINLINE lookup #-}
    lookup :: Text -> Maybe a
lookup =
      if [(Text, a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, a)]
assocList Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
512
        then
          if Bool
caseSensitive
            then
              let hashMap :: HashMap Text a
hashMap =
                    [(Text, a)] -> HashMap Text a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, a)]
assocList
               in (Text -> HashMap Text a -> Maybe a)
-> HashMap Text a -> Text -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> HashMap Text a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup HashMap Text a
hashMap
            else
              let hashMap :: HashMap Text a
hashMap =
                    [(Text, a)] -> HashMap Text a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (((Text, a) -> (Text, a)) -> [(Text, a)] -> [(Text, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text) -> (Text, a) -> (Text, a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> Text
Text.toLower) [(Text, a)]
assocList)
               in (Text -> HashMap Text a -> Maybe a)
-> HashMap Text a -> Text -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> HashMap Text a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup HashMap Text a
hashMap (Text -> Maybe a) -> (Text -> Text) -> Text -> Maybe a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
Text.toLower
        else
          if Bool
caseSensitive
            then (Text -> [(Text, a)] -> Maybe a) -> [(Text, a)] -> Text -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [(Text, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup [(Text, a)]
assocList
            else (Text -> [(Text, a)] -> Maybe a) -> [(Text, a)] -> Text -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [(Text, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup (((Text, a) -> (Text, a)) -> [(Text, a)] -> [(Text, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text) -> (Text, a) -> (Text, a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> Text
Text.toLower) [(Text, a)]
assocList) (Text -> Maybe a) -> (Text -> Text) -> Text -> Maybe a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
Text.toLower
    parser :: Text -> Either Text a
parser Text
text =
      case Text -> Maybe a
lookup Text
text of
        Just a
a -> a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
        Maybe a
_ -> Text -> Either Text a
forall a b. a -> Either a b
Left Text
"Unexpected value"

formattedString :: Text -> (Text -> Either Text a) -> String a
formattedString :: Text -> (Text -> Either Text a) -> String a
formattedString Text
format Text -> Either Text a
parser =
  String -> (Text -> Either Text a) -> String a
forall a. String -> (Text -> Either Text a) -> String a
String
    (Text -> String
Ex.FormattedString Text
format)
    Text -> Either Text a
parser

attoparsedString :: Text -> TextAtto.Parser a -> String a
attoparsedString :: Text -> Parser a -> String a
attoparsedString Text
format Parser a
parser =
  String -> (Text -> Either Text a) -> String a
forall a. String -> (Text -> Either Text a) -> String a
String
    (Text -> String
Ex.FormattedString Text
format)
    ((AnchorName -> Text) -> Either AnchorName a -> Either Text a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AnchorName -> Text
forall a. IsString a => AnchorName -> a
fromString (Either AnchorName a -> Either Text a)
-> (Text -> Either AnchorName a) -> Text -> Either Text a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parser a -> Text -> Either AnchorName a
forall a. Parser a -> Text -> Either AnchorName a
TextAtto.parseOnly Parser a
parser)

-- *

data ByKey key a = ByKey
  { ByKey key a -> ByKey key
byKeyExpectation :: Ex.ByKey key,
    ByKey key a
-> (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
byKeyParser ::
      (key -> Text) ->
      (key -> Maybe Yaml.YamlValue) ->
      ([key] -> Maybe (key, Yaml.YamlValue)) ->
      Yaml.AnchorMap ->
      ExceptT (Acc key) (Either Err.ErrAtPath) a
  }
  deriving (a -> ByKey key b -> ByKey key a
(a -> b) -> ByKey key a -> ByKey key b
(forall a b. (a -> b) -> ByKey key a -> ByKey key b)
-> (forall a b. a -> ByKey key b -> ByKey key a)
-> Functor (ByKey key)
forall a b. a -> ByKey key b -> ByKey key a
forall a b. (a -> b) -> ByKey key a -> ByKey key b
forall key a b. a -> ByKey key b -> ByKey key a
forall key a b. (a -> b) -> ByKey key a -> ByKey key b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ByKey key b -> ByKey key a
$c<$ :: forall key a b. a -> ByKey key b -> ByKey key a
fmap :: (a -> b) -> ByKey key a -> ByKey key b
$cfmap :: forall key a b. (a -> b) -> ByKey key a -> ByKey key b
Functor)

instance Applicative (ByKey key) where
  pure :: a -> ByKey key a
pure =
    ByKey key
-> ((key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> ByKey key a
forall key a.
ByKey key
-> ((key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> ByKey key a
ByKey ByKey key
forall key. ByKey key
Ex.AnyByKey (((key -> Text)
  -> (key -> Maybe YamlValue)
  -> ([key] -> Maybe (key, YamlValue))
  -> AnchorMap
  -> ExceptT (Acc key) (Either ErrAtPath) a)
 -> ByKey key a)
-> (a
    -> (key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> a
-> ByKey key a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((key -> Maybe YamlValue)
 -> ([key] -> Maybe (key, YamlValue))
 -> AnchorMap
 -> ExceptT (Acc key) (Either ErrAtPath) a)
-> (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
forall a b. a -> b -> a
const (((key -> Maybe YamlValue)
  -> ([key] -> Maybe (key, YamlValue))
  -> AnchorMap
  -> ExceptT (Acc key) (Either ErrAtPath) a)
 -> (key -> Text)
 -> (key -> Maybe YamlValue)
 -> ([key] -> Maybe (key, YamlValue))
 -> AnchorMap
 -> ExceptT (Acc key) (Either ErrAtPath) a)
-> (a
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> a
-> (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (([key] -> Maybe (key, YamlValue))
 -> AnchorMap -> ExceptT (Acc key) (Either ErrAtPath) a)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
forall a b. a -> b -> a
const ((([key] -> Maybe (key, YamlValue))
  -> AnchorMap -> ExceptT (Acc key) (Either ErrAtPath) a)
 -> (key -> Maybe YamlValue)
 -> ([key] -> Maybe (key, YamlValue))
 -> AnchorMap
 -> ExceptT (Acc key) (Either ErrAtPath) a)
-> (a
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> a
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (AnchorMap -> ExceptT (Acc key) (Either ErrAtPath) a)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
forall a b. a -> b -> a
const ((AnchorMap -> ExceptT (Acc key) (Either ErrAtPath) a)
 -> ([key] -> Maybe (key, YamlValue))
 -> AnchorMap
 -> ExceptT (Acc key) (Either ErrAtPath) a)
-> (a -> AnchorMap -> ExceptT (Acc key) (Either ErrAtPath) a)
-> a
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExceptT (Acc key) (Either ErrAtPath) a
-> AnchorMap -> ExceptT (Acc key) (Either ErrAtPath) a
forall a b. a -> b -> a
const (ExceptT (Acc key) (Either ErrAtPath) a
 -> AnchorMap -> ExceptT (Acc key) (Either ErrAtPath) a)
-> (a -> ExceptT (Acc key) (Either ErrAtPath) a)
-> a
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> ExceptT (Acc key) (Either ErrAtPath) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  <*> :: ByKey key (a -> b) -> ByKey key a -> ByKey key b
(<*>) (ByKey ByKey key
le (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) (a -> b)
lp) (ByKey ByKey key
re (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
rp) =
    ByKey key
-> ((key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) b)
-> ByKey key b
forall key a.
ByKey key
-> ((key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> ByKey key a
ByKey
      (ByKey key -> ByKey key -> ByKey key
forall key. ByKey key -> ByKey key -> ByKey key
Ex.BothByKey ByKey key
le ByKey key
re)
      (\key -> Text
a key -> Maybe YamlValue
b [key] -> Maybe (key, YamlValue)
c AnchorMap
d -> (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) (a -> b)
lp key -> Text
a key -> Maybe YamlValue
b [key] -> Maybe (key, YamlValue)
c AnchorMap
d ExceptT (Acc key) (Either ErrAtPath) (a -> b)
-> ExceptT (Acc key) (Either ErrAtPath) a
-> ExceptT (Acc key) (Either ErrAtPath) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
rp key -> Text
a key -> Maybe YamlValue
b [key] -> Maybe (key, YamlValue)
c AnchorMap
d)

instance Selective (ByKey key) where
  select :: ByKey key (Either a b) -> ByKey key (a -> b) -> ByKey key b
select (ByKey ByKey key
le (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) (Either a b)
lp) (ByKey ByKey key
re (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) (a -> b)
rp) =
    ByKey key
-> ((key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) b)
-> ByKey key b
forall key a.
ByKey key
-> ((key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> ByKey key a
ByKey
      (ByKey key -> ByKey key -> ByKey key
forall key. ByKey key -> ByKey key -> ByKey key
Ex.BothByKey ByKey key
le ByKey key
re)
      (\key -> Text
a key -> Maybe YamlValue
b [key] -> Maybe (key, YamlValue)
c AnchorMap
d -> ExceptT (Acc key) (Either ErrAtPath) (Either a b)
-> ExceptT (Acc key) (Either ErrAtPath) (a -> b)
-> ExceptT (Acc key) (Either ErrAtPath) b
forall (f :: * -> *) a b.
Selective f =>
f (Either a b) -> f (a -> b) -> f b
select ((key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) (Either a b)
lp key -> Text
a key -> Maybe YamlValue
b [key] -> Maybe (key, YamlValue)
c AnchorMap
d) ((key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) (a -> b)
rp key -> Text
a key -> Maybe YamlValue
b [key] -> Maybe (key, YamlValue)
c AnchorMap
d))

instance Alternative (ByKey key) where
  empty :: ByKey key a
empty =
    ByKey key
-> ((key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> ByKey key a
forall key a.
ByKey key
-> ((key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> ByKey key a
ByKey
      ByKey key
forall key. ByKey key
Ex.NoByKey
      (((key -> Maybe YamlValue)
 -> ([key] -> Maybe (key, YamlValue))
 -> AnchorMap
 -> ExceptT (Acc key) (Either ErrAtPath) a)
-> (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
forall a b. a -> b -> a
const ((([key] -> Maybe (key, YamlValue))
 -> AnchorMap -> ExceptT (Acc key) (Either ErrAtPath) a)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
forall a b. a -> b -> a
const ((AnchorMap -> ExceptT (Acc key) (Either ErrAtPath) a)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
forall a b. a -> b -> a
const (ExceptT (Acc key) (Either ErrAtPath) a
-> AnchorMap -> ExceptT (Acc key) (Either ErrAtPath) a
forall a b. a -> b -> a
const ExceptT (Acc key) (Either ErrAtPath) a
forall (f :: * -> *) a. Alternative f => f a
empty))))
  <|> :: ByKey key a -> ByKey key a -> ByKey key a
(<|>) (ByKey ByKey key
le (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
lp) (ByKey ByKey key
re (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
rp) =
    ByKey key
-> ((key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> ByKey key a
forall key a.
ByKey key
-> ((key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> ByKey key a
ByKey
      (ByKey key -> ByKey key -> ByKey key
forall key. ByKey key -> ByKey key -> ByKey key
Ex.EitherByKey ByKey key
le ByKey key
re)
      (\key -> Text
a key -> Maybe YamlValue
b [key] -> Maybe (key, YamlValue)
c AnchorMap
d -> (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
lp key -> Text
a key -> Maybe YamlValue
b [key] -> Maybe (key, YamlValue)
c AnchorMap
d ExceptT (Acc key) (Either ErrAtPath) a
-> ExceptT (Acc key) (Either ErrAtPath) a
-> ExceptT (Acc key) (Either ErrAtPath) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
rp key -> Text
a key -> Maybe YamlValue
b [key] -> Maybe (key, YamlValue)
c AnchorMap
d)

atByKey :: key -> Value a -> ByKey key a
atByKey :: key -> Value a -> ByKey key a
atByKey key
key Value a
valueSpec =
  ByKey key
-> ((key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> ByKey key a
forall key a.
ByKey key
-> ((key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> ByKey key a
ByKey
    ([key] -> Value -> ByKey key
forall key. [key] -> Value -> ByKey key
Ex.LookupByKey [key
key] (Value a -> Value
forall a. Value a -> Value
valueExpectation Value a
valueSpec))
    (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
parser
  where
    parser :: (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
parser key -> Text
renderKey key -> Maybe YamlValue
lookup [key] -> Maybe (key, YamlValue)
_ AnchorMap
env =
      case key -> Maybe YamlValue
lookup key
key of
        Just YamlValue
val ->
          Either ErrAtPath a -> ExceptT (Acc key) (Either ErrAtPath) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ErrAtPath a -> ExceptT (Acc key) (Either ErrAtPath) a)
-> Either ErrAtPath a -> ExceptT (Acc key) (Either ErrAtPath) a
forall a b. (a -> b) -> a -> b
$
            (ErrAtPath -> ErrAtPath)
-> Either ErrAtPath a -> Either ErrAtPath a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> ErrAtPath -> ErrAtPath
Err.atSegment (key -> Text
renderKey key
key)) (Either ErrAtPath a -> Either ErrAtPath a)
-> Either ErrAtPath a -> Either ErrAtPath a
forall a b. (a -> b) -> a -> b
$
              Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
forall a. Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
valueParser Value a
valueSpec YamlValue
val AnchorMap
env
        Maybe YamlValue
Nothing ->
          Acc key -> ExceptT (Acc key) (Either ErrAtPath) a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (key -> Acc key
forall (f :: * -> *) a. Applicative f => a -> f a
pure key
key)

atOneOfByKey :: [key] -> Value a -> ByKey key a
atOneOfByKey :: [key] -> Value a -> ByKey key a
atOneOfByKey [key]
keys Value a
valueSpec =
  ByKey key
-> ((key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> ByKey key a
forall key a.
ByKey key
-> ((key -> Text)
    -> (key -> Maybe YamlValue)
    -> ([key] -> Maybe (key, YamlValue))
    -> AnchorMap
    -> ExceptT (Acc key) (Either ErrAtPath) a)
-> ByKey key a
ByKey
    ([key] -> Value -> ByKey key
forall key. [key] -> Value -> ByKey key
Ex.LookupByKey [key]
keys (Value a -> Value
forall a. Value a -> Value
valueExpectation Value a
valueSpec))
    (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
parser
  where
    parser :: (key -> Text)
-> (key -> Maybe YamlValue)
-> ([key] -> Maybe (key, YamlValue))
-> AnchorMap
-> ExceptT (Acc key) (Either ErrAtPath) a
parser key -> Text
renderKey key -> Maybe YamlValue
_ [key] -> Maybe (key, YamlValue)
lookup AnchorMap
env =
      case [key] -> Maybe (key, YamlValue)
lookup [key]
keys of
        Just (key
key, YamlValue
val) ->
          Either ErrAtPath a -> ExceptT (Acc key) (Either ErrAtPath) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ErrAtPath a -> ExceptT (Acc key) (Either ErrAtPath) a)
-> Either ErrAtPath a -> ExceptT (Acc key) (Either ErrAtPath) a
forall a b. (a -> b) -> a -> b
$
            (ErrAtPath -> ErrAtPath)
-> Either ErrAtPath a -> Either ErrAtPath a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> ErrAtPath -> ErrAtPath
Err.atSegment (key -> Text
renderKey key
key)) (Either ErrAtPath a -> Either ErrAtPath a)
-> Either ErrAtPath a -> Either ErrAtPath a
forall a b. (a -> b) -> a -> b
$
              Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
forall a. Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
valueParser Value a
valueSpec YamlValue
val AnchorMap
env
        Maybe (key, YamlValue)
Nothing ->
          Acc key -> ExceptT (Acc key) (Either ErrAtPath) a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ([Item (Acc key)] -> Acc key
forall l. IsList l => [Item l] -> l
fromList [key]
[Item (Acc key)]
keys)

-- *

data ByOrderErr
  = NotEnoughElementsByOrderErr
      Int

data ByOrder a = ByOrder
  { ByOrder a -> ByOrder
byOrderExpectation :: Ex.ByOrder,
    ByOrder a
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
byOrderParser :: StateT (Int, [Yaml.YamlValue]) (ReaderT Yaml.AnchorMap (ExceptT ByOrderErr (Either Err.ErrAtPath))) a
  }
  deriving (a -> ByOrder b -> ByOrder a
(a -> b) -> ByOrder a -> ByOrder b
(forall a b. (a -> b) -> ByOrder a -> ByOrder b)
-> (forall a b. a -> ByOrder b -> ByOrder a) -> Functor ByOrder
forall a b. a -> ByOrder b -> ByOrder a
forall a b. (a -> b) -> ByOrder a -> ByOrder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ByOrder b -> ByOrder a
$c<$ :: forall a b. a -> ByOrder b -> ByOrder a
fmap :: (a -> b) -> ByOrder a -> ByOrder b
$cfmap :: forall a b. (a -> b) -> ByOrder a -> ByOrder b
Functor)

instance Applicative ByOrder where
  pure :: a -> ByOrder a
pure =
    ByOrder
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
-> ByOrder a
forall a.
ByOrder
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
-> ByOrder a
ByOrder ByOrder
Ex.AnyByOrder (StateT
   (Int, [YamlValue])
   (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
   a
 -> ByOrder a)
-> (a
    -> StateT
         (Int, [YamlValue])
         (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
         a)
-> a
-> ByOrder a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  <*> :: ByOrder (a -> b) -> ByOrder a -> ByOrder b
(<*>) (ByOrder ByOrder
le StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  (a -> b)
lp) (ByOrder ByOrder
re StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  a
rp) =
    ByOrder
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     b
-> ByOrder b
forall a.
ByOrder
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
-> ByOrder a
ByOrder
      (ByOrder -> ByOrder -> ByOrder
Ex.BothByOrder ByOrder
le ByOrder
re)
      (StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  (a -> b)
lp StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  (a -> b)
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  a
rp)

instance Selective ByOrder where
  select :: ByOrder (Either a b) -> ByOrder (a -> b) -> ByOrder b
select (ByOrder ByOrder
le StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  (Either a b)
lp) (ByOrder ByOrder
re StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  (a -> b)
rp) =
    ByOrder
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     b
-> ByOrder b
forall a.
ByOrder
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
-> ByOrder a
ByOrder
      (ByOrder -> ByOrder -> ByOrder
Ex.BothByOrder ByOrder
le ByOrder
re)
      (StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  (Either a b)
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     (a -> b)
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     b
forall (f :: * -> *) a b.
Selective f =>
f (Either a b) -> f (a -> b) -> f b
select StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  (Either a b)
lp StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  (a -> b)
rp)

fetchByOrder :: Value a -> ByOrder a
fetchByOrder :: Value a -> ByOrder a
fetchByOrder Value a
value =
  ByOrder
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
-> ByOrder a
forall a.
ByOrder
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
-> ByOrder a
ByOrder
    (Value -> ByOrder
Ex.FetchByOrder (Value a -> Value
forall a. Value a -> Value
valueExpectation Value a
value))
    StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  a
parser
  where
    parser :: StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  a
parser =
      do
        (!Int
offset, [YamlValue]
list) <- StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  (Int, [YamlValue])
forall s (m :: * -> *). MonadState s m => m s
get
        case [YamlValue]
list of
          YamlValue
h : [YamlValue]
t ->
            do
              (Int, [YamlValue])
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> Int
forall a. Enum a => a -> a
succ Int
offset, [YamlValue]
t)
              AnchorMap
anchorMap <- StateT
  (Int, [YamlValue])
  (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
  AnchorMap
forall r (m :: * -> *). MonadReader r m => m r
ask
              ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)) a
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)) a
 -> StateT
      (Int, [YamlValue])
      (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
      a)
-> ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)) a
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
forall a b. (a -> b) -> a -> b
$ ExceptT ByOrderErr (Either ErrAtPath) a
-> ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT ByOrderErr (Either ErrAtPath) a
 -> ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)) a)
-> ExceptT ByOrderErr (Either ErrAtPath) a
-> ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)) a
forall a b. (a -> b) -> a -> b
$ Either ErrAtPath a -> ExceptT ByOrderErr (Either ErrAtPath) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ErrAtPath a -> ExceptT ByOrderErr (Either ErrAtPath) a)
-> Either ErrAtPath a -> ExceptT ByOrderErr (Either ErrAtPath) a
forall a b. (a -> b) -> a -> b
$ (ErrAtPath -> ErrAtPath)
-> Either ErrAtPath a -> Either ErrAtPath a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> ErrAtPath -> ErrAtPath
Err.atSegment (Int -> Text
forall a. Show a => a -> Text
showAsText Int
offset)) (Either ErrAtPath a -> Either ErrAtPath a)
-> Either ErrAtPath a -> Either ErrAtPath a
forall a b. (a -> b) -> a -> b
$ Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
forall a. Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
valueParser Value a
value YamlValue
h AnchorMap
anchorMap
          [YamlValue]
_ ->
            ByOrderErr
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ByOrderErr
 -> StateT
      (Int, [YamlValue])
      (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
      a)
-> ByOrderErr
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
forall a b. (a -> b) -> a -> b
$ Int -> ByOrderErr
NotEnoughElementsByOrderErr Int
offset