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.Selective.Trans.Except as Selective.ExceptT
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.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.Vector as Vector
import qualified YamlUnscrambler.Util.Yaml as Yaml

-- * Execution

-- |
-- Run a value parser on strict text.
parseText :: Value a -> Text -> Either Text a
parseText :: forall a. Value a -> Text -> Either Text a
parseText Value a
value =
  forall a. Value a -> ByteString -> Either Text a
parseByteString Value a
value 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

-- |
-- Run a value parser on strict bytestring.
parseByteString :: Value a -> ByteString -> Either Text a
parseByteString :: forall a. 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 forall a b. a -> (a -> b) -> b
& 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 :: forall a. Value a -> Value
getExpectations =
  forall a. Value a -> Value
valueExpectation

-- * --

-- | Parser of any kind of YAML value: scalar, mapping or sequence.
data Value a = Value
  { forall a. Value a -> Value
valueExpectation :: Ex.Value,
    forall a. Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
valueParser :: Yaml.YamlValue -> Yaml.AnchorMap -> Either Err.ErrAtPath a
  }
  deriving (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
<$ :: forall a b. a -> Value b -> Value a
$c<$ :: forall a b. a -> Value b -> Value a
fmap :: forall a b. (a -> b) -> Value a -> Value b
$cfmap :: forall a b. (a -> b) -> Value a -> Value b
Functor)

-- | Specification of various alternative ways of parsing a non-nullable value.
value :: [Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value :: forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value [Scalar a]
scalars Maybe (Mapping a)
mappings Maybe (Sequence a)
sequences =
  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
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Mapping a -> Mapping
mappingExpectation Maybe (Mapping a)
mappings)
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Sequence a -> Sequence
sequenceExpectation Maybe (Sequence a)
sequences)
    scalarExpectations :: [Scalar]
scalarExpectations =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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
            [] ->
              forall a b. a -> Either a b
Left ([Text] -> Err -> ErrAtPath
Err.ErrAtPath [] (Value -> Err
Err.UnexpectedScalarErr Value
expectations))
            [Scalar a]
_ ->
              forall e a. Except e a -> Either e a
runExcept (forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scalar a -> ExceptT (Last Text) Identity a
parse [Scalar a]
scalars))
                forall a b. a -> (a -> b) -> b
& forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Last Text -> ErrAtPath
convErr
              where
                parse :: Scalar a -> ExceptT (Last Text) Identity a
parse Scalar a
scalar =
                  forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a. Maybe a -> Last a
Last forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a
Just) forall a b. (a -> b) -> a -> b
$ 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 ->
              forall a.
Mapping a -> [(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a
mappingParser Mapping a
mapping [(Text, YamlValue)]
input AnchorMap
anchorMap
            Maybe (Mapping a)
Nothing ->
              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 ->
              forall a.
Sequence a -> [YamlValue] -> AnchorMap -> Either ErrAtPath a
sequenceParser Sequence a
sequence [YamlValue]
input AnchorMap
anchorMap
            Maybe (Sequence a)
Nothing ->
              forall a b. a -> Either a b
Left ([Text] -> Err -> ErrAtPath
Err.ErrAtPath [] (Value -> Err
Err.UnexpectedSequenceErr Value
expectations))
        Yaml.Alias AnchorName
anchorName ->
          case 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 ->
              forall a b. a -> Either a b
Left ([Text] -> Err -> ErrAtPath
Err.ErrAtPath [] (Text -> Err
Err.UnknownAnchorErr (forall a. IsString a => AnchorName -> a
fromString AnchorName
anchorName)))

-- | Specification of various alternative ways of parsing a nullable value.
nullableValue :: [Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value (Maybe a)
nullableValue :: forall a.
[Scalar a]
-> Maybe (Mapping a) -> Maybe (Sequence a) -> Value (Maybe a)
nullableValue [Scalar a]
scalars Maybe (Mapping a)
mappings Maybe (Sequence a)
sequences =
  forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value
    ((forall a. a -> Scalar a
nullScalar forall a. Maybe a
Nothing) forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just) [Scalar a]
scalars)
    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just) Maybe (Mapping a)
mappings)
    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just) Maybe (Sequence a)
sequences)

-- ** Helpers

-- | Value parser, which only expects sequence values.
sequenceValue :: Sequence a -> Value a
sequenceValue :: forall a. Sequence a -> Value a
sequenceValue Sequence a
sequence =
  forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value [] forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Sequence a
sequence)

-- | Value parser, which only expects mapping values.
mappingValue :: Mapping a -> Value a
mappingValue :: forall a. Mapping a -> Value a
mappingValue Mapping a
mapping =
  forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value [] (forall a. a -> Maybe a
Just Mapping a
mapping) forall a. Maybe a
Nothing

-- | Value parser, which only expects scalar values.
scalarsValue :: [Scalar a] -> Value a
scalarsValue :: forall a. [Scalar a] -> Value a
scalarsValue [Scalar a]
scalars =
  forall a.
[Scalar a] -> Maybe (Mapping a) -> Maybe (Sequence a) -> Value a
value [Scalar a]
scalars forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- * --

-- | Scalar value parser.
data Scalar a = Scalar
  { forall a. Scalar a -> Scalar
scalarExpectation :: Ex.Scalar,
    forall a. Scalar a -> ByteString -> Tag -> Style -> Either Text a
scalarParser :: ByteString -> Libyaml.Tag -> Libyaml.Style -> Either Text a
  }
  deriving (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
<$ :: forall a b. a -> Scalar b -> Scalar a
$c<$ :: forall a b. a -> Scalar b -> Scalar a
fmap :: forall a b. (a -> b) -> Scalar a -> Scalar b
$cfmap :: forall a b. (a -> b) -> Scalar a -> Scalar b
Functor)

-- | Custom parser function of a strict bytestring as a scalar value.
bytesParsingScalar :: Ex.Scalar -> (ByteString -> Either Text a) -> Scalar a
bytesParsingScalar :: forall a. Scalar -> (ByteString -> Either Text a) -> Scalar a
bytesParsingScalar Scalar
expectation ByteString -> Either Text a
parser =
  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)

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

-- | Add protection on the maximum allowed input size over a scalar parser.
sizedScalar :: MaxInputSize -> Scalar a -> Scalar a
sizedScalar :: forall a. 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
..}) =
  forall a.
Scalar -> (ByteString -> Tag -> Style -> Either Text a) -> Scalar a
Scalar Scalar
scalarExpectation forall a b. (a -> b) -> a -> b
$ \ByteString
bytes Tag
tag Style
style ->
    if ByteString -> Int
ByteString.length ByteString
bytes forall a. Ord a => a -> a -> Bool
<= Int
maxInputSize
      then ByteString -> Tag -> Style -> Either Text a
scalarParser ByteString
bytes Tag
tag Style
style
      else forall a b. a -> Either a b
Left (Text
"Input is longer then the expected maximum of " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showAsText Int
maxInputSize forall a. Semigroup a => a -> a -> a
<> Text
" bytes")

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

-- | A parser expecting a null value and resulting in the provided constant value when successful.
nullScalar :: a -> Scalar a
nullScalar :: forall a. a -> Scalar a
nullScalar a
a =
  forall a.
Scalar -> (ByteString -> Tag -> Style -> Either Text a) -> Scalar a
Scalar Scalar
Ex.NullScalar forall a b. (a -> b) -> a -> b
$ \ByteString
bytes Tag
tag Style
_ ->
    if Tag
tag
      forall a. Eq a => a -> a -> Bool
== Tag
Libyaml.NullTag
      Bool -> Bool -> Bool
|| ByteString -> Bool
ByteString.null ByteString
bytes
      Bool -> Bool -> Bool
|| ByteString
bytes
      forall a. Eq a => a -> a -> Bool
== ByteString
"~"
      Bool -> Bool -> Bool
|| ByteString -> Bool
ByteString.saysNullInCiAscii ByteString
bytes
      then forall a b. b -> Either a b
Right a
a
      else forall a b. a -> Either a b
Left Text
"Not null"

-- | Boolean scalar parser.
boolScalar :: Scalar Bool
boolScalar :: Scalar Bool
boolScalar =
  forall a. Scalar -> (ByteString -> Either Text a) -> Scalar a
bytesParsingScalar Scalar
Ex.BoolScalar forall a b. (a -> b) -> a -> b
$ \ByteString
bytes ->
    if ByteString -> Int
ByteString.length ByteString
bytes forall a. Ord a => a -> a -> Bool
<= Int
5
      then
        let lowercased :: ByteString
lowercased =
              ByteString -> ByteString
ByteString.lowercaseInAscii ByteString
bytes
         in if 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 forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
              else
                if 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 forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                  else forall a b. a -> Either a b
Left Text
"Not a boolean"
      else forall a b. a -> Either a b
Left Text
"Not a boolean"

-- | Numeric scalar as scientific parser.
scientificScalar :: Scalar Scientific
scientificScalar :: Scalar Scientific
scientificScalar =
  forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
Ex.ScientificScalar Parser Scientific
AsciiAtto.scientific

-- | Numeric scalar as double parser.
doubleScalar :: Scalar Double
doubleScalar :: Scalar Double
doubleScalar =
  forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
Ex.DoubleScalar Parser Double
AsciiAtto.double

-- | Numeric scalar as rational parser protected with maximum allowed input size.
rationalScalar :: MaxInputSize -> Scalar Rational
rationalScalar :: MaxInputSize -> Scalar Rational
rationalScalar MaxInputSize
a =
  forall a. MaxInputSize -> Scalar a -> Scalar a
sizedScalar MaxInputSize
a
    forall a b. (a -> b) -> a -> b
$ forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar (MaxInputSize -> Scalar
Ex.RationalScalar MaxInputSize
a) forall a. Fractional a => Parser a
AsciiAtto.rational

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

-- |
-- Numeric scalar parser into any integer value.
unboundedIntegerScalar :: MaxInputSize -> Signed -> NumeralSystem -> Scalar Integer
unboundedIntegerScalar :: MaxInputSize -> Signed -> NumeralSystem -> Scalar Integer
unboundedIntegerScalar MaxInputSize
a Signed
b NumeralSystem
c =
  forall a. MaxInputSize -> Scalar a -> Scalar a
sizedScalar MaxInputSize
a
    forall a b. (a -> b) -> a -> b
$ forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar (MaxInputSize -> Signed -> NumeralSystem -> Scalar
Ex.UnboundedIntegerScalar MaxInputSize
a Signed
b NumeralSystem
c) (forall a.
(Integral a, Bits a) =>
Signed -> NumeralSystem -> Parser a
AsciiAtto.integralScalar Signed
b NumeralSystem
c)

-- | String scalar parser as 'UTCTime' in ISO-8601.
timestampScalar :: Scalar UTCTime
timestampScalar :: Scalar UTCTime
timestampScalar =
  forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
Ex.Iso8601TimestampScalar Parser UTCTime
AsciiAtto.utcTimeInISO8601

-- | String scalar parser as 'Day' in ISO-8601.
dayScalar :: Scalar Day
dayScalar :: Scalar Day
dayScalar =
  forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
Ex.Iso8601DayScalar Parser Day
AsciiAtto.dayInISO8601

-- | String scalar parser as 'TimeOfDay' in ISO-8601.
timeScalar :: Scalar TimeOfDay
timeScalar :: Scalar TimeOfDay
timeScalar =
  forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
Ex.Iso8601TimeScalar Parser TimeOfDay
AsciiAtto.timeOfDayInISO8601

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

-- | String scalar parser as binary data encoded in Base-64.
binaryScalar :: Scalar ByteString
binaryScalar :: Scalar ByteString
binaryScalar =
  forall a. Scalar -> (ByteString -> Either Text a) -> Scalar a
bytesParsingScalar Scalar
Ex.Base64BinaryScalar forall a b. (a -> b) -> a -> b
$ \ByteString
bytes ->
    let bytesWithoutNewlines :: ByteString
bytesWithoutNewlines =
          (Word8 -> Bool) -> ByteString -> ByteString
ByteString.filter (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 ->
            forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
res
          Left AnchorName
err ->
            forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. IsString a => AnchorName -> a
fromString AnchorName
err

-- * --

-- | Mapping value parser.
data Mapping a = Mapping
  { forall a. Mapping a -> Mapping
mappingExpectation :: Ex.Mapping,
    forall a.
Mapping a -> [(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a
mappingParser :: [(Text, Yaml.YamlValue)] -> Yaml.AnchorMap -> Either Err.ErrAtPath a
  }
  deriving (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
<$ :: forall a b. a -> Mapping b -> Mapping a
$c<$ :: forall a b. a -> Mapping b -> Mapping a
fmap :: forall a b. (a -> b) -> Mapping a -> Mapping b
$cfmap :: forall a b. (a -> b) -> Mapping a -> Mapping b
Functor)

-- | Mapping parser which folds pairs into some final data-structure.
foldMapping :: (key -> val -> assoc) -> Fold assoc a -> String key -> Value val -> Mapping a
foldMapping :: forall key val assoc a.
(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 =
  forall a.
Mapping
-> ([(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a)
-> Mapping a
Mapping
    (String -> Value -> Mapping
Ex.MonomorphicMapping (forall a. String a -> String
stringExpectation String key
key) (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 =
      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
        forall a b. a -> (a -> b) -> b
& 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 <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> ErrAtPath
keyErr (forall a. String a -> Text -> Either Text a
stringParser String key
key Text
keyInput)
            val
parsedVal <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> ErrAtPath -> ErrAtPath
Err.atSegment Text
keyInput) (forall a. Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
valueParser Value val
val YamlValue
valInput AnchorMap
anchorMap)
            forall (m :: * -> *) a. Monad m => a -> m a
return 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 []
                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 (forall a. String a -> String
stringExpectation String key
key) Text
keyInput

-- | Mapping parser which allows the user to look up fields and process them with individual parsers.
byKeyMapping :: CaseSensitive -> ByKey Text a -> Mapping a
byKeyMapping :: forall a. CaseSensitive -> ByKey Text a -> Mapping a
byKeyMapping CaseSensitive
caseSensitive ByKey Text a
byKey =
  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 (forall key a. ByKey key a -> ByKey key
byKeyExpectation ByKey Text a
byKey)
    parser :: [(Text, YamlValue)] -> AnchorMap -> Either ErrAtPath a
parser [(Text, YamlValue)]
input =
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Acc Text -> ErrAtPath
keysErr) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT 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 coerce :: forall a b. Coercible a b => a -> b
coerce CaseSensitive
caseSensitive
            then
              let map :: HashMap Text YamlValue
map =
                    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, YamlValue)]
input
                  lookup :: Text -> Maybe YamlValue
lookup Text
k =
                    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 =
                    forall k v. Hashable k => [k] -> HashMap k v -> Maybe (k, v)
HashMap.lookupFirst [Text]
kl HashMap Text YamlValue
map
               in 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 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 =
                    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 =
                    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 =
                    forall k v. Hashable k => [k] -> HashMap k v -> Maybe (k, v)
HashMap.lookupFirst (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
Text.toLower [Text]
kl) HashMap Text YamlValue
map
               in 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 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 []
            forall a b. (a -> b) -> a -> b
$ ByKey Text -> CaseSensitive -> [Text] -> [Text] -> Err
Err.NoneOfMappingKeysFoundErr (forall key a. ByKey key a -> ByKey key
byKeyExpectation ByKey Text a
byKey) CaseSensitive
caseSensitive [Text]
keysAvail (forall l. IsList l => l -> [Item l]
toList Acc Text
keys)
          where
            keysAvail :: [Text]
keysAvail =
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(Text, YamlValue)]
input

-- * --

-- | Sequence value parser.
data Sequence a = Sequence
  { forall a. Sequence a -> Sequence
sequenceExpectation :: Ex.Sequence,
    forall a.
Sequence a -> [YamlValue] -> AnchorMap -> Either ErrAtPath a
sequenceParser :: [Yaml.YamlValue] -> Yaml.AnchorMap -> Either Err.ErrAtPath a
  }
  deriving (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
<$ :: forall a b. a -> Sequence b -> Sequence a
$c<$ :: forall a b. a -> Sequence b -> Sequence a
fmap :: forall a b. (a -> b) -> Sequence a -> Sequence b
$cfmap :: forall a b. (a -> b) -> Sequence a -> Sequence b
Functor)

-- | Homogenous sequence parser which folds into a final data-structure.
foldSequence :: Fold a b -> Value a -> Sequence b
foldSequence :: forall a b. Fold a b -> Value a -> Sequence b
foldSequence (Fold x -> a -> x
foldStep x
foldInit x -> b
foldExtract) Value a
value =
  forall a.
Sequence
-> ([YamlValue] -> AnchorMap -> Either ErrAtPath a) -> Sequence a
Sequence
    (Value -> Sequence
Ex.MonomorphicSequence (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 =
      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
        forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x -> b
foldExtract forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (a, b) -> b
snd)
      where
        step :: (Int, x) -> YamlValue -> Either ErrAtPath (Int, x)
step (!Int
index, !x
state) YamlValue
input =
          forall a. Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
valueParser Value a
value YamlValue
input AnchorMap
anchorMap
            forall a b. a -> (a -> b) -> b
& forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> ErrAtPath -> ErrAtPath
Err.atSegment (forall a. Show a => a -> Text
showAsText Int
index))
            forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (forall a. Enum a => a -> a
succ Int
index, x -> a -> x
foldStep x
state a
a))

-- | Heterogenous sequence parser by order in the sequence, which lets you apply individual parsers to elements.
byOrderSequence :: ByOrder a -> Sequence a
byOrderSequence :: forall a. 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
..}) =
  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 =
      forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (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)
        forall a b. a -> (a -> b) -> b
& forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (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 []
                forall a b. (a -> b) -> a -> b
$ ByOrder -> Int -> Err
Err.NotEnoughElementsErr ByOrder
byOrderExpectation Int
a

-- | Heterogenous sequence parser by index in the sequence, which lets you apply individual parsers to elements.
byKeySequence :: ByKey Int a -> Sequence a
byKeySequence :: forall a. 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
..}) =
  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 =
            forall a. [a] -> Vector a
Vector.fromList [YamlValue]
input
          lookup :: Int -> Maybe YamlValue
lookup Int
k =
            Vector YamlValue
vector forall a. Vector a -> Int -> Maybe a
Vector.!? Int
k
          lookupFirst :: [Int] -> Maybe (Int, YamlValue)
lookupFirst [Int]
kl =
            forall a. [Int] -> Vector a -> Maybe (Int, a)
Vector.lookupFirst [Int]
kl Vector YamlValue
vector
       in \AnchorMap
anchorMap ->
            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 forall a. Show a => a -> Text
showAsText Int -> Maybe YamlValue
lookup [Int] -> Maybe (Int, YamlValue)
lookupFirst AnchorMap
anchorMap)
              forall a b. a -> (a -> b) -> b
& forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (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 []
            forall a b. (a -> b) -> a -> b
$ ByKey Int -> [Int] -> Err
Err.NoneOfSequenceKeysFoundErr ByKey Int
byKeyExpectation (forall l. IsList l => l -> [Item l]
toList Acc Int
keys)

-- * --

-- | String value parser applicable to string scalars and mapping keys.
data String a = String
  { forall a. String a -> String
stringExpectation :: Ex.String,
    forall a. String a -> Text -> Either Text a
stringParser :: Text -> Either Text a
  }
  deriving (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
<$ :: forall a b. a -> String b -> String a
$c<$ :: forall a b. a -> String b -> String a
fmap :: forall a b. (a -> b) -> String a -> String b
$cfmap :: forall a b. (a -> b) -> String a -> String b
Functor)

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

-- | Look the string up as a key in the provided dictionary.
enumString :: CaseSensitive -> [(Text, a)] -> String a
enumString :: forall a. CaseSensitive -> [(Text, a)] -> String a
enumString (CaseSensitive Bool
caseSensitive) [(Text, a)]
assocList =
  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) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(Text, a)]
assocList)
    {-# NOINLINE lookup #-}
    lookup :: Text -> Maybe a
lookup =
      if forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, a)]
assocList forall a. Ord a => a -> a -> Bool
> Int
512
        then
          if Bool
caseSensitive
            then
              let hashMap :: HashMap Text a
hashMap =
                    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, a)]
assocList
               in forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 =
                    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> Text
Text.toLower) [(Text, a)]
assocList)
               in forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup HashMap Text a
hashMap 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 forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup [(Text, a)]
assocList
            else forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> Text
Text.toLower) [(Text, a)]
assocList) 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
        Maybe a
_ -> forall a b. a -> Either a b
Left Text
"Unexpected value"

-- | String parsed using the provided function.
formattedString ::
  -- | Format name for documentation and expectations.
  Text ->
  (Text -> Either Text a) ->
  String a
formattedString :: forall a. Text -> (Text -> Either Text a) -> String a
formattedString Text
format Text -> Either Text a
parser =
  forall a. String -> (Text -> Either Text a) -> String a
String
    (Text -> String
Ex.FormattedString Text
format)
    Text -> Either Text a
parser

-- | String parsed using the provided textual attoparsec parser.
attoparsedString ::
  -- | Format name for documentation and expectations.
  Text ->
  TextAtto.Parser a ->
  String a
attoparsedString :: forall a. Text -> Parser a -> String a
attoparsedString Text
format Parser a
parser =
  forall a. String -> (Text -> Either Text a) -> String a
String
    (Text -> String
Ex.FormattedString Text
format)
    (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. IsString a => AnchorName -> a
fromString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Parser a -> Text -> Either AnchorName a
TextAtto.parseOnly Parser a
parser)

-- * --

-- | General abstraction for specification of parsers performing lookups by keys.
data ByKey key a = ByKey
  { forall key a. ByKey key a -> ByKey key
byKeyExpectation :: Ex.ByKey key,
    forall key a.
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 (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
<$ :: forall a b. a -> ByKey key b -> ByKey key a
$c<$ :: forall key a b. a -> ByKey key b -> ByKey key a
fmap :: forall a b. (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 :: forall a. a -> ByKey key a
pure =
    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 forall key. ByKey key
Ex.AnyByKey forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> b -> a
const forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  <*> :: forall a b. 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) =
    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
      (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 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 :: forall a b.
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) =
    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
      (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 -> forall e (f :: * -> *) a. ExceptT e f a -> ExceptT e f a
Selective.ExceptT.unwrap (forall (f :: * -> *) a b.
Selective f =>
f (Either a b) -> f (a -> b) -> f b
select (forall e (f :: * -> *) a. ExceptT e f a -> ExceptT e f a
Selective.ExceptT.ExceptT ((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)) (forall e (f :: * -> *) a. ExceptT e f a -> ExceptT e f a
Selective.ExceptT.ExceptT ((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 :: forall a. ByKey key a
empty =
    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
      forall key. ByKey key
Ex.NoByKey
      (forall a b. a -> b -> a
const (forall a b. a -> b -> a
const (forall a b. a -> b -> a
const (forall a b. a -> b -> a
const forall (f :: * -> *) a. Alternative f => f a
empty))))
  <|> :: forall a. 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) =
    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
      (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 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)

-- | Parse a value at a key using the provided parser.
atByKey :: key -> Value a -> ByKey key a
atByKey :: forall key a. key -> Value a -> ByKey key a
atByKey key
key Value a
valueSpec =
  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
    (forall key. [key] -> Value -> ByKey key
Ex.LookupByKey [key
key] (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 ->
          forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
            forall a b. (a -> b) -> a -> b
$ 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))
            forall a b. (a -> b) -> a -> b
$ forall a. Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
valueParser Value a
valueSpec YamlValue
val AnchorMap
env
        Maybe YamlValue
Nothing ->
          forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (forall (f :: * -> *) a. Applicative f => a -> f a
pure key
key)

-- | Parse a value at one of keys (whichever exists) using the provided parser.
atOneOfByKey :: [key] -> Value a -> ByKey key a
atOneOfByKey :: forall key a. [key] -> Value a -> ByKey key a
atOneOfByKey [key]
keys Value a
valueSpec =
  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
    (forall key. [key] -> Value -> ByKey key
Ex.LookupByKey [key]
keys (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) ->
          forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
            forall a b. (a -> b) -> a -> b
$ 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))
            forall a b. (a -> b) -> a -> b
$ forall a. Value a -> YamlValue -> AnchorMap -> Either ErrAtPath a
valueParser Value a
valueSpec YamlValue
val AnchorMap
env
        Maybe (key, YamlValue)
Nothing ->
          forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (forall l. IsList l => [Item l] -> l
fromList [key]
keys)

-- * --

data ByOrderErr
  = NotEnoughElementsByOrderErr
      Int

-- | Parser which fetches elements by the order in which it is composed.
data ByOrder a = ByOrder
  { forall a. ByOrder a -> ByOrder
byOrderExpectation :: Ex.ByOrder,
    forall a.
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 (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
<$ :: forall a b. a -> ByOrder b -> ByOrder a
$c<$ :: forall a b. a -> ByOrder b -> ByOrder a
fmap :: forall a b. (a -> b) -> ByOrder a -> ByOrder b
$cfmap :: forall a b. (a -> b) -> ByOrder a -> ByOrder b
Functor)

instance Applicative ByOrder where
  pure :: forall a. a -> ByOrder a
pure =
    forall a.
ByOrder
-> StateT
     (Int, [YamlValue])
     (ReaderT AnchorMap (ExceptT ByOrderErr (Either ErrAtPath)))
     a
-> ByOrder a
ByOrder ByOrder
Ex.AnyByOrder forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  <*> :: forall a b. 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) =
    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 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 :: forall a b. 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) =
    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)
      (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)

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