{-# OPTIONS_HADDOCK not-home #-}

-- | The class t'ToYaml', its instances and the parts of the encoder that the
-- generic instances share with it. "Yamlet.Encode" exports the public parts.
--
-- This module is intended for internal use only, and may change without warning
-- in subsequent releases.
module Yamlet.Internal.ToYaml
  ( -- * Class
    ToYaml (..)
  , (.=)
  , mapping

    -- * Parts of the generic instances
  , string
  , scalar
  ) where

import Control.Applicative
import Data.Fixed
import Data.Foldable
import Data.Functor.Identity
import Data.Int
import Data.IntMap.Strict qualified as IM
import Data.IntSet qualified as IS
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as M
import Data.Monoid qualified as Mon
import Data.Ord
import Data.Proxy
import Data.Ratio
import Data.Scientific qualified as Sci
import Data.Semigroup qualified as Sem
import Data.Sequence qualified as Seq
import Data.Set qualified as Set
import Data.Text qualified as T
import Data.Text.Builder.Linear qualified as B
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder qualified as TLB
import Data.Time
import Data.Time.Calendar.Month
import Data.Time.Calendar.Quarter
import Data.Time.ToText
import Data.Tree qualified as Tree
import Data.UUID.Types qualified as UUID
import Data.Void
import Data.Word
import Math.NumberTheory.Logarithms
import Numeric.Natural

import Yamlet.Internal.Schema
import Yamlet.Internal.Syntax qualified as S
import Yamlet.Internal.Utils
import Yamlet.Value

----------------------------------------
-- Class

-- | Types that can be converted to a node. A type with a
-- t'GHC.Generics.Generic' instance can derive the instance via
-- t'Yamlet.Generic.GenericYaml'.
--
-- An instance for a record writes a mapping with 'mapping' and '.=':
--
-- >>> :{
-- data Server = Server {host :: T.Text, port :: Int, tags :: [T.Text]}
-- instance ToYaml Server where
--   toYaml s = mapping ["host" .= s.host, "port" .= s.port, "tags" .= s.tags]
-- :}
--
-- >>> T.putStr (encodeText (Server "example.com" 80 ["web", "yes"]))
-- host: example.com
-- port: 80
-- tags:
-- - web
-- - 'yes'
--
-- The string @yes@ gets quotes, because YAML 1.1 parsers read it as a
-- boolean.
class ToYaml a where
  toYaml :: a -> S.Node

  -- | Convert a list. The instance for 'Char' creates a string instead.
  toYamlList :: [a] -> S.Node
  toYamlList = [Node] -> Node
S.sequenceNode ([Node] -> Node) -> ([a] -> [Node]) -> [a] -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Node) -> [a] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map a -> Node
forall a. ToYaml a => a -> Node
toYaml

  -- | Convert the value of a mapping entry, with the node of its key, e.g. to
  -- put comments on the key as 'Yamlet.Commented' does. '.=', the derived
  -- encoders and the instances for maps use it. The default returns the key
  -- unchanged.
  toYamlField :: S.Node -> a -> (S.Node, S.Node)
  toYamlField Node
k a
v = (Node
k, a -> Node
forall a. ToYaml a => a -> Node
toYaml a
v)

-- | An entry of a mapping with a string key.
(.=) :: ToYaml a => T.Text -> a -> (S.Node, S.Node)
Text
key .= :: forall a. ToYaml a => Text -> a -> (Node, Node)
.= a
v = Node -> a -> (Node, Node)
forall a. ToYaml a => Node -> a -> (Node, Node)
toYamlField (Text -> Node
string Text
key) a
v

infixr 8 .=

-- | A mapping with the entries in the given order. A mapping with two equal
-- keys does not read back.
mapping :: [(S.Node, S.Node)] -> S.Node
mapping :: [(Node, Node)] -> Node
mapping = [(Node, Node)] -> Node
S.mappingNode

instance ToYaml S.Node where toYaml :: Node -> Node
toYaml = Node -> Node
forall a. a -> a
id
instance ToYaml Value where toYaml :: Value -> Node
toYaml = Value -> Node
toSyntax

-- | The value with the comments of its entry. The lines above and the comment
-- of the first line go on the key, or on the value without a key. A key
-- keeps its own lines above, or its own comment, if the value has none. The
-- lines after the value replace its own.
instance ToYaml a => ToYaml (S.Commented a) where
  toYaml :: Commented a -> Node
toYaml Commented a
c =
    let v :: Node
v = [Line] -> Node -> Node
withLinesAfter Commented a
c.comments.after (a -> Node
forall a. ToYaml a => a -> Node
toYaml Commented a
c.value)
        vc :: Comments
vc = Node
v.comments
    in Comments -> Node -> Node
S.withComments
         Comments
vc
           { S.before = c.comments.before ++ vc.before
           , S.inline = c.comments.inline <|> vc.inline
           }
         Node
v
  toYamlField :: Node -> Commented a -> (Node, Node)
toYamlField Node
k Commented a
c = (Node
key, [Line] -> Node -> Node
withLinesAfter Commented a
c.comments.after (a -> Node
forall a. ToYaml a => a -> Node
toYaml Commented a
c.value))
    where
      -- In the syntax tree, the comments of an entry are on its key. The
      -- decoder gives them to the value too, because a key is not always a
      -- Haskell value. E.g. in
      --
      --   # c1
      --   permissions: # c2
      --     contents: read
      --
      -- a record field permissions :: Commented Node gets c1 and c2, and the
      -- encoder puts them back on the key.
      --
      -- A key that is a Haskell value gets them as well. E.g. in "a: 1 # c"
      -- decoded as Map (Commented Text) (Commented Int), the key and the
      -- value both have c. Comments that add up would be written twice, so
      -- those of the value replace those of the key.
      --
      -- A key keeps its own comments if the value has none, e.g. in a map
      -- that a program built with a comment only on the key.
      key :: S.Node
      key :: Node
key =
        Comments -> Node -> Node
S.withComments
          Node
k.comments
            { S.before = if null c.comments.before then k.comments.before else c.comments.before
            , S.inline = c.comments.inline <|> k.comments.inline
            }
          Node
k

-- | The value alone. The key of an entry goes to the value inside, e.g. for a
-- 'Yamlet.Commented' value.
instance ToYaml a => ToYaml (S.Located a) where
  toYaml :: Located a -> Node
toYaml Located a
l = a -> Node
forall a. ToYaml a => a -> Node
toYaml Located a
l.value
  toYamlField :: Node -> Located a -> (Node, Node)
toYamlField Node
k Located a
l = Node -> a -> (Node, Node)
forall a. ToYaml a => Node -> a -> (Node, Node)
toYamlField Node
k Located a
l.value

-- | The node with the given lines after it in place of its own, if the lines
-- are not empty.
withLinesAfter :: [S.Line] -> S.Node -> S.Node
withLinesAfter :: [Line] -> Node -> Node
withLinesAfter [Line]
ls Node
v
  | [Line] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Line]
ls = Node
v
  | Bool
otherwise = Comments -> Node -> Node
S.withComments Node
v.comments {S.after = ls} Node
v

-- | An empty list, as a tuple without elements.
instance ToYaml () where toYaml :: () -> Node
toYaml ()
_ = [Node] -> Node
S.sequenceNode []

instance ToYaml Bool where toYaml :: Bool -> Node
toYaml = Value -> Node
scalar (Value -> Node) -> (Bool -> Value) -> Bool -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Value
Bool
instance ToYaml Integer where toYaml :: Integer -> Node
toYaml = Value -> Node
scalar (Value -> Node) -> (Integer -> Value) -> Integer -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Value
Int
instance ToYaml Natural where toYaml :: Natural -> Node
toYaml = Natural -> Node
forall a. Integral a => a -> Node
integral
instance ToYaml Int where toYaml :: Int -> Node
toYaml = Int -> Node
forall a. Integral a => a -> Node
integral
instance ToYaml Int8 where toYaml :: Int8 -> Node
toYaml = Int8 -> Node
forall a. Integral a => a -> Node
integral
instance ToYaml Int16 where toYaml :: Int16 -> Node
toYaml = Int16 -> Node
forall a. Integral a => a -> Node
integral
instance ToYaml Int32 where toYaml :: Int32 -> Node
toYaml = Int32 -> Node
forall a. Integral a => a -> Node
integral
instance ToYaml Int64 where toYaml :: Int64 -> Node
toYaml = Int64 -> Node
forall a. Integral a => a -> Node
integral
instance ToYaml Word where toYaml :: Word -> Node
toYaml = Word -> Node
forall a. Integral a => a -> Node
integral
instance ToYaml Word8 where toYaml :: Word8 -> Node
toYaml = Word8 -> Node
forall a. Integral a => a -> Node
integral
instance ToYaml Word16 where toYaml :: Word16 -> Node
toYaml = Word16 -> Node
forall a. Integral a => a -> Node
integral
instance ToYaml Word32 where toYaml :: Word32 -> Node
toYaml = Word32 -> Node
forall a. Integral a => a -> Node
integral
instance ToYaml Word64 where toYaml :: Word64 -> Node
toYaml = Word64 -> Node
forall a. Integral a => a -> Node
integral

integral :: Integral a => a -> S.Node
integral :: forall a. Integral a => a -> Node
integral = Value -> Node
scalar (Value -> Node) -> (a -> Value) -> a -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Value
Int (Integer -> Value) -> (a -> Integer) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a. Integral a => a -> Integer
toInteger

-- | Decimal notation from 10^-6 up to 10^21, as JavaScript writes numbers,
-- and exponential notation otherwise. The text always has a dot, so that it
-- reads back as a float. A value that is not a number or is infinite is
-- @.nan@, @.inf@ or @-.inf@.
--
-- >>> T.putStr (encodeText [12, 0.01, 1.5e-7, 2.0e21, 0 / 0, -1 / 0 :: Double])
-- - 12.0
-- - 0.01
-- - 1.5e-7
-- - 2.0e+21
-- - .nan
-- - -.inf
instance ToYaml Double where toYaml :: Double -> Node
toYaml = Value -> Node
scalar (Value -> Node) -> (Double -> Value) -> Double -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatValue -> Value
Float (FloatValue -> Value) -> (Double -> FloatValue) -> Double -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> FloatValue
forall a. RealFloat a => a -> FloatValue
realFloatToFloatValue

instance ToYaml Float where toYaml :: Float -> Node
toYaml = Value -> Node
scalar (Value -> Node) -> (Float -> Value) -> Float -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatValue -> Value
Float (FloatValue -> Value) -> (Float -> FloatValue) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> FloatValue
forall a. RealFloat a => a -> FloatValue
realFloatToFloatValue

-- | A value whose exponent in scientific notation is beyond the range from
-- -1000 to 1000, e.g. @1e1001@, does not read back, see 'Finite'.
instance ToYaml Sci.Scientific where toYaml :: Scientific -> Node
toYaml = Value -> Node
scalar (Value -> Node) -> (Scientific -> Value) -> Scientific -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatValue -> Value
Float (FloatValue -> Value)
-> (Scientific -> FloatValue) -> Scientific -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> FloatValue
Finite

-- | The decoder accepts a year of at most 15 digits, so a larger year, e.g.
-- @10^15@, does not read back.
instance ToYaml Day where toYaml :: Day -> Node
toYaml = (Day -> Builder) -> Day -> Node
forall a. (a -> Builder) -> a -> Node
timestamp Day -> Builder
buildDay

instance ToYaml TimeOfDay where toYaml :: TimeOfDay -> Node
toYaml = (TimeOfDay -> Builder) -> TimeOfDay -> Node
forall a. (a -> Builder) -> a -> Node
iso8601 TimeOfDay -> Builder
timeOfDay

-- | The decoder accepts a year of at most 15 digits, so a larger year does
-- not read back.
instance ToYaml LocalTime where toYaml :: LocalTime -> Node
toYaml = (LocalTime -> Builder) -> LocalTime -> Node
forall a. (a -> Builder) -> a -> Node
timestamp LocalTime -> Builder
localTime

-- | The decoder accepts an offset of less than 24 hours, so a larger offset,
-- e.g. @+25:00@, does not read back. Neither does a year of more than 15
-- digits.
instance ToYaml ZonedTime where
  toYaml :: ZonedTime -> Node
toYaml = (ZonedTime -> Builder) -> ZonedTime -> Node
forall a. (a -> Builder) -> a -> Node
timestamp (\(ZonedTime LocalTime
t TimeZone
z) -> LocalTime -> Builder
localTime LocalTime
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TimeZone -> Builder
buildTimeZone TimeZone
z)

-- | The decoder accepts a year of at most 15 digits, so a larger year does
-- not read back.
instance ToYaml UTCTime where
  toYaml :: UTCTime -> Node
toYaml =
    (UTCTime -> Builder) -> UTCTime -> Node
forall a. (a -> Builder) -> a -> Node
timestamp (\(UTCTime Day
d DiffTime
s) -> LocalTime -> Builder
localTime (Day -> TimeOfDay -> LocalTime
LocalTime Day
d (DiffTime -> TimeOfDay
timeToTimeOfDay DiffTime
s)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"Z")

-- | The time of day without the trailing zeros of the fraction, e.g.
-- @12:30:15.5@, as in aeson. text-iso8601 writes the fraction in groups of
-- three digits.
timeOfDay :: TimeOfDay -> TLB.Builder
timeOfDay :: TimeOfDay -> Builder
timeOfDay (TimeOfDay Int
h Int
m (MkFixed Integer
ps)) =
  TimeOfDay -> Builder
buildTimeOfDay (Int -> Int -> Fixed E12 -> TimeOfDay
TimeOfDay Int
h Int
m (Integer -> Fixed E12
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer
ps Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
frac))) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fraction
  where
    frac :: Integer
    frac :: Integer
frac = Integer
ps Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` (Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
picoDecimals)

    fraction :: TLB.Builder
    fraction :: Builder
fraction
      | Integer
frac Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Builder
forall a. Monoid a => a
mempty
      | Bool
otherwise =
          Builder
"."
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TLB.fromText
              ( (Char -> Bool) -> Text -> Text
T.dropWhileEnd
                  (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0')
                  (Int -> Char -> Text -> Text
T.justifyRight Int
picoDecimals Char
'0' (String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
frac)))
              )

localTime :: LocalTime -> TLB.Builder
localTime :: LocalTime -> Builder
localTime (LocalTime Day
d TimeOfDay
t) = Day -> Builder
buildDay Day
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"T" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TimeOfDay -> Builder
timeOfDay TimeOfDay
t

-- | A number of seconds. A value whose exponent in scientific notation is
-- beyond the range from -1000 to 1000, e.g. @10^1001@ seconds, does not read
-- back, see 'Finite'.
instance ToYaml NominalDiffTime where
  toYaml :: NominalDiffTime -> Node
toYaml NominalDiffTime
d = let MkFixed Integer
ps = NominalDiffTime -> Fixed E12
nominalDiffTimeToSeconds NominalDiffTime
d in Integer -> Node
seconds Integer
ps

-- | A number of seconds. A value whose exponent in scientific notation is
-- beyond the range from -1000 to 1000, e.g. @10^1001@ seconds, does not read
-- back, see 'Finite'.
instance ToYaml DiffTime where
  toYaml :: DiffTime -> Node
toYaml = Integer -> Node
seconds (Integer -> Node) -> (DiffTime -> Integer) -> DiffTime -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Integer
diffTimeToPicoseconds

-- | The seconds of a number of picoseconds.
seconds :: Integer -> S.Node
seconds :: Integer -> Node
seconds Integer
ps = Value -> Node
scalar (FloatValue -> Value
Float (Scientific -> FloatValue
Finite (Integer -> Int -> Scientific
Sci.scientific Integer
ps (Int -> Int
forall a. Num a => a -> a
negate Int
picoDecimals))))

-- | The text form with hyphens, e.g. @123e4567-e89b-12d3-a456-426614174000@.
instance ToYaml UUID.UUID where toYaml :: UUID -> Node
toYaml = Value -> Node
scalar (Value -> Node) -> (UUID -> Value) -> UUID -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String (Text -> Value) -> (UUID -> Text) -> UUID -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
UUID.toText

-- | The decoder accepts a year of at most 15 digits, so a larger year does
-- not read back.
instance ToYaml Month where toYaml :: Month -> Node
toYaml = (Month -> Builder) -> Month -> Node
forall a. (a -> Builder) -> a -> Node
iso8601 Month -> Builder
buildMonth

-- | The decoder accepts a year of at most 15 digits, so a larger year does
-- not read back.
instance ToYaml Quarter where toYaml :: Quarter -> Node
toYaml = (Quarter -> Builder) -> Quarter -> Node
forall a. (a -> Builder) -> a -> Node
iso8601 Quarter -> Builder
buildQuarter

instance ToYaml QuarterOfYear where toYaml :: QuarterOfYear -> Node
toYaml = (QuarterOfYear -> Builder) -> QuarterOfYear -> Node
forall a. (a -> Builder) -> a -> Node
iso8601 QuarterOfYear -> Builder
buildQuarterOfYear

-- | A string in an ISO 8601 format, the same as in aeson.
iso8601 :: (a -> TLB.Builder) -> a -> S.Node
iso8601 :: forall a. (a -> Builder) -> a -> Node
iso8601 a -> Builder
build = Value -> Node
scalar (Value -> Node) -> (a -> Value) -> a -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String (Text -> Value) -> (a -> Text) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyText -> Text
TL.toStrict (LazyText -> Text) -> (a -> LazyText) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
TLB.toLazyText (Builder -> LazyText) -> (a -> Builder) -> a -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
build

-- | Like 'iso8601', but plain if YAML 1.1 reads the text as a timestamp,
-- because the value is one.
timestamp :: (a -> TLB.Builder) -> a -> S.Node
timestamp :: forall a. (a -> Builder) -> a -> Node
timestamp a -> Builder
build a
x
  | Text -> Bool
isPlainString Text
t Bool -> Bool -> Bool
&& (Text -> Bool
isYaml11Timestamp Text
t Bool -> Bool -> Bool
|| Bool -> Bool
not (Text -> Bool
isYaml11NonString Text
t)) = Text -> Node
S.plainNode Text
t
  | Bool
otherwise = Text -> Node
string Text
t
  where
    t :: T.Text
    t :: Text
t = LazyText -> Text
TL.toStrict (Builder -> LazyText
TLB.toLazyText (a -> Builder
build a
x))

-- | The English name in lowercase, e.g. @monday@.
instance ToYaml DayOfWeek where
  toYaml :: DayOfWeek -> Node
toYaml = Value -> Node
scalar (Value -> Node) -> (DayOfWeek -> Value) -> DayOfWeek -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String (Text -> Value) -> (DayOfWeek -> Text) -> DayOfWeek -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (DayOfWeek -> Text) -> DayOfWeek -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (DayOfWeek -> String) -> DayOfWeek -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfWeek -> String
forall a. Show a => a -> String
show

-- | A mapping with the keys @months@ and @days@, e.g. @{months: 1, days: 2}@.
instance ToYaml CalendarDiffDays where
  toYaml :: CalendarDiffDays -> Node
toYaml CalendarDiffDays
d = [(Node, Node)] -> Node
mapping [Text
"months" Text -> Integer -> (Node, Node)
forall a. ToYaml a => Text -> a -> (Node, Node)
.= CalendarDiffDays -> Integer
cdMonths CalendarDiffDays
d, Text
"days" Text -> Integer -> (Node, Node)
forall a. ToYaml a => Text -> a -> (Node, Node)
.= CalendarDiffDays -> Integer
cdDays CalendarDiffDays
d]

-- | A mapping with the keys @months@ and @time@, a number of seconds, e.g.
-- @{months: 1, time: 1.5}@.
instance ToYaml CalendarDiffTime where
  toYaml :: CalendarDiffTime -> Node
toYaml CalendarDiffTime
d = [(Node, Node)] -> Node
mapping [Text
"months" Text -> Integer -> (Node, Node)
forall a. ToYaml a => Text -> a -> (Node, Node)
.= CalendarDiffTime -> Integer
ctMonths CalendarDiffTime
d, Text
"time" Text -> NominalDiffTime -> (Node, Node)
forall a. ToYaml a => Text -> a -> (Node, Node)
.= CalendarDiffTime -> NominalDiffTime
ctTime CalendarDiffTime
d]

instance ToYaml T.Text where toYaml :: Text -> Node
toYaml = Value -> Node
scalar (Value -> Node) -> (Text -> Value) -> Text -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String
instance ToYaml TL.Text where toYaml :: LazyText -> Node
toYaml = Value -> Node
scalar (Value -> Node) -> (LazyText -> Value) -> LazyText -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String (Text -> Value) -> (LazyText -> Text) -> LazyText -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyText -> Text
TL.toStrict

-- | A string of the character, and a t'String' as a string. A surrogate code
-- point, which t'Data.Text.Text' cannot hold, becomes U+FFFD, so it does not
-- read back.
instance ToYaml Char where
  toYaml :: Char -> Node
toYaml = Value -> Node
scalar (Value -> Node) -> (Char -> Value) -> Char -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String (Text -> Value) -> (Char -> Text) -> Char -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton
  toYamlList :: String -> Node
toYamlList = Value -> Node
scalar (Value -> Node) -> (String -> Value) -> String -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance ToYaml a => ToYaml [a] where
  toYaml :: [a] -> Node
toYaml = [a] -> Node
forall a. ToYaml a => [a] -> Node
toYamlList

instance ToYaml a => ToYaml (NE.NonEmpty a) where
  toYaml :: NonEmpty a -> Node
toYaml = [a] -> Node
forall a. ToYaml a => [a] -> Node
items ([a] -> Node) -> (NonEmpty a -> [a]) -> NonEmpty a -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList

-- | 'Nothing' is null. @'Just' 'Nothing'@ is null too, so it reads back as
-- 'Nothing', as in aeson. The key of an entry goes to the value inside, e.g.
-- for a 'Yamlet.Commented' value.
instance ToYaml a => ToYaml (Maybe a) where
  toYaml :: Maybe a -> Node
toYaml = Node -> (a -> Node) -> Maybe a -> Node
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Value -> Node
scalar Value
Null) a -> Node
forall a. ToYaml a => a -> Node
toYaml
  toYamlField :: Node -> Maybe a -> (Node, Node)
toYamlField Node
k = (Node, Node) -> (a -> (Node, Node)) -> Maybe a -> (Node, Node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node
k, Value -> Node
scalar Value
Null) (Node -> a -> (Node, Node)
forall a. ToYaml a => Node -> a -> (Node, Node)
toYamlField Node
k)

-- | Two keys that give equal nodes give a mapping that does not read back,
-- e.g. 'Nothing' and @'Just' 'Nothing'@, two NaN values, or two v'Mapping'
-- values with the same entries in a different order.
instance (ToYaml k, ToYaml v) => ToYaml (M.Map k v) where
  toYaml :: Map k v -> Node
toYaml Map k v
m = [(Node, Node)] -> Node
mapping [Node -> v -> (Node, Node)
forall a. ToYaml a => Node -> a -> (Node, Node)
toYamlField (k -> Node
forall a. ToYaml a => a -> Node
toYaml k
k) v
v | (k
k, v
v) <- Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
M.toList Map k v
m]

instance ToYaml v => ToYaml (IM.IntMap v) where
  toYaml :: IntMap v -> Node
toYaml IntMap v
m = [(Node, Node)] -> Node
mapping [Node -> v -> (Node, Node)
forall a. ToYaml a => Node -> a -> (Node, Node)
toYamlField (Int -> Node
forall a. ToYaml a => a -> Node
toYaml Int
k) v
v | (Int
k, v
v) <- IntMap v -> [(Int, v)]
forall a. IntMap a -> [(Int, a)]
IM.toList IntMap v
m]

-- | A list in ascending order.
instance ToYaml a => ToYaml (Set.Set a) where
  toYaml :: Set a -> Node
toYaml = [a] -> Node
forall a. ToYaml a => [a] -> Node
items ([a] -> Node) -> (Set a -> [a]) -> Set a -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toAscList

-- | A list in ascending order.
instance ToYaml IS.IntSet where
  toYaml :: IntSet -> Node
toYaml = [Int] -> Node
forall a. ToYaml a => a -> Node
toYaml ([Int] -> Node) -> (IntSet -> [Int]) -> IntSet -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IS.toAscList

instance ToYaml a => ToYaml (Seq.Seq a) where
  toYaml :: Seq a -> Node
toYaml = [a] -> Node
forall a. ToYaml a => [a] -> Node
items ([a] -> Node) -> (Seq a -> [a]) -> Seq a -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | A sequence of the items. Unlike a list, it is never a string, e.g. for
-- items of type 'Char', because only t'String' is text.
items :: ToYaml a => [a] -> S.Node
items :: forall a. ToYaml a => [a] -> Node
items = [Node] -> Node
S.sequenceNode ([Node] -> Node) -> ([a] -> [Node]) -> [a] -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Node) -> [a] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map a -> Node
forall a. ToYaml a => a -> Node
toYaml

-- | A list of the label and the subtrees, e.g. @[a, [[b, []]]]@.
instance ToYaml a => ToYaml (Tree.Tree a) where
  toYaml :: Tree a -> Node
toYaml Tree a
t = (a, [Tree a]) -> Node
forall a. ToYaml a => a -> Node
toYaml (Tree a -> a
forall a. Tree a -> a
Tree.rootLabel Tree a
t, Tree a -> [Tree a]
forall a. Tree a -> [Tree a]
Tree.subForest Tree a
t)

-- | @LT@, @EQ@ or @GT@.
instance ToYaml Ordering where
  toYaml :: Ordering -> Node
toYaml = Value -> Node
scalar (Value -> Node) -> (Ordering -> Value) -> Ordering -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String (Text -> Value) -> (Ordering -> Text) -> Ordering -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Ordering -> String) -> Ordering -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ordering -> String
forall a. Show a => a -> String
show

instance ToYaml Void where
  toYaml :: Void -> Node
toYaml = Void -> Node
forall a. Void -> a
absurd

-- | A mapping with the keys @numerator@ and @denominator@, e.g.
-- @{numerator: 1, denominator: 3}@.
instance (Integral a, ToYaml a) => ToYaml (Ratio a) where
  toYaml :: Ratio a -> Node
toYaml Ratio a
r = [(Node, Node)] -> Node
mapping [Text
"numerator" Text -> a -> (Node, Node)
forall a. ToYaml a => Text -> a -> (Node, Node)
.= Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r, Text
"denominator" Text -> a -> (Node, Node)
forall a. ToYaml a => Text -> a -> (Node, Node)
.= Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r]

-- | A number. If the resolution is not a product of 2s and 5s, e.g. 3, a value
-- can have no exact decimal form. It then becomes the nearest number with as
-- many digits after the point as the resolution has, which does not read back.
-- For such a resolution, use 'Rational' instead.
--
-- A value whose exponent in scientific notation is beyond the range from
-- -1000 to 1000, e.g. @10^1001@, does not read back, see 'Finite'.
instance HasResolution a => ToYaml (Fixed a) where
  toYaml :: Fixed a -> Node
toYaml (MkFixed Integer
n) = Value -> Node
scalar (Value -> Node) -> (Scientific -> Value) -> Scientific -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatValue -> Value
Float (FloatValue -> Value)
-> (Scientific -> FloatValue) -> Scientific -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> FloatValue
Finite (Scientific -> Node) -> Scientific -> Node
forall a b. (a -> b) -> a -> b
$ case Integer -> Maybe Int
decimalPlaces Integer
res of
    Just Int
places -> Integer -> Int -> Scientific
Sci.scientific (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
places Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
res)) (Int -> Int
forall a. Num a => a -> a
negate Int
places)
    Maybe Int
Nothing -> Integer -> Int -> Scientific
Sci.scientific (Ratio Integer -> Integer
forall b. Integral b => Ratio Integer -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
digits Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
res)) (Int -> Int
forall a. Num a => a -> a
negate Int
digits)
    where
      res :: Integer
      res :: Integer
res = Proxy a -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
forall (p :: k -> *). p a -> Integer
resolution (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)

      digits :: Int
      digits :: Int
digits = Integer -> Int
integerLog10 Integer
res Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | The value inside.
deriving newtype instance ToYaml a => ToYaml (Identity a)

-- | The value inside.
deriving newtype instance ToYaml a => ToYaml (Const a b)

-- | The value inside.
deriving newtype instance ToYaml a => ToYaml (Down a)

-- | The value inside.
deriving newtype instance ToYaml a => ToYaml (Sem.Min a)

-- | The value inside.
deriving newtype instance ToYaml a => ToYaml (Sem.Max a)

-- | The value inside.
deriving newtype instance ToYaml a => ToYaml (Sem.First a)

-- | The value inside.
deriving newtype instance ToYaml a => ToYaml (Sem.Last a)

-- | The value inside, or null for 'Nothing'.
deriving newtype instance ToYaml a => ToYaml (Mon.First a)

-- | The value inside, or null for 'Nothing'.
deriving newtype instance ToYaml a => ToYaml (Mon.Last a)

-- | The value inside.
deriving newtype instance ToYaml a => ToYaml (Sem.Dual a)

-- | The value inside.
deriving newtype instance ToYaml a => ToYaml (Sem.Sum a)

-- | The value inside.
deriving newtype instance ToYaml a => ToYaml (Sem.Product a)

-- | The value inside.
deriving newtype instance ToYaml Sem.All

-- | The value inside.
deriving newtype instance ToYaml Sem.Any

-- | A mapping with one key, @Left@ or @Right@, e.g. @{Left: 1}@.
instance (ToYaml a, ToYaml b) => ToYaml (Either a b) where
  toYaml :: Either a b -> Node
toYaml = \case
    Left a
a -> [(Node, Node)] -> Node
mapping [Text
"Left" Text -> a -> (Node, Node)
forall a. ToYaml a => Text -> a -> (Node, Node)
.= a
a]
    Right b
b -> [(Node, Node)] -> Node
mapping [Text
"Right" Text -> b -> (Node, Node)
forall a. ToYaml a => Text -> a -> (Node, Node)
.= b
b]

instance (ToYaml a1, ToYaml a2) => ToYaml (a1, a2) where
  toYaml :: (a1, a2) -> Node
toYaml (a1
a1, a2
a2) =
    [Node] -> Node
S.sequenceNode
      [ a1 -> Node
forall a. ToYaml a => a -> Node
toYaml a1
a1
      , a2 -> Node
forall a. ToYaml a => a -> Node
toYaml a2
a2
      ]

instance (ToYaml a1, ToYaml a2, ToYaml a3) => ToYaml (a1, a2, a3) where
  toYaml :: (a1, a2, a3) -> Node
toYaml (a1
a1, a2
a2, a3
a3) =
    [Node] -> Node
S.sequenceNode
      [ a1 -> Node
forall a. ToYaml a => a -> Node
toYaml a1
a1
      , a2 -> Node
forall a. ToYaml a => a -> Node
toYaml a2
a2
      , a3 -> Node
forall a. ToYaml a => a -> Node
toYaml a3
a3
      ]

instance (ToYaml a1, ToYaml a2, ToYaml a3, ToYaml a4) => ToYaml (a1, a2, a3, a4) where
  toYaml :: (a1, a2, a3, a4) -> Node
toYaml (a1
a1, a2
a2, a3
a3, a4
a4) =
    [Node] -> Node
S.sequenceNode
      [ a1 -> Node
forall a. ToYaml a => a -> Node
toYaml a1
a1
      , a2 -> Node
forall a. ToYaml a => a -> Node
toYaml a2
a2
      , a3 -> Node
forall a. ToYaml a => a -> Node
toYaml a3
a3
      , a4 -> Node
forall a. ToYaml a => a -> Node
toYaml a4
a4
      ]

instance
  (ToYaml a1, ToYaml a2, ToYaml a3, ToYaml a4, ToYaml a5)
  => ToYaml (a1, a2, a3, a4, a5)
  where
  toYaml :: (a1, a2, a3, a4, a5) -> Node
toYaml (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5) =
    [Node] -> Node
S.sequenceNode
      [ a1 -> Node
forall a. ToYaml a => a -> Node
toYaml a1
a1
      , a2 -> Node
forall a. ToYaml a => a -> Node
toYaml a2
a2
      , a3 -> Node
forall a. ToYaml a => a -> Node
toYaml a3
a3
      , a4 -> Node
forall a. ToYaml a => a -> Node
toYaml a4
a4
      , a5 -> Node
forall a. ToYaml a => a -> Node
toYaml a5
a5
      ]

instance
  (ToYaml a1, ToYaml a2, ToYaml a3, ToYaml a4, ToYaml a5, ToYaml a6)
  => ToYaml (a1, a2, a3, a4, a5, a6)
  where
  toYaml :: (a1, a2, a3, a4, a5, a6) -> Node
toYaml (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6) =
    [Node] -> Node
S.sequenceNode
      [ a1 -> Node
forall a. ToYaml a => a -> Node
toYaml a1
a1
      , a2 -> Node
forall a. ToYaml a => a -> Node
toYaml a2
a2
      , a3 -> Node
forall a. ToYaml a => a -> Node
toYaml a3
a3
      , a4 -> Node
forall a. ToYaml a => a -> Node
toYaml a4
a4
      , a5 -> Node
forall a. ToYaml a => a -> Node
toYaml a5
a5
      , a6 -> Node
forall a. ToYaml a => a -> Node
toYaml a6
a6
      ]

instance
  (ToYaml a1, ToYaml a2, ToYaml a3, ToYaml a4, ToYaml a5, ToYaml a6, ToYaml a7)
  => ToYaml (a1, a2, a3, a4, a5, a6, a7)
  where
  toYaml :: (a1, a2, a3, a4, a5, a6, a7) -> Node
toYaml (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6, a7
a7) =
    [Node] -> Node
S.sequenceNode
      [ a1 -> Node
forall a. ToYaml a => a -> Node
toYaml a1
a1
      , a2 -> Node
forall a. ToYaml a => a -> Node
toYaml a2
a2
      , a3 -> Node
forall a. ToYaml a => a -> Node
toYaml a3
a3
      , a4 -> Node
forall a. ToYaml a => a -> Node
toYaml a4
a4
      , a5 -> Node
forall a. ToYaml a => a -> Node
toYaml a5
a5
      , a6 -> Node
forall a. ToYaml a => a -> Node
toYaml a6
a6
      , a7 -> Node
forall a. ToYaml a => a -> Node
toYaml a7
a7
      ]

instance
  (ToYaml a1, ToYaml a2, ToYaml a3, ToYaml a4, ToYaml a5, ToYaml a6, ToYaml a7, ToYaml a8)
  => ToYaml (a1, a2, a3, a4, a5, a6, a7, a8)
  where
  toYaml :: (a1, a2, a3, a4, a5, a6, a7, a8) -> Node
toYaml (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6, a7
a7, a8
a8) =
    [Node] -> Node
S.sequenceNode
      [ a1 -> Node
forall a. ToYaml a => a -> Node
toYaml a1
a1
      , a2 -> Node
forall a. ToYaml a => a -> Node
toYaml a2
a2
      , a3 -> Node
forall a. ToYaml a => a -> Node
toYaml a3
a3
      , a4 -> Node
forall a. ToYaml a => a -> Node
toYaml a4
a4
      , a5 -> Node
forall a. ToYaml a => a -> Node
toYaml a5
a5
      , a6 -> Node
forall a. ToYaml a => a -> Node
toYaml a6
a6
      , a7 -> Node
forall a. ToYaml a => a -> Node
toYaml a7
a7
      , a8 -> Node
forall a. ToYaml a => a -> Node
toYaml a8
a8
      ]

instance
  ( ToYaml a1
  , ToYaml a2
  , ToYaml a3
  , ToYaml a4
  , ToYaml a5
  , ToYaml a6
  , ToYaml a7
  , ToYaml a8
  , ToYaml a9
  )
  => ToYaml (a1, a2, a3, a4, a5, a6, a7, a8, a9)
  where
  toYaml :: (a1, a2, a3, a4, a5, a6, a7, a8, a9) -> Node
toYaml (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6, a7
a7, a8
a8, a9
a9) =
    [Node] -> Node
S.sequenceNode
      [ a1 -> Node
forall a. ToYaml a => a -> Node
toYaml a1
a1
      , a2 -> Node
forall a. ToYaml a => a -> Node
toYaml a2
a2
      , a3 -> Node
forall a. ToYaml a => a -> Node
toYaml a3
a3
      , a4 -> Node
forall a. ToYaml a => a -> Node
toYaml a4
a4
      , a5 -> Node
forall a. ToYaml a => a -> Node
toYaml a5
a5
      , a6 -> Node
forall a. ToYaml a => a -> Node
toYaml a6
a6
      , a7 -> Node
forall a. ToYaml a => a -> Node
toYaml a7
a7
      , a8 -> Node
forall a. ToYaml a => a -> Node
toYaml a8
a8
      , a9 -> Node
forall a. ToYaml a => a -> Node
toYaml a9
a9
      ]

instance
  ( ToYaml a1
  , ToYaml a2
  , ToYaml a3
  , ToYaml a4
  , ToYaml a5
  , ToYaml a6
  , ToYaml a7
  , ToYaml a8
  , ToYaml a9
  , ToYaml a10
  )
  => ToYaml (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)
  where
  toYaml :: (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> Node
toYaml (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6, a7
a7, a8
a8, a9
a9, a10
a10) =
    [Node] -> Node
S.sequenceNode
      [ a1 -> Node
forall a. ToYaml a => a -> Node
toYaml a1
a1
      , a2 -> Node
forall a. ToYaml a => a -> Node
toYaml a2
a2
      , a3 -> Node
forall a. ToYaml a => a -> Node
toYaml a3
a3
      , a4 -> Node
forall a. ToYaml a => a -> Node
toYaml a4
a4
      , a5 -> Node
forall a. ToYaml a => a -> Node
toYaml a5
a5
      , a6 -> Node
forall a. ToYaml a => a -> Node
toYaml a6
a6
      , a7 -> Node
forall a. ToYaml a => a -> Node
toYaml a7
a7
      , a8 -> Node
forall a. ToYaml a => a -> Node
toYaml a8
a8
      , a9 -> Node
forall a. ToYaml a => a -> Node
toYaml a9
a9
      , a10 -> Node
forall a. ToYaml a => a -> Node
toYaml a10
a10
      ]

----------------------------------------
-- Nodes

-- | The node of a value.
toSyntax :: Value -> S.Node
toSyntax :: Value -> Node
toSyntax = \case
  Sequence [Value]
xs -> [Node] -> Node
S.sequenceNode ((Value -> Node) -> [Value] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Node
toSyntax [Value]
xs)
  Mapping [(Value, Value)]
kvs -> [(Node, Node)] -> Node
S.mappingNode [(Value -> Node
toSyntax Value
k, Value -> Node
toSyntax Value
v) | (Value
k, Value
v) <- [(Value, Value)]
kvs]
  Tagged Text
tag Value
v
    | Text -> Int -> Ordering
T.compareLength Text
tag Int
1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT -> (Value -> Node
toSyntax Value
v) {S.props = S.Props Nothing (S.Tag tag)}
    -- YAML has no syntax for such a tag. The non-specific tag ! would make
    -- the value a string in YAML 1.2, but not in YAML 1.1 parsers.
    | Bool
otherwise -> Value -> Node
toSyntax Value
v
  Value
v -> Value -> Node
scalar Value
v

-- | A scalar in a style that reads back as the value. For a collection or a
-- tagged value, use 'toSyntax'.
scalar :: Value -> S.Node
scalar :: Value -> Node
scalar = \case
  String Text
t -> Text -> Node
string Text
t
  Value
v -> Text -> Node
S.plainNode (Value -> Text
plainText Value
v)

-- | A string as a literal block scalar if it has a line break. A text of
-- only line breaks is in double quotes, because quotes are easier to read
-- than empty lines. Otherwise it is a plain scalar if the schema reads the
-- text as a string, and in single quotes if not. The renderer puts a plain
-- scalar in quotes if its text cannot be plain, e.g. @a: b@. It uses double
-- quotes for a text with a tab or a character that single quotes cannot
-- hold.
--
-- A text that YAML 1.1 reads as another type, e.g. @yes@ or @12:30@, is in
-- quotes too, because many parsers still follow YAML 1.1.
string :: T.Text -> S.Node
string :: Text -> Node
string Text
t
  | (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
t, Bool -> Bool
not (Text -> Bool
T.null Text
t) = ScalarStyle -> Text -> Node
S.scalarNode ScalarStyle
S.DoubleQuoted Text
t
  | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
t = ScalarStyle -> Text -> Node
S.scalarNode ScalarStyle
S.Literal Text
t
  | Text -> Bool
isPlainString Text
t Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
isYaml11NonString Text
t) = Text -> Node
S.plainNode Text
t
  | Bool
otherwise = ScalarStyle -> Text -> Node
S.scalarNode ScalarStyle
S.SingleQuoted Text
t

-- | The text of a scalar value without quotes.
plainText :: Value -> T.Text
plainText :: Value -> Text
plainText = \case
  Value
Null -> Text
"null"
  Bool Bool
b -> if Bool
b then Text
"true" else Text
"false"
  Int Integer
i -> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
i)
  Float (Finite Scientific
s) -> Scientific -> Text
finite Scientific
s
  Float FloatValue
Infinity -> Text
".inf"
  Float FloatValue
NegativeZero -> Text
"-0.0"
  Float FloatValue
NegativeInfinity -> Text
"-.inf"
  Float FloatValue
NaN -> Text
".nan"
  String Text
t -> Text
t
  Sequence [Value]
_ -> Text
"[]"
  Mapping [(Value, Value)]
_ -> Text
"{}"
  Tagged Text
_ Value
v -> Value -> Text
plainText Value
v
  where
    -- Decimal notation for the exponents from 'minDecimal' to 'maxDecimal',
    -- and exponential notation for other numbers. The text always has a dot,
    -- so the number reads back as a float, not as an integer.
    -- The exponent of Sci.formatScientific overflows close to the upper limit
    -- of Int.
    finite :: Sci.Scientific -> T.Text
    finite :: Scientific -> Text
finite Scientific
s = case Text -> Maybe (Char, Text)
T.uncons Text
digits of
      Maybe (Char, Text)
Nothing -> Text
"0.0"
      Just (Char
d, Text
rest)
        | Integer
ex Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
minDecimal Bool -> Bool -> Bool
&& Integer
ex Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 ->
            [Text] -> Text
T.concat [Text
sign, Text
"0.", Int -> Text -> Text
T.replicate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer
forall a. Num a => a -> a
negate Integer
ex Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)) Text
"0", Text
digits]
        | Integer
ex Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
ex Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxDecimal ->
            let (Text
int, Text
frac) = Int -> Text -> (Text, Text)
T.splitAt Int
integerDigits Text
digits
            in [Text] -> Text
T.concat [Text
sign, Int -> Char -> Text -> Text
T.justifyLeft Int
integerDigits Char
'0' Text
int, Text
".", Text -> Text
orZero Text
frac]
        -- YAML 1.1 reads an exponent without a sign as a string.
        | Bool
otherwise ->
            [Text] -> Text
T.concat
              [ Text
sign
              , Char -> Text
T.singleton Char
d
              , Text
"."
              , Text -> Text
orZero Text
rest
              , if Integer
ex Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Text
"e" else Text
"e+"
              , Integer -> Text
decimal Integer
ex
              ]
      where
        c :: Integer
        c :: Integer
c = Scientific -> Integer
Sci.coefficient Scientific
s

        written :: T.Text
        written :: Text
written = Integer -> Text
decimal (Integer -> Integer
forall a. Num a => a -> a
abs Integer
c)

        digits :: T.Text
        digits :: Text
digits = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0') Text
written

        -- The exponent of the first digit.
        ex :: Integer
        ex :: Integer
ex = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Scientific -> Int
Sci.base10Exponent Scientific
s) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Text -> Int
T.length Text
written) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1

        integerDigits :: Int
        integerDigits :: Int
integerDigits = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        sign :: T.Text
        sign :: Text
sign = if Integer
c Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Text
"-" else Text
""

        orZero :: T.Text -> T.Text
        orZero :: Text -> Text
orZero Text
t = if Text -> Bool
T.null Text
t then Text
"0" else Text
t

        decimal :: Integer -> T.Text
        decimal :: Integer -> Text
decimal = Builder -> Text
Builder -> Text
B.runBuilder (Builder -> Text) -> (Integer -> Builder) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Builder
forall a. Integral a => a -> Builder
B.fromUnboundedDec

        -- The exponents of the first digit that Number::toString of
        -- ECMAScript writes in decimal notation, for the numbers from 10^-6
        -- up to 10^21. JSON.stringify uses the same notation.
        minDecimal, maxDecimal :: Integer
        minDecimal :: Integer
minDecimal = -Integer
6
        maxDecimal :: Integer
maxDecimal = Integer
20

-- $setup
-- >>> import Data.Text.IO qualified as T
-- >>> import Yamlet