{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE Safe                #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Copyright: © Herbert Valerio Riedel 2015-2018
-- SPDX-License-Identifier: GPL-2.0-or-later
--
-- YAML 1.2 Schema resolvers and encoders
--
module Data.YAML.Schema.Internal
    ( SchemaResolver(..)
    , failsafeSchemaResolver
    , jsonSchemaResolver
    , coreSchemaResolver
    , Scalar(..)

    , SchemaEncoder(..)
    , failsafeSchemaEncoder
    , jsonSchemaEncoder
    , coreSchemaEncoder

    , tagNull, tagBool, tagStr, tagInt, tagFloat, tagSeq, tagMap

    , isPlainChar , isAmbiguous, defaultSchemaEncoder, setScalarStyle
    , encodeDouble, encodeBool, encodeInt
    ) where

import qualified Data.Char        as C
import qualified Data.Map         as Map
import qualified Data.Set         as Set
import qualified Data.Text        as T
import           Numeric          (readHex, readOct)
import           Text.Parsec      as P
import           Text.Parsec.Text

import           Data.YAML.Event  (ScalarStyle (..), Tag, isUntagged, mkTag, untagged)
import qualified Data.YAML.Event  as YE

import           Util

-- | Primitive scalar types as defined in YAML 1.2
data Scalar = SNull            -- ^ @tag:yaml.org,2002:null@
            | SBool   !Bool    -- ^ @tag:yaml.org,2002:bool@
            | SFloat  !Double  -- ^ @tag:yaml.org,2002:float@
            | SInt    !Integer -- ^ @tag:yaml.org,2002:int@
            | SStr    !Text    -- ^ @tag:yaml.org,2002:str@

            | SUnknown !Tag !Text -- ^ unknown/unsupported tag or untagged (thus unresolved) scalar
            deriving (Scalar -> Scalar -> Bool
(Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Bool) -> Eq Scalar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scalar -> Scalar -> Bool
== :: Scalar -> Scalar -> Bool
$c/= :: Scalar -> Scalar -> Bool
/= :: Scalar -> Scalar -> Bool
Eq,Eq Scalar
Eq Scalar =>
(Scalar -> Scalar -> Ordering)
-> (Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Scalar)
-> (Scalar -> Scalar -> Scalar)
-> Ord Scalar
Scalar -> Scalar -> Bool
Scalar -> Scalar -> Ordering
Scalar -> Scalar -> Scalar
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Scalar -> Scalar -> Ordering
compare :: Scalar -> Scalar -> Ordering
$c< :: Scalar -> Scalar -> Bool
< :: Scalar -> Scalar -> Bool
$c<= :: Scalar -> Scalar -> Bool
<= :: Scalar -> Scalar -> Bool
$c> :: Scalar -> Scalar -> Bool
> :: Scalar -> Scalar -> Bool
$c>= :: Scalar -> Scalar -> Bool
>= :: Scalar -> Scalar -> Bool
$cmax :: Scalar -> Scalar -> Scalar
max :: Scalar -> Scalar -> Scalar
$cmin :: Scalar -> Scalar -> Scalar
min :: Scalar -> Scalar -> Scalar
Ord,Int -> Scalar -> ShowS
[Scalar] -> ShowS
Scalar -> [Char]
(Int -> Scalar -> ShowS)
-> (Scalar -> [Char]) -> ([Scalar] -> ShowS) -> Show Scalar
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scalar -> ShowS
showsPrec :: Int -> Scalar -> ShowS
$cshow :: Scalar -> [Char]
show :: Scalar -> [Char]
$cshowList :: [Scalar] -> ShowS
showList :: [Scalar] -> ShowS
Show,(forall x. Scalar -> Rep Scalar x)
-> (forall x. Rep Scalar x -> Scalar) -> Generic Scalar
forall x. Rep Scalar x -> Scalar
forall x. Scalar -> Rep Scalar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Scalar -> Rep Scalar x
from :: forall x. Scalar -> Rep Scalar x
$cto :: forall x. Rep Scalar x -> Scalar
to :: forall x. Rep Scalar x -> Scalar
Generic)

-- | @since 0.2.0
instance NFData Scalar where
  rnf :: Scalar -> ()
rnf Scalar
SNull          = ()
  rnf (SBool Bool
_)      = ()
  rnf (SFloat Double
_)     = ()
  rnf (SInt Integer
_)       = ()
  rnf (SStr Text
_)       = ()
  rnf (SUnknown Tag
t Text
_) = Tag -> ()
forall a. NFData a => a -> ()
rnf Tag
t

-- | Definition of a [YAML 1.2 Schema](http://yaml.org/spec/1.2/spec.html#Schema)
--
-- A YAML schema defines how implicit tags are resolved to concrete tags and how data is represented textually in YAML.
data SchemaResolver = SchemaResolver
     { SchemaResolver
-> Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverScalar            :: Tag -> YE.ScalarStyle -> T.Text -> Either String Scalar
     , SchemaResolver -> Tag -> Either [Char] Tag
schemaResolverSequence          :: Tag -> Either String Tag
     , SchemaResolver -> Tag -> Either [Char] Tag
schemaResolverMapping           :: Tag -> Either String Tag
     , SchemaResolver -> Bool
schemaResolverMappingDuplicates :: Bool -- TODO: use something different from 'Bool'
     }


data ScalarTag = ScalarBangTag   -- ^ non-specific ! tag
               | ScalarQMarkTag  -- ^ non-specific ? tag
               | ScalarTag !Tag  -- ^ specific tag

-- common logic for 'schemaResolverScalar'
scalarTag :: (ScalarTag -> T.Text -> Either String Scalar)
             -> Tag -> YE.ScalarStyle -> T.Text -> Either String Scalar
scalarTag :: (ScalarTag -> Text -> Either [Char] Scalar)
-> Tag -> ScalarStyle -> Text -> Either [Char] Scalar
scalarTag ScalarTag -> Text -> Either [Char] Scalar
f Tag
tag ScalarStyle
sty Text
val = ScalarTag -> Text -> Either [Char] Scalar
f ScalarTag
tag' Text
val
  where
    tag' :: ScalarTag
tag' = case ScalarStyle
sty of
             ScalarStyle
YE.Plain
               | Tag
tag Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
untagged -> ScalarTag
ScalarQMarkTag -- implicit ? tag

             ScalarStyle
_ | Tag
tag Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
untagged -> ScalarTag
ScalarBangTag -- implicit ! tag
               | Tag
tag Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagBang  -> ScalarTag
ScalarBangTag -- explicit ! tag
               | Bool
otherwise       -> Tag -> ScalarTag
ScalarTag Tag
tag


-- | \"Failsafe\" schema resolver as specified
-- in [YAML 1.2 / 10.1.2. Tag Resolution](http://yaml.org/spec/1.2/spec.html#id2803036)
failsafeSchemaResolver :: SchemaResolver
failsafeSchemaResolver :: SchemaResolver
failsafeSchemaResolver = SchemaResolver{Bool
Tag -> Either [Char] Tag
Tag -> ScalarStyle -> Text -> Either [Char] Scalar
forall {a}. Tag -> Either a Tag
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverSequence :: Tag -> Either [Char] Tag
schemaResolverMapping :: Tag -> Either [Char] Tag
schemaResolverMappingDuplicates :: Bool
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverMapping :: forall {a}. Tag -> Either a Tag
schemaResolverMappingDuplicates :: Bool
schemaResolverSequence :: forall {a}. Tag -> Either a Tag
..}
  where
    -- scalars
    schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverScalar = (ScalarTag -> Text -> Either [Char] Scalar)
-> Tag -> ScalarStyle -> Text -> Either [Char] Scalar
scalarTag ScalarTag -> Text -> Either [Char] Scalar
forall {a}. ScalarTag -> Text -> Either a Scalar
go
      where
        go :: ScalarTag -> Text -> Either a Scalar
go ScalarTag
ScalarBangTag  Text
v = Scalar -> Either a Scalar
forall a b. b -> Either a b
Right (Text -> Scalar
SStr Text
v)
        go (ScalarTag Tag
t)  Text
v
          | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagStr     = Scalar -> Either a Scalar
forall a b. b -> Either a b
Right (Text -> Scalar
SStr Text
v)
          | Bool
otherwise       = Scalar -> Either a Scalar
forall a b. b -> Either a b
Right (Tag -> Text -> Scalar
SUnknown Tag
t Text
v)
        go ScalarTag
ScalarQMarkTag Text
v = Scalar -> Either a Scalar
forall a b. b -> Either a b
Right (Tag -> Text -> Scalar
SUnknown Tag
untagged Text
v) -- leave unresolved

    -- mappings
    schemaResolverMapping :: Tag -> Either a Tag
schemaResolverMapping Tag
t
      | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagBang = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
tagMap
      | Bool
otherwise    = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
t

    schemaResolverMappingDuplicates :: Bool
schemaResolverMappingDuplicates = Bool
False

    -- sequences
    schemaResolverSequence :: Tag -> Either a Tag
schemaResolverSequence Tag
t
      | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagBang = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
tagSeq
      | Bool
otherwise    = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
t

-- | Strict JSON schema resolver as specified
-- in [YAML 1.2 / 10.2.2. Tag Resolution](http://yaml.org/spec/1.2/spec.html#id2804356)
jsonSchemaResolver :: SchemaResolver
jsonSchemaResolver :: SchemaResolver
jsonSchemaResolver = SchemaResolver{Bool
Tag -> Either [Char] Tag
Tag -> ScalarStyle -> Text -> Either [Char] Scalar
forall {a}. Tag -> Either a Tag
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverSequence :: Tag -> Either [Char] Tag
schemaResolverMapping :: Tag -> Either [Char] Tag
schemaResolverMappingDuplicates :: Bool
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverMapping :: forall {a}. Tag -> Either a Tag
schemaResolverMappingDuplicates :: Bool
schemaResolverSequence :: forall {a}. Tag -> Either a Tag
..}
  where
    -- scalars
    schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverScalar = (ScalarTag -> Text -> Either [Char] Scalar)
-> Tag -> ScalarStyle -> Text -> Either [Char] Scalar
scalarTag ScalarTag -> Text -> Either [Char] Scalar
go
      where
        go :: ScalarTag -> Text -> Either [Char] Scalar
go ScalarTag
ScalarBangTag  Text
v = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Text -> Scalar
SStr Text
v)
        go (ScalarTag Tag
t)  Text
v
          | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagStr     = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Text -> Scalar
SStr Text
v)
          | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagNull  = if Text -> Bool
isNullLiteral Text
v then Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right Scalar
SNull else [Char] -> Either [Char] Scalar
forall a b. a -> Either a b
Left ([Char]
"invalid !!null " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
v)
          | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagInt   = Either [Char] Scalar
-> (Integer -> Either [Char] Scalar)
-> Maybe Integer
-> Either [Char] Scalar
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] Scalar
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Scalar) -> [Char] -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid !!int " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
v)   (Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Scalar -> Either [Char] Scalar)
-> (Integer -> Scalar) -> Integer -> Either [Char] Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt)   (Maybe Integer -> Either [Char] Scalar)
-> Maybe Integer -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Integer
jsonDecodeInt   Text
v
          | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagFloat = Either [Char] Scalar
-> (Double -> Either [Char] Scalar)
-> Maybe Double
-> Either [Char] Scalar
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] Scalar
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Scalar) -> [Char] -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid !!float " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
v) (Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Scalar -> Either [Char] Scalar)
-> (Double -> Scalar) -> Double -> Either [Char] Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Scalar
SFloat) (Maybe Double -> Either [Char] Scalar)
-> Maybe Double -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Double
jsonDecodeFloat Text
v
          | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagBool  = Either [Char] Scalar
-> (Bool -> Either [Char] Scalar)
-> Maybe Bool
-> Either [Char] Scalar
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] Scalar
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Scalar) -> [Char] -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid !!bool " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
v)  (Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Scalar -> Either [Char] Scalar)
-> (Bool -> Scalar) -> Bool -> Either [Char] Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Scalar
SBool)  (Maybe Bool -> Either [Char] Scalar)
-> Maybe Bool -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Bool
jsonDecodeBool  Text
v
          | Bool
otherwise       = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Tag -> Text -> Scalar
SUnknown Tag
t Text
v) -- unknown specific tag
        go ScalarTag
ScalarQMarkTag Text
v
          | Text -> Bool
isNullLiteral Text
v             = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right Scalar
SNull
          | Just Bool
b <- Text -> Maybe Bool
jsonDecodeBool  Text
v = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Scalar -> Either [Char] Scalar) -> Scalar -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$! Bool -> Scalar
SBool Bool
b
          | Just Integer
i <- Text -> Maybe Integer
jsonDecodeInt   Text
v = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Scalar -> Either [Char] Scalar) -> Scalar -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$! Integer -> Scalar
SInt Integer
i
          | Just Double
f <- Text -> Maybe Double
jsonDecodeFloat Text
v = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Scalar -> Either [Char] Scalar) -> Scalar -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$! Double -> Scalar
SFloat Double
f
          | Bool
otherwise = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Tag -> Text -> Scalar
SUnknown Tag
untagged Text
v) -- leave unresolved  -- FIXME: YAML 1.2 spec requires an error here

    isNullLiteral :: Text -> Bool
isNullLiteral = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"null")

    -- mappings
    schemaResolverMapping :: Tag -> Either a Tag
schemaResolverMapping Tag
t
      | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagBang = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
tagMap
      | Tag -> Bool
isUntagged Tag
t = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
tagMap
      | Bool
otherwise    = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
t

    schemaResolverMappingDuplicates :: Bool
schemaResolverMappingDuplicates = Bool
False

    -- sequences
    schemaResolverSequence :: Tag -> Either a Tag
schemaResolverSequence Tag
t
      | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagBang = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
tagSeq
      | Tag -> Bool
isUntagged Tag
t = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
tagSeq
      | Bool
otherwise    = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
t

-- | Core schema resolver as specified
-- in [YAML 1.2 / 10.3.2. Tag Resolution](http://yaml.org/spec/1.2/spec.html#id2805071)
coreSchemaResolver :: SchemaResolver
coreSchemaResolver :: SchemaResolver
coreSchemaResolver = SchemaResolver{Bool
Tag -> Either [Char] Tag
Tag -> ScalarStyle -> Text -> Either [Char] Scalar
forall {a}. Tag -> Either a Tag
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverSequence :: Tag -> Either [Char] Tag
schemaResolverMapping :: Tag -> Either [Char] Tag
schemaResolverMappingDuplicates :: Bool
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverMapping :: forall {a}. Tag -> Either a Tag
schemaResolverMappingDuplicates :: Bool
schemaResolverSequence :: forall {a}. Tag -> Either a Tag
..}
  where
    -- scalars
    schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverScalar = (ScalarTag -> Text -> Either [Char] Scalar)
-> Tag -> ScalarStyle -> Text -> Either [Char] Scalar
scalarTag ScalarTag -> Text -> Either [Char] Scalar
go
      where
        go :: ScalarTag -> Text -> Either [Char] Scalar
go ScalarTag
ScalarBangTag  Text
v = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Text -> Scalar
SStr Text
v)
        go (ScalarTag Tag
t)  Text
v
          | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagStr     = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Text -> Scalar
SStr Text
v)
          | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagNull  = if Text -> Bool
isNullLiteral Text
v then Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right Scalar
SNull else [Char] -> Either [Char] Scalar
forall a b. a -> Either a b
Left ([Char]
"invalid !!null " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
v)
          | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagInt   = Either [Char] Scalar
-> (Integer -> Either [Char] Scalar)
-> Maybe Integer
-> Either [Char] Scalar
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] Scalar
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Scalar) -> [Char] -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid !!int " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
v)   (Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Scalar -> Either [Char] Scalar)
-> (Integer -> Scalar) -> Integer -> Either [Char] Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt)   (Maybe Integer -> Either [Char] Scalar)
-> Maybe Integer -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Integer
coreDecodeInt   Text
v
          | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagFloat = Either [Char] Scalar
-> (Double -> Either [Char] Scalar)
-> Maybe Double
-> Either [Char] Scalar
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] Scalar
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Scalar) -> [Char] -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid !!float " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
v) (Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Scalar -> Either [Char] Scalar)
-> (Double -> Scalar) -> Double -> Either [Char] Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Scalar
SFloat) (Maybe Double -> Either [Char] Scalar)
-> Maybe Double -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Double
coreDecodeFloat Text
v
          | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagBool  = Either [Char] Scalar
-> (Bool -> Either [Char] Scalar)
-> Maybe Bool
-> Either [Char] Scalar
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] Scalar
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Scalar) -> [Char] -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid !!bool " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
v)  (Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Scalar -> Either [Char] Scalar)
-> (Bool -> Scalar) -> Bool -> Either [Char] Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Scalar
SBool)  (Maybe Bool -> Either [Char] Scalar)
-> Maybe Bool -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Bool
coreDecodeBool  Text
v
          | Bool
otherwise       = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Tag -> Text -> Scalar
SUnknown Tag
t Text
v) -- unknown specific tag
        go ScalarTag
ScalarQMarkTag Text
v
          | Text -> Bool
isNullLiteral Text
v             = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right Scalar
SNull
          | Just Bool
b <- Text -> Maybe Bool
coreDecodeBool  Text
v = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Scalar -> Either [Char] Scalar) -> Scalar -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$! Bool -> Scalar
SBool Bool
b
          | Just Integer
i <- Text -> Maybe Integer
coreDecodeInt   Text
v = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Scalar -> Either [Char] Scalar) -> Scalar -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$! Integer -> Scalar
SInt Integer
i
          | Just Double
f <- Text -> Maybe Double
coreDecodeFloat Text
v = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Scalar -> Either [Char] Scalar) -> Scalar -> Either [Char] Scalar
forall a b. (a -> b) -> a -> b
$! Double -> Scalar
SFloat Double
f
          | Bool
otherwise = Scalar -> Either [Char] Scalar
forall a b. b -> Either a b
Right (Text -> Scalar
SStr Text
v) -- map to !!str by default

    isNullLiteral :: Text -> Bool
isNullLiteral = (Text -> Set Text -> Bool) -> Set Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [ Text
"", Text
"null", Text
"NULL", Text
"Null", Text
"~" ])

    -- mappings
    schemaResolverMapping :: Tag -> Either a Tag
schemaResolverMapping Tag
t
      | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagBang = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
tagMap
      | Tag -> Bool
isUntagged Tag
t = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
tagMap
      | Bool
otherwise    = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
t

    schemaResolverMappingDuplicates :: Bool
schemaResolverMappingDuplicates = Bool
False

    -- sequences
    schemaResolverSequence :: Tag -> Either a Tag
schemaResolverSequence Tag
t
      | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagBang = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
tagSeq
      | Tag -> Bool
isUntagged Tag
t = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
tagSeq
      | Bool
otherwise    = Tag -> Either a Tag
forall a b. b -> Either a b
Right Tag
t


-- | @tag:yaml.org,2002:bool@ (JSON Schema)
jsonDecodeBool :: T.Text -> Maybe Bool
jsonDecodeBool :: Text -> Maybe Bool
jsonDecodeBool Text
"false" = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
jsonDecodeBool Text
"true"  = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
jsonDecodeBool Text
_       = Maybe Bool
forall a. Maybe a
Nothing

-- | @tag:yaml.org,2002:bool@ (Core Schema)
coreDecodeBool :: T.Text -> Maybe Bool
coreDecodeBool :: Text -> Maybe Bool
coreDecodeBool = (Text -> Map Text Bool -> Maybe Bool)
-> Map Text Bool -> Text -> Maybe Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Map Text Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Map Text Bool -> Text -> Maybe Bool)
-> Map Text Bool -> Text -> Maybe Bool
forall a b. (a -> b) -> a -> b
$
  [(Text, Bool)] -> Map Text Bool
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Text
"true", Bool
True)
               , (Text
"True", Bool
True)
               , (Text
"TRUE", Bool
True)
               , (Text
"false", Bool
False)
               , (Text
"False", Bool
False)
               , (Text
"FALSE", Bool
False)
               ]

-- | @tag:yaml.org,2002:int@ according to JSON Schema
--
-- > 0 | -? [1-9] [0-9]*
jsonDecodeInt  :: T.Text -> Maybe Integer
jsonDecodeInt :: Text -> Maybe Integer
jsonDecodeInt Text
t | Text -> Bool
T.null Text
t = Maybe Integer
forall a. Maybe a
Nothing
jsonDecodeInt Text
"0" = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
jsonDecodeInt Text
t = do
  -- [-]? [1-9] [0-9]*
  let tabs :: Text
tabs | Text -> Text -> Bool
T.isPrefixOf Text
"-" Text
t = HasCallStack => Text -> Text
Text -> Text
T.tail Text
t
           | Bool
otherwise          = Text
t

  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Text -> Bool
T.null Text
tabs))
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (HasCallStack => Text -> Char
Text -> Char
T.head Text
tabs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'0')
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
C.isDigit Text
tabs)

  [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
t)

-- | @tag:yaml.org,2002:int@ according to Core Schema
--
-- > [-+]? [0-9]+         (Base 10)
-- > 0o [0-7]+            (Base 8)
-- > 0x [0-9a-fA-F]+      (Base 16)
--
coreDecodeInt :: T.Text -> Maybe Integer
coreDecodeInt :: Text -> Maybe Integer
coreDecodeInt Text
t
  | Text -> Bool
T.null Text
t = Maybe Integer
forall a. Maybe a
Nothing

  -- > 0x [0-9a-fA-F]+      (Base 16)
  | Just Text
rest <- Text -> Text -> Maybe Text
T.stripPrefix Text
"0x" Text
t
  , (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
C.isHexDigit Text
rest
  , [(Integer
j,[Char]
"")] <- ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readHex (Text -> [Char]
T.unpack Text
rest)
  = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$! Integer
j

  -- 0o [0-7]+            (Base 8)
  | Just Text
rest <- Text -> Text -> Maybe Text
T.stripPrefix Text
"0o" Text
t
  , (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
C.isOctDigit Text
rest
  , [(Integer
j,[Char]
"")] <- ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readOct (Text -> [Char]
T.unpack Text
rest)
  = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$! Integer
j

  -- [-+]? [0-9]+         (Base 10)
  | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
C.isDigit Text
t
  = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$! [Char] -> Integer
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
t)

  | Just Text
rest <- Text -> Text -> Maybe Text
T.stripPrefix Text
"+" Text
t
  , Bool -> Bool
not (Text -> Bool
T.null Text
rest)
  , (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
C.isDigit Text
rest
  = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$! [Char] -> Integer
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
rest)

  | Just Text
rest <- Text -> Text -> Maybe Text
T.stripPrefix Text
"-" Text
t
  , Bool -> Bool
not (Text -> Bool
T.null Text
rest)
  , (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
C.isDigit Text
rest
  = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$! [Char] -> Integer
forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
t)

  | Bool
otherwise = Maybe Integer
forall a. Maybe a
Nothing


-- | @tag:yaml.org,2002:float@ according to JSON Schema
--
-- > -? ( 0 | [1-9] [0-9]* ) ( \. [0-9]* )? ( [eE] [-+]? [0-9]+ )?
--
jsonDecodeFloat :: T.Text -> Maybe Double
jsonDecodeFloat :: Text -> Maybe Double
jsonDecodeFloat = (ParseError -> Maybe Double)
-> (Double -> Maybe Double)
-> Either ParseError Double
-> Maybe Double
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Double -> ParseError -> Maybe Double
forall a b. a -> b -> a
const Maybe Double
forall a. Maybe a
Nothing) Double -> Maybe Double
forall a. a -> Maybe a
Just (Either ParseError Double -> Maybe Double)
-> (Text -> Either ParseError Double) -> Text -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Text () Double -> [Char] -> Text -> Either ParseError Double
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse Parsec Text () Double
float [Char]
""
  where
    float :: Parser Double
    float :: Parsec Text () Double
float = do
      -- -?
      [Char]
p0 <- [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" ([Char]
"-" [Char]
-> ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')

      -- ( 0 | [1-9] [0-9]* )
      [Char]
p1 <- do
        Char
d <- ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
        if (Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'0')
          then (Char
dChar -> ShowS
forall a. a -> [a] -> [a]
:) ShowS
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
          else [Char] -> ParsecT Text () Identity [Char]
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char
d]

      -- ( \. [0-9]* )?
      [Char]
p2 <- [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" (ParsecT Text () Identity [Char]
 -> ParsecT Text () Identity [Char])
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall a b. (a -> b) -> a -> b
$ (:) (Char -> ShowS)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT Text () Identity ShowS
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"0" (ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)

      -- ( [eE] [-+]? [0-9]+ )?
      [Char]
p3 <- [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" (ParsecT Text () Identity [Char]
 -> ParsecT Text () Identity [Char])
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall a b. (a -> b) -> a -> b
$ do
        ParsecT Text () Identity Char -> ParsecT Text () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'E')
        [Char]
s <- [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" (([Char]
"-" [Char]
-> ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-') ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> ([Char]
"" [Char]
-> ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'))
        [Char]
d <- ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

        [Char] -> ParsecT Text () Identity [Char]
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
"e" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
d)

      ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

      let t' :: [Char]
t' = [Char]
p0[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
p1[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
p2[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
p3
      Double -> Parsec Text () Double
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Parsec Text () Double)
-> Double -> Parsec Text () Double
forall a b. (a -> b) -> a -> b
$! [Char] -> Double
forall a. Read a => [Char] -> a
read [Char]
t'

-- | @tag:yaml.org,2002:float@ according to Core Schema
--
-- > [-+]? ( \. [0-9]+ | [0-9]+ ( \. [0-9]* )? ) ( [eE] [-+]? [0-9]+ )?
--
coreDecodeFloat :: T.Text -> Maybe Double
coreDecodeFloat :: Text -> Maybe Double
coreDecodeFloat Text
t
  | Just Double
j <- Text -> Map Text Double -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
t Map Text Double
literals = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
j -- short-cut
  | Bool
otherwise = (ParseError -> Maybe Double)
-> (Double -> Maybe Double)
-> Either ParseError Double
-> Maybe Double
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Double -> ParseError -> Maybe Double
forall a b. a -> b -> a
const Maybe Double
forall a. Maybe a
Nothing) Double -> Maybe Double
forall a. a -> Maybe a
Just (Either ParseError Double -> Maybe Double)
-> (Text -> Either ParseError Double) -> Text -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Text () Double -> [Char] -> Text -> Either ParseError Double
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse Parsec Text () Double
float [Char]
"" (Text -> Maybe Double) -> Text -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Text
t
  where
    float :: Parser Double
    float :: Parsec Text () Double
float = do
      -- [-+]?
      [Char]
p0 <- [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" (([Char]
"-" [Char]
-> ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-') ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> [Char]
"" [Char]
-> ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+')

      -- ( \. [0-9]+ | [0-9]+ ( \. [0-9]* )? )
      [Char]
p1 <- (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT Text () Identity Char
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (([Char]
"0."[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit))
            ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> do [Char]
d1  <- ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
                     [Char]
d2  <- [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" (ParsecT Text () Identity [Char]
 -> ParsecT Text () Identity [Char])
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall a b. (a -> b) -> a -> b
$ (:) (Char -> ShowS)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' ParsecT Text () Identity ShowS
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall a b.
ParsecT Text () Identity (a -> b)
-> ParsecT Text () Identity a -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"0" (ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)
                     [Char] -> ParsecT Text () Identity [Char]
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
d1[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
d2)

      -- ( [eE] [-+]? [0-9]+ )?
      [Char]
p2 <- [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" (ParsecT Text () Identity [Char]
 -> ParsecT Text () Identity [Char])
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall a b. (a -> b) -> a -> b
$ do
        ParsecT Text () Identity Char -> ParsecT Text () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'E')
        [Char]
s <- [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" (([Char]
"-" [Char]
-> ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-') ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
-> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> ([Char]
"" [Char]
-> ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall a b.
a -> ParsecT Text () Identity b -> ParsecT Text () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'))
        [Char]
d <- ParsecT Text () Identity Char -> ParsecT Text () Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

        [Char] -> ParsecT Text () Identity [Char]
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
"e" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
d)

      ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

      let t' :: [Char]
t' = [Char]
p0[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
p1[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
p2

      Double -> Parsec Text () Double
forall a. a -> ParsecT Text () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Parsec Text () Double)
-> Double -> Parsec Text () Double
forall a b. (a -> b) -> a -> b
$! [Char] -> Double
forall a. Read a => [Char] -> a
read [Char]
t'

    literals :: Map Text Double
literals = [(Text, Double)] -> Map Text Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (Text
"0"   , Double
0)

      , (Text
".nan", (Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0))
      , (Text
".NaN", (Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0))
      , (Text
".NAN", (Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0))

      , (Text
".inf", (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0))
      , (Text
".Inf", (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0))
      , (Text
".INF", (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0))

      , (Text
"+.inf", (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0))
      , (Text
"+.Inf", (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0))
      , (Text
"+.INF", (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0))

      , (Text
"-.inf", (-Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0))
      , (Text
"-.Inf", (-Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0))
      , (Text
"-.INF", (-Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0))
      ]

-- | Some tags specified in YAML 1.2
tagNull, tagBool, tagStr, tagInt, tagFloat, tagSeq, tagMap, tagBang :: Tag
tagNull :: Tag
tagNull  = [Char] -> Tag
mkTag [Char]
"tag:yaml.org,2002:null"
tagStr :: Tag
tagStr   = [Char] -> Tag
mkTag [Char]
"tag:yaml.org,2002:str"
tagInt :: Tag
tagInt   = [Char] -> Tag
mkTag [Char]
"tag:yaml.org,2002:int"
tagFloat :: Tag
tagFloat = [Char] -> Tag
mkTag [Char]
"tag:yaml.org,2002:float"
tagBool :: Tag
tagBool  = [Char] -> Tag
mkTag [Char]
"tag:yaml.org,2002:bool"
tagSeq :: Tag
tagSeq   = [Char] -> Tag
mkTag [Char]
"tag:yaml.org,2002:seq"
tagMap :: Tag
tagMap   = [Char] -> Tag
mkTag [Char]
"tag:yaml.org,2002:map"
tagBang :: Tag
tagBang  = [Char] -> Tag
mkTag [Char]
"!"


-- | @since 0.2.0
data SchemaEncoder = SchemaEncoder
    { SchemaEncoder -> Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderScalar   :: Scalar -> Either String (Tag, ScalarStyle, T.Text)
    , SchemaEncoder -> Tag -> Either [Char] Tag
schemaEncoderSequence :: Tag -> Either String Tag
    , SchemaEncoder -> Tag -> Either [Char] Tag
schemaEncoderMapping  :: Tag -> Either String Tag
    }

mappingTag :: Tag -> Either String Tag
mappingTag :: Tag -> Either [Char] Tag
mappingTag Tag
t
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagMap  = Tag -> Either [Char] Tag
forall a b. b -> Either a b
Right Tag
untagged
  | Bool
otherwise    = Tag -> Either [Char] Tag
forall a b. b -> Either a b
Right Tag
t

seqTag :: Tag -> Either String Tag
seqTag :: Tag -> Either [Char] Tag
seqTag Tag
t
  | Tag
t Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
tagSeq  = Tag -> Either [Char] Tag
forall a b. b -> Either a b
Right Tag
untagged
  | Bool
otherwise    = Tag -> Either [Char] Tag
forall a b. b -> Either a b
Right Tag
t


-- | \"Failsafe\" schema encoder as specified
-- in [YAML 1.2 / 10.1.2. Tag Resolution](http://yaml.org/spec/1.2/spec.html#id2803036)
--
-- @since 0.2.0
failsafeSchemaEncoder :: SchemaEncoder
failsafeSchemaEncoder :: SchemaEncoder
failsafeSchemaEncoder = SchemaEncoder{Tag -> Either [Char] Tag
Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderSequence :: Tag -> Either [Char] Tag
schemaEncoderMapping :: Tag -> Either [Char] Tag
schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderMapping :: Tag -> Either [Char] Tag
schemaEncoderSequence :: Tag -> Either [Char] Tag
..}
  where

    schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderScalar Scalar
s = case Scalar
s of
      Scalar
SNull        -> [Char] -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. a -> Either a b
Left  [Char]
"SNull scalar type not supported in failsafeSchemaEncoder"
      SBool  Bool
_     -> [Char] -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. a -> Either a b
Left  [Char]
"SBool scalar type not supported in failsafeSchemaEncoder"
      SFloat Double
_     -> [Char] -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. a -> Either a b
Left  [Char]
"SFloat scalar type not supported in failsafeSchemaEncoder"
      SInt   Integer
_     -> [Char] -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. a -> Either a b
Left  [Char]
"SInt scalar type not supported in failsafeSchemaEncoder"
      SStr   Text
text  -> Text -> Either [Char] (Tag, ScalarStyle, Text)
failEncodeStr Text
text
      SUnknown Tag
t Text
v -> (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
t, ScalarStyle
DoubleQuoted, Text
v)

    schemaEncoderMapping :: Tag -> Either [Char] Tag
schemaEncoderMapping  = Tag -> Either [Char] Tag
mappingTag
    schemaEncoderSequence :: Tag -> Either [Char] Tag
schemaEncoderSequence = Tag -> Either [Char] Tag
seqTag

-- | Strict JSON schema encoder as specified
-- in [YAML 1.2 / 10.2.2. Tag Resolution](http://yaml.org/spec/1.2/spec.html#id2804356)
--
-- @since 0.2.0
jsonSchemaEncoder :: SchemaEncoder
jsonSchemaEncoder :: SchemaEncoder
jsonSchemaEncoder = SchemaEncoder{Tag -> Either [Char] Tag
Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderSequence :: Tag -> Either [Char] Tag
schemaEncoderMapping :: Tag -> Either [Char] Tag
schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderMapping :: Tag -> Either [Char] Tag
schemaEncoderSequence :: Tag -> Either [Char] Tag
..}
  where

    schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderScalar Scalar
s = case Scalar
s of
      Scalar
SNull         -> (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Text
"null")
      SBool  Bool
bool   -> (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Bool -> Text
encodeBool Bool
bool)
      SFloat Double
double -> (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Double -> Text
encodeDouble Double
double)
      SInt   Integer
int    -> (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Integer -> Text
encodeInt Integer
int)
      SStr   Text
text   -> Text -> Either [Char] (Tag, ScalarStyle, Text)
jsonEncodeStr Text
text
      SUnknown Tag
_ Text
_  -> [Char] -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. a -> Either a b
Left  [Char]
"SUnknown scalar type not supported in jsonSchemaEncoder"

    schemaEncoderMapping :: Tag -> Either [Char] Tag
schemaEncoderMapping  = Tag -> Either [Char] Tag
mappingTag
    schemaEncoderSequence :: Tag -> Either [Char] Tag
schemaEncoderSequence = Tag -> Either [Char] Tag
seqTag

-- | Core schema encoder as specified
-- in [YAML 1.2 / 10.3.2. Tag Resolution](http://yaml.org/spec/1.2/spec.html#id2805071)
--
-- @since 0.2.0
coreSchemaEncoder :: SchemaEncoder
coreSchemaEncoder :: SchemaEncoder
coreSchemaEncoder = SchemaEncoder{Tag -> Either [Char] Tag
Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderSequence :: Tag -> Either [Char] Tag
schemaEncoderMapping :: Tag -> Either [Char] Tag
schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderMapping :: Tag -> Either [Char] Tag
schemaEncoderSequence :: Tag -> Either [Char] Tag
..}
  where

    schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderScalar Scalar
s = case Scalar
s of
      Scalar
SNull         -> (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Text
"null")
      SBool  Bool
bool   -> (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Bool -> Text
encodeBool Bool
bool)
      SFloat Double
double -> (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Double -> Text
encodeDouble Double
double)
      SInt   Integer
int    -> (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Integer -> Text
encodeInt Integer
int)
      SStr   Text
text   -> Text -> Either [Char] (Tag, ScalarStyle, Text)
coreEncodeStr Text
text
      SUnknown Tag
t Text
v  -> (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
t, ScalarStyle
DoubleQuoted, Text
v)

    schemaEncoderMapping :: Tag -> Either [Char] Tag
schemaEncoderMapping  = Tag -> Either [Char] Tag
mappingTag
    schemaEncoderSequence :: Tag -> Either [Char] Tag
schemaEncoderSequence = Tag -> Either [Char] Tag
seqTag

-- | Encode Boolean
--
-- @since 0.2.0
encodeBool :: Bool -> T.Text
encodeBool :: Bool -> Text
encodeBool Bool
b = if Bool
b then Text
"true" else Text
"false"

-- | Encode Double
--
-- @since 0.2.0
encodeDouble :: Double -> T.Text
encodeDouble :: Double -> Text
encodeDouble Double
d
  | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
d      = Text
".nan"
  | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0)  = Text
".inf"
  | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== (-Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0) = Text
"-.inf"
  | Bool
otherwise   = [Char] -> Text
T.pack ([Char] -> Text) -> (Double -> [Char]) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [Char]
forall a. Show a => a -> [Char]
show (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Double
d

-- | Encode Integer
--
-- @since 0.2.0
encodeInt :: Integer -> T.Text
encodeInt :: Integer -> Text
encodeInt = [Char] -> Text
T.pack ([Char] -> Text) -> (Integer -> [Char]) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Char]
forall a. Show a => a -> [Char]
show


failEncodeStr :: T.Text -> Either String (Tag, ScalarStyle, T.Text)
failEncodeStr :: Text -> Either [Char] (Tag, ScalarStyle, Text)
failEncodeStr Text
t
  | Text -> Text -> Bool
T.isPrefixOf Text
" " Text
t               = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | HasCallStack => Text -> Char
Text -> Char
T.last Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '                  = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | (Char -> Bool) -> Text -> Bool
T.any (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isPlainChar) Text
t       = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | Bool
otherwise                        = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Text
t)

jsonEncodeStr :: T.Text -> Either String (Tag, ScalarStyle, T.Text)
jsonEncodeStr :: Text -> Either [Char] (Tag, ScalarStyle, Text)
jsonEncodeStr Text
t
  | Text -> Bool
T.null Text
t                         = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | Text -> Text -> Bool
T.isPrefixOf Text
" " Text
t               = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | HasCallStack => Text -> Char
Text -> Char
T.last Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '                  = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | (Char -> Bool) -> Text -> Bool
T.any (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isPlainChar) Text
t       = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | SchemaResolver -> Text -> Bool
isAmbiguous SchemaResolver
jsonSchemaResolver Text
t = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | Bool
otherwise                        = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Text
t)

coreEncodeStr :: T.Text -> Either String (Tag, ScalarStyle, T.Text)
coreEncodeStr :: Text -> Either [Char] (Tag, ScalarStyle, Text)
coreEncodeStr Text
t
  | Text -> Bool
T.null Text
t                         = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | Text -> Text -> Bool
T.isPrefixOf Text
" " Text
t               = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | HasCallStack => Text -> Char
Text -> Char
T.last Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '                  = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | (Char -> Bool) -> Text -> Bool
T.any (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isPlainChar) Text
t       = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | SchemaResolver -> Text -> Bool
isAmbiguous SchemaResolver
coreSchemaResolver Text
t = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | Bool
otherwise                        = (Tag, ScalarStyle, Text) -> Either [Char] (Tag, ScalarStyle, Text)
forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Text
t)

-- | These are some characters which can be used in 'Plain' 'Scalar's safely without any quotes (see <https://yaml.org/spec/1.2/spec.html#c-indicator Indicator Characters>).
--
-- __NOTE__: This does not mean that other characters (like @"\\n"@ and other special characters like @"-?:,[]{}#&*!,>%\@`\"\'"@) cannot be used in 'Plain' 'Scalar's.
--
-- @since 0.2.0
isPlainChar :: Char -> Bool
isPlainChar :: Char -> Bool
isPlainChar Char
c = Char -> Bool
C.isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
" ~$^+=</;._\\" :: String)  -- not $ c `elem` "\n-?:,[]{}#&*!,>%@`\\'\""

-- | Returns True if the string can be decoded by the given 'SchemaResolver'
-- into a 'Scalar' which is not a of type 'SStr'.
--
-- >>> isAmbiguous coreSchemaResolver "true"
-- True
--
-- >>> isAmbiguous failSchemaResolver "true"
-- False
--
-- @since 0.2.0
isAmbiguous :: SchemaResolver -> T.Text -> Bool
isAmbiguous :: SchemaResolver -> Text -> Bool
isAmbiguous SchemaResolver{Bool
Tag -> Either [Char] Tag
Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverScalar :: SchemaResolver
-> Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverSequence :: SchemaResolver -> Tag -> Either [Char] Tag
schemaResolverMapping :: SchemaResolver -> Tag -> Either [Char] Tag
schemaResolverMappingDuplicates :: SchemaResolver -> Bool
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverSequence :: Tag -> Either [Char] Tag
schemaResolverMapping :: Tag -> Either [Char] Tag
schemaResolverMappingDuplicates :: Bool
..} Text
t = case Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverScalar Tag
untagged ScalarStyle
Plain Text
t of
  Left [Char]
err        -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
err
  Right (SStr Text
_ ) -> Bool
False
  Right Scalar
_         -> Bool
True

-- | According to YAML 1.2 'coreSchemaEncoder' is the default 'SchemaEncoder'
--
-- By default, 'Scalar's are encoded as follows:
--
-- * String which are made of Plain Characters (see 'isPlainChar'), unambiguous (see 'isAmbiguous') and do not contain any leading/trailing spaces are encoded as 'Plain' 'Scalar'.
--
-- * Rest of the strings are encoded in DoubleQuotes
--
-- * Booleans are encoded using 'encodeBool'
--
-- * Double values are encoded using 'encodeDouble'
--
-- * Integral values are encoded using 'encodeInt'
--
-- @since 0.2.0
defaultSchemaEncoder :: SchemaEncoder
defaultSchemaEncoder :: SchemaEncoder
defaultSchemaEncoder = SchemaEncoder
coreSchemaEncoder

-- | Set the 'Scalar' style in the encoded YAML. This is a function that decides
-- for each 'Scalar' the type of YAML string to output.
--
-- __WARNING__: You must ensure that special strings (like @"true"@\/@"false"@\/@"null"@\/@"1234"@) are not encoded with the 'Plain' style, because
-- then they will be decoded as boolean, null or numeric values. You can use 'isAmbiguous' to detect them.
--
-- __NOTE__: For different 'SchemaResolver's, different strings are ambiguous. For example, @"true"@ is not ambiguous for 'failsafeSchemaResolver'.
--
-- @since 0.2.0
setScalarStyle :: (Scalar -> Either String (Tag, ScalarStyle, T.Text)) -> SchemaEncoder -> SchemaEncoder
setScalarStyle :: (Scalar -> Either [Char] (Tag, ScalarStyle, Text))
-> SchemaEncoder -> SchemaEncoder
setScalarStyle Scalar -> Either [Char] (Tag, ScalarStyle, Text)
customScalarEncoder SchemaEncoder
encoder = SchemaEncoder
encoder { schemaEncoderScalar = customScalarEncoder }