module YamlUnscrambler
(
parseText,
parseByteString,
getExpectations,
Value,
value,
nullableValue,
sequenceValue,
mappingValue,
scalarsValue,
Scalar,
stringScalar,
nullScalar,
boolScalar,
scientificScalar,
doubleScalar,
rationalScalar,
boundedIntegerScalar,
unboundedIntegerScalar,
timestampScalar,
dayScalar,
timeScalar,
uuidScalar,
binaryScalar,
Mapping,
foldMapping,
byKeyMapping,
Sequence,
foldSequence,
byOrderSequence,
byKeySequence,
String,
textString,
enumString,
formattedString,
attoparsedString,
ByKey,
atByKey,
atOneOfByKey,
ByOrder,
fetchByOrder,
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
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
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
getExpectations :: Value a -> Ex.Value
getExpectations :: forall a. Value a -> Value
getExpectations =
forall a. Value a -> Value
valueExpectation
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)
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)))
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)
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)
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
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
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)
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)
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)
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")
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)
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"
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"
scientificScalar :: Scalar Scientific
scientificScalar :: Scalar Scientific
scientificScalar =
forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
Ex.ScientificScalar Parser Scientific
AsciiAtto.scientific
doubleScalar :: Scalar Double
doubleScalar :: Scalar Double
doubleScalar =
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 =
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
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)
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)
timestampScalar :: Scalar UTCTime
timestampScalar :: Scalar UTCTime
timestampScalar =
forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
Ex.Iso8601TimestampScalar Parser UTCTime
AsciiAtto.utcTimeInISO8601
dayScalar :: Scalar Day
dayScalar :: Scalar Day
dayScalar =
forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
Ex.Iso8601DayScalar Parser Day
AsciiAtto.dayInISO8601
timeScalar :: Scalar TimeOfDay
timeScalar :: Scalar TimeOfDay
timeScalar =
forall a. Scalar -> Parser a -> Scalar a
attoparsedScalar Scalar
Ex.Iso8601TimeScalar Parser TimeOfDay
AsciiAtto.timeOfDayInISO8601
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"
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
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)
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
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
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)
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))
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
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)
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)
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
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"
formattedString ::
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
attoparsedString ::
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)
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)
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)
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
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)
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