{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scalar -> Scalar -> Bool
$c/= :: Scalar -> Scalar -> Bool
== :: Scalar -> Scalar -> Bool
$c== :: Scalar -> Scalar -> Bool
Eq,Eq 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
min :: Scalar -> Scalar -> Scalar
$cmin :: Scalar -> Scalar -> Scalar
max :: Scalar -> Scalar -> Scalar
$cmax :: Scalar -> Scalar -> Scalar
>= :: Scalar -> Scalar -> Bool
$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
compare :: Scalar -> Scalar -> Ordering
$ccompare :: Scalar -> Scalar -> Ordering
Ord,Int -> Scalar -> ShowS
[Scalar] -> ShowS
Scalar -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Scalar] -> ShowS
$cshowList :: [Scalar] -> ShowS
show :: Scalar -> [Char]
$cshow :: Scalar -> [Char]
showsPrec :: Int -> Scalar -> ShowS
$cshowsPrec :: Int -> Scalar -> ShowS
Show,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
$cto :: forall x. Rep Scalar x -> Scalar
$cfrom :: forall x. Scalar -> Rep Scalar x
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
_) = 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 forall a. Eq a => a -> a -> Bool
== Tag
untagged -> ScalarTag
ScalarQMarkTag -- implicit ? tag

             ScalarStyle
_ | Tag
tag forall a. Eq a => a -> a -> Bool
== Tag
untagged -> ScalarTag
ScalarBangTag -- implicit ! tag
               | Tag
tag 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 -> ScalarStyle -> Text -> Either [Char] Scalar
forall {a}. Tag -> Either a Tag
schemaResolverSequence :: forall {a}. Tag -> Either a Tag
schemaResolverMappingDuplicates :: Bool
schemaResolverMapping :: forall {a}. Tag -> Either a Tag
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverMappingDuplicates :: Bool
schemaResolverMapping :: Tag -> Either [Char] Tag
schemaResolverSequence :: Tag -> Either [Char] Tag
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
..}
  where
    -- scalars
    schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverScalar = (ScalarTag -> Text -> Either [Char] Scalar)
-> Tag -> ScalarStyle -> Text -> Either [Char] Scalar
scalarTag forall {a}. ScalarTag -> Text -> Either a Scalar
go
      where
        go :: ScalarTag -> Text -> Either a Scalar
go ScalarTag
ScalarBangTag  Text
v = forall a b. b -> Either a b
Right (Text -> Scalar
SStr Text
v)
        go (ScalarTag Tag
t)  Text
v
          | Tag
t forall a. Eq a => a -> a -> Bool
== Tag
tagStr     = forall a b. b -> Either a b
Right (Text -> Scalar
SStr Text
v)
          | Bool
otherwise       = forall a b. b -> Either a b
Right (Tag -> Text -> Scalar
SUnknown Tag
t Text
v)
        go ScalarTag
ScalarQMarkTag Text
v = 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 forall a. Eq a => a -> a -> Bool
== Tag
tagBang = forall a b. b -> Either a b
Right Tag
tagMap
      | Bool
otherwise    = 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 forall a. Eq a => a -> a -> Bool
== Tag
tagBang = forall a b. b -> Either a b
Right Tag
tagSeq
      | Bool
otherwise    = 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 -> ScalarStyle -> Text -> Either [Char] Scalar
forall {a}. Tag -> Either a Tag
schemaResolverSequence :: forall {a}. Tag -> Either a Tag
schemaResolverMappingDuplicates :: Bool
schemaResolverMapping :: forall {a}. Tag -> Either a Tag
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverMappingDuplicates :: Bool
schemaResolverMapping :: Tag -> Either [Char] Tag
schemaResolverSequence :: Tag -> Either [Char] Tag
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
..}
  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 = forall a b. b -> Either a b
Right (Text -> Scalar
SStr Text
v)
        go (ScalarTag Tag
t)  Text
v
          | Tag
t forall a. Eq a => a -> a -> Bool
== Tag
tagStr     = forall a b. b -> Either a b
Right (Text -> Scalar
SStr Text
v)
          | Tag
t forall a. Eq a => a -> a -> Bool
== Tag
tagNull  = if Text -> Bool
isNullLiteral Text
v then forall a b. b -> Either a b
Right Scalar
SNull else forall a b. a -> Either a b
Left ([Char]
"invalid !!null " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
v)
          | Tag
t forall a. Eq a => a -> a -> Bool
== Tag
tagInt   = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"invalid !!int " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
v)   (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt)   forall a b. (a -> b) -> a -> b
$ Text -> Maybe Integer
jsonDecodeInt   Text
v
          | Tag
t forall a. Eq a => a -> a -> Bool
== Tag
tagFloat = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"invalid !!float " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
v) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Scalar
SFloat) forall a b. (a -> b) -> a -> b
$ Text -> Maybe Double
jsonDecodeFloat Text
v
          | Tag
t forall a. Eq a => a -> a -> Bool
== Tag
tagBool  = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"invalid !!bool " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
v)  (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Scalar
SBool)  forall a b. (a -> b) -> a -> b
$ Text -> Maybe Bool
jsonDecodeBool  Text
v
          | Bool
otherwise       = 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             = forall a b. b -> Either a b
Right Scalar
SNull
          | Just Bool
b <- Text -> Maybe Bool
jsonDecodeBool  Text
v = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! Bool -> Scalar
SBool Bool
b
          | Just Integer
i <- Text -> Maybe Integer
jsonDecodeInt   Text
v = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! Integer -> Scalar
SInt Integer
i
          | Just Double
f <- Text -> Maybe Double
jsonDecodeFloat Text
v = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! Double -> Scalar
SFloat Double
f
          | Bool
otherwise = 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 = (forall a. Eq a => a -> a -> Bool
== Text
"null")

    -- mappings
    schemaResolverMapping :: Tag -> Either a Tag
schemaResolverMapping Tag
t
      | Tag
t forall a. Eq a => a -> a -> Bool
== Tag
tagBang = forall a b. b -> Either a b
Right Tag
tagMap
      | Tag -> Bool
isUntagged Tag
t = forall a b. b -> Either a b
Right Tag
tagMap
      | Bool
otherwise    = 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 forall a. Eq a => a -> a -> Bool
== Tag
tagBang = forall a b. b -> Either a b
Right Tag
tagSeq
      | Tag -> Bool
isUntagged Tag
t = forall a b. b -> Either a b
Right Tag
tagSeq
      | Bool
otherwise    = 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 -> ScalarStyle -> Text -> Either [Char] Scalar
forall {a}. Tag -> Either a Tag
schemaResolverSequence :: forall {a}. Tag -> Either a Tag
schemaResolverMappingDuplicates :: Bool
schemaResolverMapping :: forall {a}. Tag -> Either a Tag
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverMappingDuplicates :: Bool
schemaResolverMapping :: Tag -> Either [Char] Tag
schemaResolverSequence :: Tag -> Either [Char] Tag
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
..}
  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 = forall a b. b -> Either a b
Right (Text -> Scalar
SStr Text
v)
        go (ScalarTag Tag
t)  Text
v
          | Tag
t forall a. Eq a => a -> a -> Bool
== Tag
tagStr     = forall a b. b -> Either a b
Right (Text -> Scalar
SStr Text
v)
          | Tag
t forall a. Eq a => a -> a -> Bool
== Tag
tagNull  = if Text -> Bool
isNullLiteral Text
v then forall a b. b -> Either a b
Right Scalar
SNull else forall a b. a -> Either a b
Left ([Char]
"invalid !!null " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
v)
          | Tag
t forall a. Eq a => a -> a -> Bool
== Tag
tagInt   = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"invalid !!int " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
v)   (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
SInt)   forall a b. (a -> b) -> a -> b
$ Text -> Maybe Integer
coreDecodeInt   Text
v
          | Tag
t forall a. Eq a => a -> a -> Bool
== Tag
tagFloat = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"invalid !!float " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
v) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Scalar
SFloat) forall a b. (a -> b) -> a -> b
$ Text -> Maybe Double
coreDecodeFloat Text
v
          | Tag
t forall a. Eq a => a -> a -> Bool
== Tag
tagBool  = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"invalid !!bool " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
v)  (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Scalar
SBool)  forall a b. (a -> b) -> a -> b
$ Text -> Maybe Bool
coreDecodeBool  Text
v
          | Bool
otherwise       = 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             = forall a b. b -> Either a b
Right Scalar
SNull
          | Just Bool
b <- Text -> Maybe Bool
coreDecodeBool  Text
v = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! Bool -> Scalar
SBool Bool
b
          | Just Integer
i <- Text -> Maybe Integer
coreDecodeInt   Text
v = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! Integer -> Scalar
SInt Integer
i
          | Just Double
f <- Text -> Maybe Double
coreDecodeFloat Text
v = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! Double -> Scalar
SFloat Double
f
          | Bool
otherwise = forall a b. b -> Either a b
Right (Text -> Scalar
SStr Text
v) -- map to !!str by default

    isNullLiteral :: Text -> Bool
isNullLiteral = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Bool
Set.member (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 forall a. Eq a => a -> a -> Bool
== Tag
tagBang = forall a b. b -> Either a b
Right Tag
tagMap
      | Tag -> Bool
isUntagged Tag
t = forall a b. b -> Either a b
Right Tag
tagMap
      | Bool
otherwise    = 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 forall a. Eq a => a -> a -> Bool
== Tag
tagBang = forall a b. b -> Either a b
Right Tag
tagSeq
      | Tag -> Bool
isUntagged Tag
t = forall a b. b -> Either a b
Right Tag
tagSeq
      | Bool
otherwise    = 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" = forall a. a -> Maybe a
Just Bool
False
jsonDecodeBool Text
"true"  = forall a. a -> Maybe a
Just Bool
True
jsonDecodeBool Text
_       = forall a. Maybe a
Nothing

-- | @tag:yaml.org,2002:bool@ (Core Schema)
coreDecodeBool :: T.Text -> Maybe Bool
coreDecodeBool :: Text -> Maybe Bool
coreDecodeBool = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup forall a b. (a -> b) -> a -> b
$
  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 = forall a. Maybe a
Nothing
jsonDecodeInt Text
"0" = 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 = Text -> Text
T.tail Text
t
           | Bool
otherwise          = Text
t

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

  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 = 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]
"")] <- forall a. (Eq a, Num a) => ReadS a
readHex (Text -> [Char]
T.unpack Text
rest)
  = forall a. a -> Maybe a
Just 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]
"")] <- forall a. (Eq a, Num a) => ReadS a
readOct (Text -> [Char]
T.unpack Text
rest)
  = forall a. a -> Maybe a
Just 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
  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! 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
  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! 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
  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall a. Read a => [Char] -> a
read (Text -> [Char]
T.unpack Text
t)

  | Bool
otherwise = 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse Parser Double
float [Char]
""
  where
    float :: Parser Double
    float :: Parser Double
float = do
      -- -?
      [Char]
p0 <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" ([Char]
"-" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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 <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
        if (Char
d forall a. Eq a => a -> a -> Bool
/= Char
'0')
          then (Char
dforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
          else forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char
d]

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

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

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

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

      let t' :: [Char]
t' = [Char]
p0forall a. [a] -> [a] -> [a]
++[Char]
p1forall a. [a] -> [a] -> [a]
++[Char]
p2forall a. [a] -> [a] -> [a]
++[Char]
p3
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! 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 <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
t Map Text Double
literals = forall a. a -> Maybe a
Just Double
j -- short-cut
  | Bool
otherwise = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse Parser Double
float [Char]
"" forall a b. (a -> b) -> a -> b
$ Text
t
  where
    float :: Parser Double
    float :: Parser Double
float = do
      -- [-+]?
      [Char]
p0 <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" (([Char]
"-" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> [Char]
"" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+')

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

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

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

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

      let t' :: [Char]
t' = [Char]
p0forall a. [a] -> [a] -> [a]
++[Char]
p1forall a. [a] -> [a] -> [a]
++[Char]
p2

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

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

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

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

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

      , (Text
"-.inf", (-Double
1forall a. Fractional a => a -> a -> a
/Double
0))
      , (Text
"-.Inf", (-Double
1forall a. Fractional a => a -> a -> a
/Double
0))
      , (Text
"-.INF", (-Double
1forall 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 forall a. Eq a => a -> a -> Bool
== Tag
tagMap  = forall a b. b -> Either a b
Right Tag
untagged
  | Bool
otherwise    = 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 forall a. Eq a => a -> a -> Bool
== Tag
tagSeq  = forall a b. b -> Either a b
Right Tag
untagged
  | Bool
otherwise    = 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)
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
schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
..}
  where

    schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderScalar Scalar
s = case Scalar
s of
      Scalar
SNull        -> forall a b. a -> Either a b
Left  [Char]
"SNull scalar type not supported in failsafeSchemaEncoder"
      SBool  Bool
_     -> forall a b. a -> Either a b
Left  [Char]
"SBool scalar type not supported in failsafeSchemaEncoder"
      SFloat Double
_     -> forall a b. a -> Either a b
Left  [Char]
"SFloat scalar type not supported in failsafeSchemaEncoder"
      SInt   Integer
_     -> 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 -> 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)
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
schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
..}
  where

    schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderScalar Scalar
s = case Scalar
s of
      Scalar
SNull         -> forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Text
"null")
      SBool  Bool
bool   -> forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Bool -> Text
encodeBool Bool
bool)
      SFloat Double
double -> forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Double -> Text
encodeDouble Double
double)
      SInt   Integer
int    -> 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
_  -> 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)
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
schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
..}
  where

    schemaEncoderScalar :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderScalar Scalar
s = case Scalar
s of
      Scalar
SNull         -> forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Text
"null")
      SBool  Bool
bool   -> forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Bool -> Text
encodeBool Bool
bool)
      SFloat Double
double -> forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
Plain, Double -> Text
encodeDouble Double
double)
      SInt   Integer
int    -> 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  -> 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 forall a. Eq a => a -> a -> Bool
/= Double
d      = Text
".nan"
  | Double
d forall a. Eq a => a -> a -> Bool
== (Double
1forall a. Fractional a => a -> a -> a
/Double
0)  = Text
".inf"
  | Double
d forall a. Eq a => a -> a -> Bool
== (-Double
1forall a. Fractional a => a -> a -> a
/Double
0) = Text
"-.inf"
  | Bool
otherwise   = [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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               = forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | Text -> Char
T.last Text
t forall a. Eq a => a -> a -> Bool
== Char
' '                  = forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | (Char -> Bool) -> Text -> Bool
T.any (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isPlainChar) Text
t       = forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | Bool
otherwise                        = 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                         = forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | Text -> Text -> Bool
T.isPrefixOf Text
" " Text
t               = forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | Text -> Char
T.last Text
t forall a. Eq a => a -> a -> Bool
== Char
' '                  = forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | (Char -> Bool) -> Text -> Bool
T.any (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isPlainChar) Text
t       = forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | SchemaResolver -> Text -> Bool
isAmbiguous SchemaResolver
jsonSchemaResolver Text
t = forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | Bool
otherwise                        = 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                         = forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | Text -> Text -> Bool
T.isPrefixOf Text
" " Text
t               = forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | Text -> Char
T.last Text
t forall a. Eq a => a -> a -> Bool
== Char
' '                  = forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | (Char -> Bool) -> Text -> Bool
T.any (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isPlainChar) Text
t       = forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | SchemaResolver -> Text -> Bool
isAmbiguous SchemaResolver
coreSchemaResolver Text
t = forall a b. b -> Either a b
Right (Tag
untagged, ScalarStyle
DoubleQuoted, Text
t)
  | Bool
otherwise                        = 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 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
schemaResolverMappingDuplicates :: Bool
schemaResolverMapping :: Tag -> Either [Char] Tag
schemaResolverSequence :: Tag -> Either [Char] Tag
schemaResolverScalar :: Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverMappingDuplicates :: SchemaResolver -> Bool
schemaResolverMapping :: SchemaResolver -> Tag -> Either [Char] Tag
schemaResolverSequence :: SchemaResolver -> Tag -> Either [Char] Tag
schemaResolverScalar :: SchemaResolver
-> Tag -> ScalarStyle -> Text -> Either [Char] Scalar
..} Text
t = case Tag -> ScalarStyle -> Text -> Either [Char] Scalar
schemaResolverScalar Tag
untagged ScalarStyle
Plain Text
t of
  Left [Char]
err        -> 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 :: Scalar -> Either [Char] (Tag, ScalarStyle, Text)
schemaEncoderScalar = Scalar -> Either [Char] (Tag, ScalarStyle, Text)
customScalarEncoder }