{-# OPTIONS_HADDOCK not-home #-}

-- | The core schema of YAML 1.2.2.
--
-- This module is intended for internal use only, and may change without warning
-- in subsequent releases.
module Yamlet.Internal.Schema
  ( resolvePlain
  , resolveTagged
  , resolvePlainExact
  , resolveTaggedExact
  , startsNumber
  , isPlainString
  , isPlainSafe
  , isPlainPortable
  , isYaml11Bool
  , isYaml11NonString
  , isYaml11Timestamp
  , exponentOutOfRange
  ) where

import Control.Monad
import Data.Bifunctor
import Data.Char
import Data.Maybe
import Data.Scientific qualified as Sci
import Data.Text qualified as T
import Data.Time.Calendar

import Yamlet.Internal.Emit
import Yamlet.Internal.Utils
import Yamlet.Value

-- | The value of a plain scalar without a tag. Not every such scalar is a
-- string, e.g. @null@, @true@, @12@, @0x1F@ and @1.5e3@ are not. Quoted and
-- block scalars are always strings.
--
-- A float whose exponent in scientific notation is beyond the range from
-- -1000 to 1000, e.g. @1e1001@, @10e1000@ or @1e-1001@, becomes infinity
-- or zero, as a double does. The decoders reject such a number, because its
-- value is not exact.
--
-- >>> map resolvePlain ["", "true", "0x1F", "1.5e3", ".inf", "yes", "9.10.3"]
-- [Null,Bool True,Int 31,Float (Finite 1500.0),Float Infinity,String "yes",String "9.10.3"]
resolvePlain :: T.Text -> Value
resolvePlain :: Text -> Value
resolvePlain = (Value -> Value) -> (Value -> Value) -> Either Value Value -> Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Value -> Value
forall a. a -> a
id Value -> Value
forall a. a -> a
id (Either Value Value -> Value)
-> (Text -> Either Value Value) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Value Value
resolvePlainExact

-- | The value of a scalar with the given resolved tag, e.g.
-- @tag:yaml.org,2002:int@. Return 'Nothing' if the text is not valid for a
-- tag of the core schema. A scalar with another tag is a string.
--
-- A float beyond the limit becomes infinity or zero, as in 'resolvePlain'.
--
-- >>> [resolveTagged floatTag "1", resolveTagged intTag "abc", resolveTagged seqTag "x", resolveTagged "!point" "1"]
-- [Just (Float (Finite 1.0)),Nothing,Nothing,Just (String "1")]
resolveTagged :: T.Text -> T.Text -> Maybe Value
resolveTagged :: Text -> Text -> Maybe Value
resolveTagged Text
tag Text
t = (Value -> Value) -> (Value -> Value) -> Either Value Value -> Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Value -> Value
forall a. a -> a
id Value -> Value
forall a. a -> a
id (Either Value Value -> Value)
-> Maybe (Either Value Value) -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe (Either Value Value)
resolveTaggedExact Text
tag Text
t

-- | The value of a plain scalar, 'Left' if the value is not exact.
resolvePlainExact :: T.Text -> Either Value Value
resolvePlainExact :: Text -> Either Value Value
resolvePlainExact Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
  Maybe (Char, Text)
Nothing -> Value -> Either Value Value
forall a b. b -> Either a b
Right Value
Null
  Just (Char
c, Text
_)
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'N' -> Value -> Either Value Value
forall a b. b -> Either a b
Right (Value -> Either Value Value) -> Value -> Either Value Value
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
isNull Text
t then Value
Null else Text -> Value
String Text
t
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
't' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'T' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'f' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'F' ->
        Value -> Either Value Value
forall a b. b -> Either a b
Right (Value -> Either Value Value) -> Value -> Either Value Value
forall a b. (a -> b) -> a -> b
$ Value -> (Bool -> Value) -> Maybe Bool -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Value
String Text
t) Bool -> Value
Bool (Text -> Maybe Bool
readBool Text
t)
    | Char -> Bool
startsNumber Char
c -> case Text -> Maybe Integer
readInt Text
t of
        Just Integer
i -> Value -> Either Value Value
forall a b. b -> Either a b
Right (Integer -> Value
Int Integer
i)
        Maybe Integer
Nothing -> Either Value Value
-> (Either FloatValue FloatValue -> Either Value Value)
-> Maybe (Either FloatValue FloatValue)
-> Either Value Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Value -> Either Value Value
forall a b. b -> Either a b
Right (Text -> Value
String Text
t)) ((FloatValue -> Value)
-> (FloatValue -> Value)
-> Either FloatValue FloatValue
-> Either Value Value
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap FloatValue -> Value
Float FloatValue -> Value
Float) (Text -> Maybe (Either FloatValue FloatValue)
readFloat Text
t)
    | Bool
otherwise -> Value -> Either Value Value
forall a b. b -> Either a b
Right (Text -> Value
String Text
t)

-- | A plain scalar that starts with the character can be a number. Only such
-- a scalar can have a value that is not exact.
startsNumber :: Char -> Bool
startsNumber :: Char -> Bool
startsNumber Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'

-- | The value of a scalar with a tag, 'Left' if the value is not exact.
resolveTaggedExact :: T.Text -> T.Text -> Maybe (Either Value Value)
resolveTaggedExact :: Text -> Text -> Maybe (Either Value Value)
resolveTaggedExact Text
tag Text
t
  | Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
strTag = Either Value Value -> Maybe (Either Value Value)
forall a. a -> Maybe a
Just (Either Value Value -> Maybe (Either Value Value))
-> (Value -> Either Value Value)
-> Value
-> Maybe (Either Value Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either Value Value
forall a b. b -> Either a b
Right (Value -> Maybe (Either Value Value))
-> Value -> Maybe (Either Value Value)
forall a b. (a -> b) -> a -> b
$ Text -> Value
String Text
t
  | Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
nullTag = if Text -> Bool
isNull Text
t then Either Value Value -> Maybe (Either Value Value)
forall a. a -> Maybe a
Just (Value -> Either Value Value
forall a b. b -> Either a b
Right Value
Null) else Maybe (Either Value Value)
forall a. Maybe a
Nothing
  | Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
boolTag = Value -> Either Value Value
forall a b. b -> Either a b
Right (Value -> Either Value Value)
-> (Bool -> Value) -> Bool -> Either Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Value
Bool (Bool -> Either Value Value)
-> Maybe Bool -> Maybe (Either Value Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Bool
readBool Text
t
  | Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
intTag = Value -> Either Value Value
forall a b. b -> Either a b
Right (Value -> Either Value Value)
-> (Integer -> Value) -> Integer -> Either Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Value
Int (Integer -> Either Value Value)
-> Maybe Integer -> Maybe (Either Value Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Integer
readInt Text
t
  | Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
floatTag = (FloatValue -> Value)
-> (FloatValue -> Value)
-> Either FloatValue FloatValue
-> Either Value Value
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap FloatValue -> Value
Float FloatValue -> Value
Float (Either FloatValue FloatValue -> Either Value Value)
-> Maybe (Either FloatValue FloatValue)
-> Maybe (Either Value Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Either FloatValue FloatValue)
readFloat Text
t
  | Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
seqTag Bool -> Bool -> Bool
|| Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
mapTag = Maybe (Either Value Value)
forall a. Maybe a
Nothing
  | Bool
otherwise = Either Value Value -> Maybe (Either Value Value)
forall a. a -> Maybe a
Just (Either Value Value -> Maybe (Either Value Value))
-> (Value -> Either Value Value)
-> Value
-> Maybe (Either Value Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either Value Value
forall a b. b -> Either a b
Right (Value -> Maybe (Either Value Value))
-> Value -> Maybe (Either Value Value)
forall a b. (a -> b) -> a -> b
$ Text -> Value
String Text
t

-- | A plain scalar with the text is a string, e.g. @9.10.3@ is a string, but
-- @9.10@ and @true@ are not. The check ignores the syntax, so e.g. @a: b@
-- passes. For both checks, use 'isPlainSafe'.
--
-- >>> map isPlainString ["9.10.3", "9.10", "true", "a: b"]
-- [True,False,False,True]
isPlainString :: T.Text -> Bool
isPlainString :: Text -> Bool
isPlainString Text
t = case Text -> Value
resolvePlain Text
t of
  String Text
_ -> Bool
True
  Value
_ -> Bool
False

-- | The string reads back as the same string if it is a plain scalar in the
-- block style, as a value or as a key. A key without @?@ must also have at
-- most 1024 characters, which the check does not count. In a flow collection
-- the characters @,[]{}@ need quotes too, so the check does not apply there.
--
-- >>> map isPlainSafe ["a:b", "a: b", "- a", "a #b", "9.10"]
-- [True,False,False,False,False]
isPlainSafe :: T.Text -> Bool
isPlainSafe :: Text -> Bool
isPlainSafe Text
t = Bool -> Text -> Bool
plainSyntax Bool
False Text
t Bool -> Bool -> Bool
&& Text -> Bool
isPlainString Text
t

-- | As 'isPlainSafe', and common YAML 1.1 parsers also read the plain scalar
-- as a string, e.g. not @yes@ as a boolean or @12:30@ as a number. The
-- encoder writes a string without quotes only if it passes this check.
--
-- >>> map isPlainPortable ["a:b", "yes", "12:30", "2024-01-01", "9.10.3"]
-- [True,False,False,False,True]
isPlainPortable :: T.Text -> Bool
isPlainPortable :: Text -> Bool
isPlainPortable Text
t = Text -> Bool
isPlainSafe Text
t Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
isYaml11NonString Text
t)

isNull :: T.Text -> Bool
isNull :: Text -> Bool
isNull Text
t = Text -> Bool
T.null Text
t Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"~" Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"null" Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Null" Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"NULL"

readBool :: T.Text -> Maybe Bool
readBool :: Text -> Maybe Bool
readBool = \case
  Text
"true" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
  Text
"True" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
  Text
"TRUE" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
  Text
"false" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
  Text
"False" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
  Text
"FALSE" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
  Text
_ -> Maybe Bool
forall a. Maybe a
Nothing

-- | A word that YAML 1.1 reads as a boolean, but YAML 1.2 as a string, e.g.
-- @yes@ or @off@.
isYaml11Bool :: T.Text -> Bool
isYaml11Bool :: Text -> Bool
isYaml11Bool Text
t =
  Text
t Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"y", Text
"Y", Text
"yes", Text
"Yes", Text
"YES", Text
"on", Text
"On", Text
"ON"]
    Bool -> Bool -> Bool
|| Text
t Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"n", Text
"N", Text
"no", Text
"No", Text
"NO", Text
"off", Text
"Off", Text
"OFF"]

-- | A common YAML 1.1 parser reads a plain scalar with the text as a value
-- that is not a string, e.g. the boolean @yes@, the base-60 number @12:30@ or
-- the date @2024-01-01@. The patterns cover what PyYAML, Ruby's Psych and
-- go-yaml v2, which Kubernetes uses, accept. The YAML 1.1 types themselves
-- are not enough: the parsers accept more, e.g. @1,000@ in Psych and @0X1F@ in
-- go-yaml v2, and the type of floats accepts too much, e.g. @1.2.3@.
isYaml11NonString :: T.Text -> Bool
isYaml11NonString :: Text -> Bool
isYaml11NonString Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
  Maybe (Char, Text)
Nothing -> Bool
True
  Just (Char
c, Text
_)
    -- A symbol in Psych, which its safe loader rejects.
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' -> Text -> Int -> Ordering
T.compareLength Text
t Int
1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
    | Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' ->
        (Text -> [Text]) -> Text -> Bool
matches ([Text -> [Text]] -> Text -> [Text]
alt [Text -> [Text]
int, Text -> [Text]
float, Text -> [Text]
timestamp]) Text
t Bool -> Bool -> Bool
|| (Text -> [Text]) -> Text -> Bool
matches Text -> [Text]
goNumber ((Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') Text
t)
    -- Psych merges a quoted << too, only !!str << stays a key there.
    | Bool
otherwise ->
        Text
t Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"y", Text
"Y", Text
"n", Text
"N", Text
"~", Text
"<<", Text
"="]
          -- Psych ignores the case of these words.
          Bool -> Bool -> Bool
|| ( Text -> Int -> Ordering
T.compareLength Text
t Int
5 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT
                 Bool -> Bool -> Bool
&& Text -> Text
T.toLower Text
t Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"yes", Text
"no", Text
"true", Text
"false", Text
"on", Text
"off", Text
"null"]
             )
  where
    matches :: (T.Text -> [T.Text]) -> T.Text -> Bool
    matches :: (Text -> [Text]) -> Text -> Bool
matches Text -> [Text]
m Text
s = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
T.null (Text -> [Text]
m Text
s)

    int :: T.Text -> [T.Text]
    int :: Text -> [Text]
int =
      Text -> [Text]
sign
        (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Text -> [Text]] -> Text -> [Text]
alt
          [ Text -> Text -> [Text]
str Text
"0b" (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
some ((Char -> Bool) -> Text -> [Text]
separatorOr (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'0', Char
'1']))
          , (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0') (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
some ((Char -> Bool) -> Text -> [Text]
separatorOr Char -> Bool
isOctDigit)
          , (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0')
          , Text -> [Text]
nonZero (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
many ((Char -> Bool) -> Text -> [Text]
separatorOr Char -> Bool
isDigit)
          , Text -> Text -> [Text]
str Text
"0x" (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
some ((Char -> Bool) -> Text -> [Text]
separatorOr Char -> Bool
isHexDigit)
          , Text -> [Text]
digit (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
many ((Char -> Bool) -> Text -> [Text]
underscoreOr Char -> Bool
isDigit) (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> [Text]
sexagesimal
          ]

    float :: T.Text -> [T.Text]
    float :: Text -> [Text]
float =
      Text -> [Text]
sign
        (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Text -> [Text]] -> Text -> [Text]
alt
          [ Text -> [Text]
digit
              (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
many ((Char -> Bool) -> Text -> [Text]
separatorOr Char -> Bool
isDigit)
              (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
              (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
many ((Char -> Bool) -> Text -> [Text]
underscoreOr Char -> Bool
isDigit)
              (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
opt Text -> [Text]
exponentPart
          , (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
some ((Char -> Bool) -> Text -> [Text]
underscoreOr Char -> Bool
isDigit) (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
opt Text -> [Text]
exponentPart
          , (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> [Text]
exponentPart
          , Text -> [Text]
digit
              (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
many ((Char -> Bool) -> Text -> [Text]
underscoreOr Char -> Bool
isDigit)
              (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> [Text]
sexagesimal
              (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
              (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
many ((Char -> Bool) -> Text -> [Text]
underscoreOr Char -> Bool
isDigit)
          , (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Text -> [Text]
caseless Text
"inf"
          , (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> Text -> [Text]
caseless Text
"nan"
          ]

    timestamp :: T.Text -> [T.Text]
    timestamp :: Text -> [Text]
timestamp =
      [Text -> [Text]] -> Text -> [Text]
alt
        [ Int -> Text -> [Text]
digits Int
4 (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> [Text]
oneOrTwoDigits (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> [Text]
oneOrTwoDigits
        , (Text -> [Text]) -> Text -> [Text]
opt ((Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'))
            (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Int -> Text -> [Text]
digits Int
4
            (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
            (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> [Text]
oneOrTwoDigits
            (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
            (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> [Text]
oneOrTwoDigits
            (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Text -> [Text]] -> Text -> [Text]
alt [(Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'T', Char
't']), (Text -> [Text]) -> Text -> [Text]
some Text -> [Text]
blank]
            (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> [Text]
oneOrTwoDigits
            (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')
            (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Int -> Text -> [Text]
digits Int
2
            (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')
            (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Int -> Text -> [Text]
digits Int
2
            (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
opt ((Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
many Text -> [Text]
digit)
            (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
opt
              ( (Text -> [Text]) -> Text -> [Text]
many Text -> [Text]
blank
                  (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Text -> [Text]] -> Text -> [Text]
alt
                    [ (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'Z')
                    , (Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'+', Char
'-'])
                        (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> [Text]
oneOrTwoDigits
                        (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
opt ((Text -> [Text]) -> Text -> [Text]
opt ((Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')) (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Int -> Text -> [Text]
digits Int
2)
                    ]
              )
        ]

    -- The numbers of go-yaml v2, which removes the underscores first: the
    -- integers of Go, a float whose dot and sign of the exponent are
    -- optional, and a binary integer with its sign after "0b", e.g. 0b-1.
    goNumber :: T.Text -> [T.Text]
    goNumber :: Text -> [Text]
goNumber =
      [Text -> [Text]] -> Text -> [Text]
alt
        [ Text -> [Text]
sign
            (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Text -> [Text]] -> Text -> [Text]
alt
              [ (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0')
                  (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'x', Char
'X'])
                  (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
some ((Char -> Bool) -> Text -> [Text]
one Char -> Bool
isHexDigit)
              , (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0')
                  (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'o', Char
'O'])
                  (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
some ((Char -> Bool) -> Text -> [Text]
one Char -> Bool
isOctDigit)
              , (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0')
                  (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'b', Char
'B'])
                  (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
some ((Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'0', Char
'1']))
              , [Text -> [Text]] -> Text -> [Text]
alt
                  [ (Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
some Text -> [Text]
digit
                  , (Text -> [Text]) -> Text -> [Text]
some Text -> [Text]
digit (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
opt ((Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
many Text -> [Text]
digit)
                  ]
                  (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
opt
                    ( (Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'e', Char
'E'])
                        (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
opt ((Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'+', Char
'-']))
                        (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
some Text -> [Text]
digit
                    )
              ]
        , Text -> Text -> [Text]
str Text
"0b" (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'+', Char
'-']) (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
some ((Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'0', Char
'1']))
        ]

    -- Each matcher gives the rests of the text after all its possible
    -- matches, so the patterns backtrack as the regular expressions of the
    -- parsers do and each one matches its regular expression. A parser such as
    -- attoparsec does not backtrack into an optional or repeated part, e.g.
    -- [0-5]?[0-9] would take the 5 of 1:5 and then find no digit.
    one :: (Char -> Bool) -> T.Text -> [T.Text]
    one :: (Char -> Bool) -> Text -> [Text]
one Char -> Bool
p Text
s = case Text -> Maybe (Char, Text)
T.uncons Text
s of
      Just (Char
x, Text
rest) | Char -> Bool
p Char
x -> [Text
rest]
      Maybe (Char, Text)
_ -> []

    str :: T.Text -> T.Text -> [T.Text]
    str :: Text -> Text -> [Text]
str Text
prefix Text
s = [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Text -> Maybe Text
textStripPrefix Text
prefix Text
s)

    alt :: [T.Text -> [T.Text]] -> T.Text -> [T.Text]
    alt :: [Text -> [Text]] -> Text -> [Text]
alt [Text -> [Text]]
ms Text
s = ((Text -> [Text]) -> [Text]) -> [Text -> [Text]] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
s) [Text -> [Text]]
ms

    opt :: (T.Text -> [T.Text]) -> T.Text -> [T.Text]
    opt :: (Text -> [Text]) -> Text -> [Text]
opt Text -> [Text]
m Text
s = Text
s Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
m Text
s

    -- The rests of each step go in front of the rests that follow, because
    -- s : (m s >>= many m) appends once per step and takes quadratic time.
    many :: (T.Text -> [T.Text]) -> T.Text -> [T.Text]
    many :: (Text -> [Text]) -> Text -> [Text]
many Text -> [Text]
m Text
s0 = Text -> [Text] -> [Text]
go Text
s0 []
      where
        go :: T.Text -> [T.Text] -> [T.Text]
        go :: Text -> [Text] -> [Text]
go Text
s [Text]
rests = Text
s Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> [Text] -> [Text]) -> [Text] -> [Text] -> [Text]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> [Text] -> [Text]
go [Text]
rests (Text -> [Text]
m Text
s)

    some :: (T.Text -> [T.Text]) -> T.Text -> [T.Text]
    some :: (Text -> [Text]) -> Text -> [Text]
some Text -> [Text]
m = Text -> [Text]
m (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
many Text -> [Text]
m

    sign :: T.Text -> [T.Text]
    sign :: Text -> [Text]
sign = (Text -> [Text]) -> Text -> [Text]
opt ((Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'+', Char
'-']))

    digit :: T.Text -> [T.Text]
    digit :: Text -> [Text]
digit = (Char -> Bool) -> Text -> [Text]
one Char -> Bool
isDigit

    digits :: Int -> T.Text -> [T.Text]
    digits :: Int -> Text -> [Text]
digits Int
k = ((Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text])
-> (Text -> [Text]) -> [Text -> [Text]] -> Text -> [Text]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
(>=>) Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> (Text -> [Text]) -> [Text -> [Text]]
forall a. Int -> a -> [a]
replicate Int
k Text -> [Text]
digit)

    oneOrTwoDigits :: T.Text -> [T.Text]
    oneOrTwoDigits :: Text -> [Text]
oneOrTwoDigits = Text -> [Text]
digit (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
opt Text -> [Text]
digit

    nonZero :: T.Text -> [T.Text]
    nonZero :: Text -> [Text]
nonZero = (Char -> Bool) -> Text -> [Text]
one (\Char
x -> Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'0')

    underscoreOr :: (Char -> Bool) -> T.Text -> [T.Text]
    underscoreOr :: (Char -> Bool) -> Text -> [Text]
underscoreOr Char -> Bool
p = (Char -> Bool) -> Text -> [Text]
one (\Char
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
p Char
x)

    -- Psych also allows commas in numbers, e.g. 1,000.
    separatorOr :: (Char -> Bool) -> T.Text -> [T.Text]
    separatorOr :: (Char -> Bool) -> Text -> [Text]
separatorOr Char -> Bool
p = (Char -> Bool) -> Text -> [Text]
one (\Char
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char -> Bool
p Char
x)

    caseless :: T.Text -> T.Text -> [T.Text]
    caseless :: Text -> Text -> [Text]
caseless Text
w Text
s =
      [Text
rest | let (Text
prefix, Text
rest) = Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
T.length Text
w) Text
s, Text -> Text
T.toLower Text
prefix Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
w]

    sexagesimal :: T.Text -> [T.Text]
    sexagesimal :: Text -> [Text]
sexagesimal = (Text -> [Text]) -> Text -> [Text]
some ((Char -> Bool) -> Text -> [Text]
one (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
opt ((Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'0' .. Char
'5'])) (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> [Text]
digit)

    exponentPart :: T.Text -> [T.Text]
    exponentPart :: Text -> [Text]
exponentPart = (Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'e', Char
'E']) (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'+', Char
'-']) (Text -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Text -> [Text]) -> Text -> [Text]
some Text -> [Text]
digit

    blank :: T.Text -> [T.Text]
    blank :: Text -> [Text]
blank = (Char -> Bool) -> Text -> [Text]
one (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ', Char
'\t'])

-- | A common YAML 1.1 parser reads a plain scalar with the text as a
-- timestamp and can build it. PyYAML has the years from 1 to 9999 of Python,
-- and it rejects the hour 24, a leap second and a time zone of 24 hours.
-- Psych reads the hour 24 and a leap second as a later time.
--
-- >>> map isYaml11Timestamp ["2024-01-01", "2024-01-01T12:30:00Z", "0000-01-01", "2016-12-31T23:59:60Z", "12:30"]
-- [True,True,False,False,False]
isYaml11Timestamp :: T.Text -> Bool
isYaml11Timestamp :: Text -> Bool
isYaml11Timestamp Text
t =
  Text -> Bool
isYaml11NonString Text
t Bool -> Bool -> Bool
&& case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"-" Text
date of
    [Text
y, Text
m, Text
d]
      | Text -> Int
T.length Text
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4
      , (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Text
ds -> Bool -> Bool
not (Text -> Bool
T.null Text
ds) Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
ds) [Text
y, Text
m, Text
d] ->
          let year :: Integer
year = Integer -> Text -> Integer
digitsValue Integer
10 Text
y
          in Integer
year Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1
               Bool -> Bool -> Bool
&& Integer
year Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
9999
               Bool -> Bool -> Bool
&& Maybe Day -> Bool
forall a. Maybe a -> Bool
isJust (Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
year (Text -> Int
number Text
m) (Text -> Int
number Text
d))
               Bool -> Bool -> Bool
&& Text -> Bool
validTime ((Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isTimeSeparator Text
rest)
    [Text]
_ -> Bool
False
  where
    (Text
date, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isTimeSeparator Text
t

    isTimeSeparator :: Char -> Bool
    isTimeSeparator :: Char -> Bool
isTimeSeparator Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'T' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
't' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'

    number :: T.Text -> Int
    number :: Text -> Int
number = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Text -> Integer) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Text -> Integer
digitsValue Integer
10

    -- The time, with the hours, the minutes and the seconds of the pattern of
    -- 'isYaml11NonString'.
    validTime :: T.Text -> Bool
    validTime :: Text -> Bool
validTime Text
s
      | Text -> Bool
T.null Text
s = Bool
True
      | Bool
otherwise = case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
":" ((Char -> Bool) -> Text -> Text
T.takeWhile (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
s) of
          Text
h : Text
_ : Text
sec : [Text]
_ ->
            Text -> Int
number Text
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24
              Bool -> Bool -> Bool
&& Text -> Int
number (Int -> Text -> Text
T.take Int
2 Text
sec) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
60
              Bool -> Bool -> Bool
&& Text -> Bool
validZone
                ((Char -> Bool) -> Text -> Text
T.dropWhile (\Char
c -> Char -> Bool
isDigit 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
':', Char
'.', Char
' ', Char
'\t']) Text
s)
          [Text]
_ -> Bool
False

    -- The hours of a zone are the digits before the last two, unless the
    -- zone has a colon or at most two digits.
    validZone :: T.Text -> Bool
    validZone :: Text -> Bool
validZone Text
z = case Text -> Maybe (Char, Text)
T.uncons Text
z of
      Just (Char
c, Text
offset)
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' ->
            let hours :: Text
hours = (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isDigit Text
offset
                h :: Text
h = if Text -> Int -> Ordering
T.compareLength Text
hours Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then Int -> Text -> Text
T.dropEnd Int
2 Text
hours else Text
hours
            in Text -> Int
number Text
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24
      Maybe (Char, Text)
_ -> Bool
True

-- | [-+]?[0-9]+, 0o[0-7]+ or 0x[0-9a-fA-F]+.
readInt :: T.Text -> Maybe Integer
readInt :: Text -> Maybe Integer
readInt Text
t
  | Just Text
ds <- Text -> Text -> Maybe Text
textStripPrefix Text
"0o" Text
t = Integer -> (Char -> Bool) -> Text -> Maybe Integer
digits Integer
8 Char -> Bool
isOctDigit Text
ds
  | Just Text
ds <- Text -> Text -> Maybe Text
textStripPrefix Text
"0x" Text
t = Integer -> (Char -> Bool) -> Text -> Maybe Integer
digits Integer
16 Char -> Bool
isHexDigit Text
ds
  | Just Text
ds <- Text -> Text -> Maybe Text
textStripPrefix Text
"-" Text
t = Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> (Char -> Bool) -> Text -> Maybe Integer
digits Integer
10 Char -> Bool
isDigit Text
ds
  | Just Text
ds <- Text -> Text -> Maybe Text
textStripPrefix Text
"+" Text
t = Integer -> (Char -> Bool) -> Text -> Maybe Integer
digits Integer
10 Char -> Bool
isDigit Text
ds
  | Bool
otherwise = Integer -> (Char -> Bool) -> Text -> Maybe Integer
digits Integer
10 Char -> Bool
isDigit Text
t
  where
    digits :: Integer -> (Char -> Bool) -> T.Text -> Maybe Integer
    digits :: Integer -> (Char -> Bool) -> Text -> Maybe Integer
digits Integer
radix Char -> Bool
valid Text
ds
      | Bool -> Bool
not (Text -> Bool
T.null Text
ds) Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
valid Text
ds = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Text -> Integer
digitsValue Integer
radix Text
ds
      | Bool
otherwise = Maybe Integer
forall a. Maybe a
Nothing

-- | The value of the digits in the radix. A multiplication for each digit
-- takes quadratic time in the number of digits, so the halves of a long text
-- are read apart.
digitsValue :: Integer -> T.Text -> Integer
digitsValue :: Integer -> Text -> Integer
digitsValue Integer
radix Text
t0 = Int -> Text -> Integer
go (Text -> Int
T.length Text
t0) Text
t0
  where
    go :: Int -> T.Text -> Integer
    go :: Int -> Text -> Integer
go Int
n Text
t
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxFoldDigits =
          (Integer -> Char -> Integer) -> Integer -> Text -> Integer
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (\Integer
acc Char
d -> Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
radix Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
digitToInt Char
d)) Integer
0 Text
t
      | Bool
otherwise =
          let k :: Int
k = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
              (Text
hi, Text
lo) = Int -> Text -> (Text, Text)
T.splitAt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) Text
t
          in Int -> Text -> Integer
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) Text
hi Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
radix Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
k Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Text -> Integer
go Int
k Text
lo

    -- Up to about 20 digits, one fold is faster than a split, measured with
    -- GHC 9.10.3 for numbers from 60 to 100000 digits.
    maxFoldDigits :: Int
    maxFoldDigits :: Int
maxFoldDigits = Int
20

-- | The limit of the exponent of a float in scientific notation, i.e. the
-- exponent of its first digit that is not zero. The limit applies to the
-- value, not to the text, so every value that the decoder gives reads back
-- after the encoder writes it.
--
-- A t'Data.Scientific.Scientific' keeps the exponent apart from the
-- coefficient, but its conversion to an 'Integer', e.g. with 'truncate',
-- computes every digit. With this limit, the integer has at most 1001
-- digits. Without a limit, a short input such as @1e999999999@ gives an
-- integer of about 400 MiB. The limit covers the whole range of 'Double',
-- from about 5e-324 to 1.8e308.
maxExponent :: Integer
maxExponent :: Integer
maxExponent = Integer
1000

-- | The error for a number beyond 'maxExponent'.
exponentOutOfRange :: String
exponentOutOfRange :: [Char]
exponentOutOfRange =
  [Char]
"the exponent of the number is out of the range from "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> Integer
forall a. Num a => a -> a
negate Integer
maxExponent)
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" to "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
maxExponent

-- | [-+]?(\.[0-9]+|[0-9]+(\.[0-9]*)?)([eE][-+]?[0-9]+)?, [-+]?\.inf or \.nan
-- in one of three capitalizations. The value is 'Left' if it is not exact.
readFloat :: T.Text -> Maybe (Either FloatValue FloatValue)
readFloat :: Text -> Maybe (Either FloatValue FloatValue)
readFloat Text
t0 = case Text
t0 of
  Text
".nan" -> Either FloatValue FloatValue
-> Maybe (Either FloatValue FloatValue)
forall a. a -> Maybe a
Just (FloatValue -> Either FloatValue FloatValue
forall a b. b -> Either a b
Right FloatValue
NaN)
  Text
".NaN" -> Either FloatValue FloatValue
-> Maybe (Either FloatValue FloatValue)
forall a. a -> Maybe a
Just (FloatValue -> Either FloatValue FloatValue
forall a b. b -> Either a b
Right FloatValue
NaN)
  Text
".NAN" -> Either FloatValue FloatValue
-> Maybe (Either FloatValue FloatValue)
forall a. a -> Maybe a
Just (FloatValue -> Either FloatValue FloatValue
forall a b. b -> Either a b
Right FloatValue
NaN)
  Text
_ -> case Text -> Maybe (Char, Text)
T.uncons Text
t0 of
    Just (Char
'-', Text
t) -> (FloatValue -> FloatValue)
-> (FloatValue -> FloatValue)
-> Either FloatValue FloatValue
-> Either FloatValue FloatValue
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap FloatValue -> FloatValue
negateFloat FloatValue -> FloatValue
negateFloat (Either FloatValue FloatValue -> Either FloatValue FloatValue)
-> Maybe (Either FloatValue FloatValue)
-> Maybe (Either FloatValue FloatValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Either FloatValue FloatValue)
unsigned Text
t
    Just (Char
'+', Text
t) -> Text -> Maybe (Either FloatValue FloatValue)
unsigned Text
t
    Maybe (Char, Text)
_ -> Text -> Maybe (Either FloatValue FloatValue)
unsigned Text
t0
  where
    unsigned :: T.Text -> Maybe (Either FloatValue FloatValue)
    unsigned :: Text -> Maybe (Either FloatValue FloatValue)
unsigned Text
t
      | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
".inf" Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
".Inf" Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
".INF" = Either FloatValue FloatValue
-> Maybe (Either FloatValue FloatValue)
forall a. a -> Maybe a
Just (FloatValue -> Either FloatValue FloatValue
forall a b. b -> Either a b
Right FloatValue
Infinity)
      | Bool
otherwise =
          let (Text
int, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isDigit Text
t
              (Text
frac, Text
rest') = case Text -> Maybe (Char, Text)
T.uncons Text
rest of
                Just (Char
'.', Text
r) -> (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isDigit Text
r
                Maybe (Char, Text)
_ -> (Text
"", Text
rest)
              hasDot :: Bool
hasDot = Text -> Text -> Bool
textIsPrefixOf Text
"." Text
rest
          in if
               | Text -> Bool
T.null Text
int Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
frac -> Maybe (Either FloatValue FloatValue)
forall a. Maybe a
Nothing
               | Bool -> Bool
not (Text -> Bool
T.null Text
int) Bool -> Bool -> Bool
|| Bool
hasDot -> do
                   ex <- Text -> Maybe Integer
exponent_ Text
rest'
                   Just $ decimal (int <> frac) (ex - toInteger (T.length frac))
               | Bool
otherwise -> Maybe (Either FloatValue FloatValue)
forall a. Maybe a
Nothing

    -- The decimal digits times a power of 10, with the exponent that the text
    -- of the float has. A value beyond the limit of 'maxExponent' gives
    -- infinity or zero, which are not exact.
    decimal :: T.Text -> Integer -> Either FloatValue FloatValue
    decimal :: Text -> Integer -> Either FloatValue FloatValue
decimal Text
ds Integer
e
      | Integer
c Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = FloatValue -> Either FloatValue FloatValue
forall a b. b -> Either a b
Right (Scientific -> FloatValue
Finite Scientific
0)
      | Integer -> Integer
forall a. Num a => a -> a
abs Integer
leading Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
maxExponent = FloatValue -> Either FloatValue FloatValue
forall a b. a -> Either a b
Left (if Integer
leading Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then FloatValue
Infinity else Scientific -> FloatValue
Finite Scientific
0)
      | Bool
otherwise = FloatValue -> Either FloatValue FloatValue
forall a b. b -> Either a b
Right (FloatValue -> Either FloatValue FloatValue)
-> FloatValue -> Either FloatValue FloatValue
forall a b. (a -> b) -> a -> b
$ Scientific -> FloatValue
Finite (Integer -> Int -> Scientific
Sci.scientific Integer
c (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
e))
      where
        -- The exponent of the first digit that is not zero.
        leading :: Integer
        leading :: Integer
leading = Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Text -> Int
T.length ((Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0') Text
ds)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1

        c :: Integer
        c :: Integer
c = Integer -> Text -> Integer
digitsValue Integer
10 Text
ds

    negateFloat :: FloatValue -> FloatValue
    negateFloat :: FloatValue -> FloatValue
negateFloat = \case
      Finite Scientific
s
        | Scientific
s Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Scientific
0 -> FloatValue
NegativeZero
        | Bool
otherwise -> Scientific -> FloatValue
Finite (Scientific -> Scientific
forall a. Num a => a -> a
negate Scientific
s)
      FloatValue
NegativeZero -> Scientific -> FloatValue
Finite Scientific
0
      FloatValue
Infinity -> FloatValue
NegativeInfinity
      FloatValue
NegativeInfinity -> FloatValue
Infinity
      FloatValue
NaN -> FloatValue
NaN

    exponent_ :: T.Text -> Maybe Integer
    exponent_ :: Text -> Maybe Integer
exponent_ Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
      Maybe (Char, Text)
Nothing -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0
      Just (Char
e, Text
r)
        | Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
e Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'E' ->
            let (Integer -> Integer
sign, Text
ds) = case Text -> Maybe (Char, Text)
T.uncons Text
r of
                  Just (Char
'-', Text
d) -> (Integer -> Integer
forall a. Num a => a -> a
negate, Text
d)
                  Just (Char
'+', Text
d) -> (Integer -> Integer
forall a. a -> a
id, Text
d)
                  Maybe (Char, Text)
_ -> (Integer -> Integer
forall a. a -> a
id, Text
r)
            in if Bool -> Bool
not (Text -> Bool
T.null Text
ds) Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
ds
                 then Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> (Integer -> Integer) -> Integer -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
sign (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Text -> Integer
digitsValue Integer
10 Text
ds
                 else Maybe Integer
forall a. Maybe a
Nothing
        | Bool
otherwise -> Maybe Integer
forall a. Maybe a
Nothing