{-# Language TypeFamilies #-}
{-|
Module      : Toml.Schema.FromValue
Description : Automation for converting TOML values to application values.
Copyright   : (c) Eric Mertens, 2023
License     : ISC
Maintainer  : emertens@gmail.com

Use 'FromValue' to define a transformation from some 'Value' to an application
domain type.

Use 'ParseTable' to help build 'FromValue' instances that match tables. It
will make it easy to track which table keys have been used and which are left
over.

Warnings can be emitted using 'warn' and 'warnTable' (depending on what)
context you're in. These warnings can provide useful feedback about
problematic values or keys that might be unused now but were perhaps
meaningful in an old version of a configuration file.

"Toml.Schema.FromValue.Generic" can be used to derive instances of 'FromValue'
automatically for record types.

-}
module Toml.Schema.FromValue (
    -- * Deserialization classes
    FromValue(..),
    FromKey(..),

    -- * Containers
    mapOf,
    listOf,

    -- * Tables
    parseTableFromValue,
    reqKey,
    reqKeyOf,
    optKey,
    optKeyOf,

    -- * Errors
    typeError,

    ) where

import Control.Monad (zipWithM, liftM2)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Ratio (Ratio)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Lazy qualified
import Data.Time (ZonedTime, LocalTime, Day, TimeOfDay)
import Data.Word (Word8, Word16, Word32, Word64)
import Numeric.Natural (Natural)
import Toml.Schema.Matcher
import Toml.Schema.ParseTable
import Toml.Semantics

-- | Table matching function used to help implement 'fromValue' for tables.
-- Key matching function is given the annotation of the key for error reporting.
-- Value matching function is given the key in case values can depend on their keys.
mapOf ::
    Ord k =>
    (l -> Text -> Matcher l k)         {- ^ key matcher   -} ->
    (Text -> Value' l -> Matcher l v)  {- ^ value matcher -} ->
    Value' l -> Matcher l (Map k v)
mapOf :: forall k l v.
Ord k =>
(l -> Text -> Matcher l k)
-> (Text -> Value' l -> Matcher l v)
-> Value' l
-> Matcher l (Map k v)
mapOf l -> Text -> Matcher l k
matchKey Text -> Value' l -> Matcher l v
matchVal =
    \case
        Table' l
_ (MkTable Map Text (l, Value' l)
t) -> [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, v)] -> Map k v) -> Matcher l [(k, v)] -> Matcher l (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Matcher l (k, v)] -> Matcher l [(k, v)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Matcher l (k, v)]
kvs
            where
                kvs :: [Matcher l (k, v)]
kvs = [(k -> v -> (k, v))
-> Matcher l k -> Matcher l v -> Matcher l (k, v)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (l -> Text -> Matcher l k
matchKey l
l Text
k) (Text -> Matcher l v -> Matcher l v
forall l a. Text -> Matcher l a -> Matcher l a
inKey Text
k (Text -> Value' l -> Matcher l v
matchVal Text
k Value' l
v)) | (Text
k, (l
l, Value' l
v)) <- Map Text (l, Value' l) -> [(Text, (l, Value' l))]
forall k a. Map k a -> [(k, a)]
Map.assocs Map Text (l, Value' l)
t]
        Value' l
v -> String -> Value' l -> Matcher l (Map k v)
forall l a. String -> Value' l -> Matcher l a
typeError String
"table" Value' l
v

-- | List matching function used to help implemented 'fromValue' for arrays.
-- The element matching function is given the list index in case values can
-- depend on their index.
listOf ::
    (Int -> Value' l -> Matcher l a) ->
    Value' l -> Matcher l [a]
listOf :: forall l a.
(Int -> Value' l -> Matcher l a) -> Value' l -> Matcher l [a]
listOf Int -> Value' l -> Matcher l a
matchElt =
    \case
        List' l
_ [Value' l]
xs -> (Int -> Value' l -> Matcher l a)
-> [Int] -> [Value' l] -> Matcher l [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i -> Int -> Matcher l a -> Matcher l a
forall l a. Int -> Matcher l a -> Matcher l a
inIndex Int
i (Matcher l a -> Matcher l a)
-> (Value' l -> Matcher l a) -> Value' l -> Matcher l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Value' l -> Matcher l a
matchElt Int
i) [Int
0..] [Value' l]
xs
        Value' l
v -> String -> Value' l -> Matcher l [a]
forall l a. String -> Value' l -> Matcher l a
typeError String
"array" Value' l
v

-- | Class for types that can be decoded from a TOML value.
class FromValue a where
    -- | Convert a 'Value' or report an error message
    fromValue :: Value' l -> Matcher l a

    -- | Used to implement instance for @[]@. Most implementations rely on the default implementation.
    listFromValue :: Value' l -> Matcher l [a]
    listFromValue = (Int -> Value' l -> Matcher l a) -> Value' l -> Matcher l [a]
forall l a.
(Int -> Value' l -> Matcher l a) -> Value' l -> Matcher l [a]
listOf ((Value' l -> Matcher l a) -> Int -> Value' l -> Matcher l a
forall a b. a -> b -> a
const Value' l -> Matcher l a
forall l. Value' l -> Matcher l a
forall a l. FromValue a => Value' l -> Matcher l a
fromValue)

instance (Ord k, FromKey k, FromValue v) => FromValue (Map k v) where
    fromValue :: forall l. Value' l -> Matcher l (Map k v)
fromValue = (l -> Text -> Matcher l k)
-> (Text -> Value' l -> Matcher l v)
-> Value' l
-> Matcher l (Map k v)
forall k l v.
Ord k =>
(l -> Text -> Matcher l k)
-> (Text -> Value' l -> Matcher l v)
-> Value' l
-> Matcher l (Map k v)
mapOf l -> Text -> Matcher l k
forall l. l -> Text -> Matcher l k
forall a l. FromKey a => l -> Text -> Matcher l a
fromKey ((Value' l -> Matcher l v) -> Text -> Value' l -> Matcher l v
forall a b. a -> b -> a
const Value' l -> Matcher l v
forall l. Value' l -> Matcher l v
forall a l. FromValue a => Value' l -> Matcher l a
fromValue)

instance FromValue Table where
    fromValue :: forall l. Value' l -> Matcher l Table
fromValue (Table' l
_ Table' l
t) = Table -> Matcher l Table
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Table' l -> Table
forall a. Table' a -> Table
forgetTableAnns Table' l
t)
    fromValue Value' l
v = String -> Value' l -> Matcher l Table
forall l a. String -> Value' l -> Matcher l a
typeError String
"table" Value' l
v

-- | Convert from a table key
class FromKey a where
    fromKey :: l -> Text -> Matcher l a

-- | Matches all strings
instance a ~ Char => FromKey [a] where
    fromKey :: forall l. l -> Text -> Matcher l [a]
fromKey l
_ = [a] -> Matcher l [a]
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Matcher l [a]) -> (Text -> [a]) -> Text -> Matcher l [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [a]
Text -> String
Text.unpack

-- | Matches all strings
instance FromKey Text where
    fromKey :: forall l. l -> Text -> Matcher l Text
fromKey l
_ = Text -> Matcher l Text
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Matches all strings
instance FromKey Data.Text.Lazy.Text where
    fromKey :: forall l. l -> Text -> Matcher l Text
fromKey l
_ = Text -> Matcher l Text
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Matcher l Text)
-> (Text -> Text) -> Text -> Matcher l Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Data.Text.Lazy.fromStrict

-- | Report a type error
typeError :: String {- ^ expected type -} -> Value' l {- ^ actual value -} -> Matcher l a
typeError :: forall l a. String -> Value' l -> Matcher l a
typeError String
wanted Value' l
got = l -> String -> Matcher l a
forall l a. l -> String -> Matcher l a
failAt (Value' l -> l
forall a. Value' a -> a
valueAnn Value' l
got) (String
"expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wanted String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value' l -> String
forall l. Value' l -> String
valueType Value' l
got)

-- | Used to derive a 'fromValue' implementation from a 'ParseTable' matcher.
parseTableFromValue :: ParseTable l a -> Value' l -> Matcher l a
parseTableFromValue :: forall l a. ParseTable l a -> Value' l -> Matcher l a
parseTableFromValue ParseTable l a
p (Table' l
l Table' l
t) = ParseTable l a -> l -> Table' l -> Matcher l a
forall l a. ParseTable l a -> l -> Table' l -> Matcher l a
parseTable ParseTable l a
p l
l Table' l
t
parseTableFromValue ParseTable l a
_ Value' l
v = String -> Value' l -> Matcher l a
forall l a. String -> Value' l -> Matcher l a
typeError String
"table" Value' l
v

-- | Matches integer values
instance FromValue Integer where
    fromValue :: forall l. Value' l -> Matcher l Integer
fromValue (Integer' l
_ Integer
x) = Integer -> Matcher l Integer
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
x
    fromValue Value' l
v = String -> Value' l -> Matcher l Integer
forall l a. String -> Value' l -> Matcher l a
typeError String
"integer" Value' l
v

-- | Matches non-negative integer values
instance FromValue Natural where
    fromValue :: forall l. Value' l -> Matcher l Natural
fromValue Value' l
v =
     do Integer
i <- Value' l -> Matcher l Integer
forall l. Value' l -> Matcher l Integer
forall a l. FromValue a => Value' l -> Matcher l a
fromValue Value' l
v
        if Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i then
            Natural -> Matcher l Natural
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
i)
        else
            l -> String -> Matcher l Natural
forall l a. l -> String -> Matcher l a
failAt (Value' l -> l
forall a. Value' a -> a
valueAnn Value' l
v) String
"integer out of range for Natural"

fromValueSized :: forall l a. (Bounded a, Integral a) => String -> Value' l -> Matcher l a
fromValueSized :: forall l a.
(Bounded a, Integral a) =>
String -> Value' l -> Matcher l a
fromValueSized String
name Value' l
v =
 do Integer
i <- Value' l -> Matcher l Integer
forall l. Value' l -> Matcher l Integer
forall a l. FromValue a => Value' l -> Matcher l a
fromValue Value' l
v
    if a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
minBound :: a) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
maxBound :: a) then
        a -> Matcher l a
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i)
    else
        l -> String -> Matcher l a
forall l a. l -> String -> Matcher l a
failAt (Value' l -> l
forall a. Value' a -> a
valueAnn Value' l
v) (String
"integer out of range for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)

instance FromValue Int    where fromValue :: forall l. Value' l -> Matcher l Int
fromValue = String -> Value' l -> Matcher l Int
forall l a.
(Bounded a, Integral a) =>
String -> Value' l -> Matcher l a
fromValueSized String
"Int"
instance FromValue Int8   where fromValue :: forall l. Value' l -> Matcher l Int8
fromValue = String -> Value' l -> Matcher l Int8
forall l a.
(Bounded a, Integral a) =>
String -> Value' l -> Matcher l a
fromValueSized String
"Int8"
instance FromValue Int16  where fromValue :: forall l. Value' l -> Matcher l Int16
fromValue = String -> Value' l -> Matcher l Int16
forall l a.
(Bounded a, Integral a) =>
String -> Value' l -> Matcher l a
fromValueSized String
"Int16"
instance FromValue Int32  where fromValue :: forall l. Value' l -> Matcher l Int32
fromValue = String -> Value' l -> Matcher l Int32
forall l a.
(Bounded a, Integral a) =>
String -> Value' l -> Matcher l a
fromValueSized String
"Int32"
instance FromValue Int64  where fromValue :: forall l. Value' l -> Matcher l Int64
fromValue = String -> Value' l -> Matcher l Int64
forall l a.
(Bounded a, Integral a) =>
String -> Value' l -> Matcher l a
fromValueSized String
"Int64"
instance FromValue Word   where fromValue :: forall l. Value' l -> Matcher l Word
fromValue = String -> Value' l -> Matcher l Word
forall l a.
(Bounded a, Integral a) =>
String -> Value' l -> Matcher l a
fromValueSized String
"Word"
instance FromValue Word8  where fromValue :: forall l. Value' l -> Matcher l Word8
fromValue = String -> Value' l -> Matcher l Word8
forall l a.
(Bounded a, Integral a) =>
String -> Value' l -> Matcher l a
fromValueSized String
"Word8"
instance FromValue Word16 where fromValue :: forall l. Value' l -> Matcher l Word16
fromValue = String -> Value' l -> Matcher l Word16
forall l a.
(Bounded a, Integral a) =>
String -> Value' l -> Matcher l a
fromValueSized String
"Word16"
instance FromValue Word32 where fromValue :: forall l. Value' l -> Matcher l Word32
fromValue = String -> Value' l -> Matcher l Word32
forall l a.
(Bounded a, Integral a) =>
String -> Value' l -> Matcher l a
fromValueSized String
"Word32"
instance FromValue Word64 where fromValue :: forall l. Value' l -> Matcher l Word64
fromValue = String -> Value' l -> Matcher l Word64
forall l a.
(Bounded a, Integral a) =>
String -> Value' l -> Matcher l a
fromValueSized String
"Word64"

-- | Matches single-character strings with 'fromValue' and arbitrary
-- strings with 'listFromValue' to support 'Prelude.String'
instance FromValue Char where
    fromValue :: forall l. Value' l -> Matcher l Char
fromValue (Text' l
l Text
t) =
        case Text -> Maybe (Char, Text)
Text.uncons Text
t of
            Just (Char
c, Text
t')
                | Text -> Bool
Text.null Text
t' -> Char -> Matcher l Char
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
            Maybe (Char, Text)
_ -> l -> String -> Matcher l Char
forall l a. l -> String -> Matcher l a
failAt l
l String
"expected single character"
    fromValue Value' l
v = String -> Value' l -> Matcher l Char
forall l a. String -> Value' l -> Matcher l a
typeError String
"string" Value' l
v

    listFromValue :: forall l. Value' l -> Matcher l String
listFromValue (Text' l
_ Text
t) = String -> Matcher l String
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
Text.unpack Text
t)
    listFromValue Value' l
v = String -> Value' l -> Matcher l String
forall l a. String -> Value' l -> Matcher l a
typeError String
"string" Value' l
v

-- | Matches string literals
instance FromValue Text where
    fromValue :: forall l. Value' l -> Matcher l Text
fromValue (Text' l
_ Text
t) = Text -> Matcher l Text
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
    fromValue Value' l
v = String -> Value' l -> Matcher l Text
forall l a. String -> Value' l -> Matcher l a
typeError String
"string" Value' l
v

-- | Matches string literals
instance FromValue Data.Text.Lazy.Text where
    fromValue :: forall l. Value' l -> Matcher l Text
fromValue Value' l
v = Text -> Text
Data.Text.Lazy.fromStrict (Text -> Text) -> Matcher l Text -> Matcher l Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value' l -> Matcher l Text
forall l. Value' l -> Matcher l Text
forall a l. FromValue a => Value' l -> Matcher l a
fromValue Value' l
v

-- | Matches floating-point and integer values
instance FromValue Double where
    fromValue :: forall l. Value' l -> Matcher l Double
fromValue (Double' l
_ Double
x) = Double -> Matcher l Double
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
x
    fromValue (Integer' l
_ Integer
x) = Double -> Matcher l Double
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
x)
    fromValue Value' l
v = String -> Value' l -> Matcher l Double
forall l a. String -> Value' l -> Matcher l a
typeError String
"float" Value' l
v

-- | Matches floating-point and integer values
instance FromValue Float where
    fromValue :: forall l. Value' l -> Matcher l Float
fromValue (Double' l
_ Double
x) = Float -> Matcher l Float
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x)
    fromValue (Integer' l
_ Integer
x) = Float -> Matcher l Float
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
x)
    fromValue Value' l
v = String -> Value' l -> Matcher l Float
forall l a. String -> Value' l -> Matcher l a
typeError String
"float" Value' l
v

-- | Matches floating-point and integer values.
--
-- TOML specifies @Floats should be implemented as IEEE 754 binary64 values.@
-- so note that the given 'Rational' will be converted from a double
-- representation and will often be an approximation rather than the exact
-- value.
instance Integral a => FromValue (Ratio a) where
    fromValue :: forall l. Value' l -> Matcher l (Ratio a)
fromValue (Double' l
a Double
x)
        | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
x = l -> String -> Matcher l (Ratio a)
forall l a. l -> String -> Matcher l a
failAt l
a String
"finite float required"
        | Bool
otherwise = Ratio a -> Matcher l (Ratio a)
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Ratio a
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x)
    fromValue (Integer' l
_ Integer
x) = Ratio a -> Matcher l (Ratio a)
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Ratio a
forall a. Num a => Integer -> a
fromInteger Integer
x)
    fromValue Value' l
v = String -> Value' l -> Matcher l (Ratio a)
forall l a. String -> Value' l -> Matcher l a
typeError String
"float" Value' l
v

-- | Matches non-empty arrays or reports an error.
instance FromValue a => FromValue (NonEmpty a) where
    fromValue :: forall l. Value' l -> Matcher l (NonEmpty a)
fromValue Value' l
v =
     do [a]
xs <- Value' l -> Matcher l [a]
forall l. Value' l -> Matcher l [a]
forall a l. FromValue a => Value' l -> Matcher l a
fromValue Value' l
v
        case [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [a]
xs of
            Maybe (NonEmpty a)
Nothing -> l -> String -> Matcher l (NonEmpty a)
forall l a. l -> String -> Matcher l a
failAt (Value' l -> l
forall a. Value' a -> a
valueAnn Value' l
v) String
"non-empty list required"
            Just NonEmpty a
ne -> NonEmpty a -> Matcher l (NonEmpty a)
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty a
ne

-- | Matches arrays
instance FromValue a => FromValue (Seq a) where
    fromValue :: forall l. Value' l -> Matcher l (Seq a)
fromValue Value' l
v = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> Matcher l [a] -> Matcher l (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value' l -> Matcher l [a]
forall l. Value' l -> Matcher l [a]
forall a l. FromValue a => Value' l -> Matcher l a
fromValue Value' l
v

-- | Matches @true@ and @false@
instance FromValue Bool where
    fromValue :: forall l. Value' l -> Matcher l Bool
fromValue (Bool' l
_ Bool
x) = Bool -> Matcher l Bool
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
x
    fromValue Value' l
v = String -> Value' l -> Matcher l Bool
forall l a. String -> Value' l -> Matcher l a
typeError String
"boolean" Value' l
v

-- | Implemented in terms of 'listFromValue'
instance FromValue a => FromValue [a] where
    fromValue :: forall l. Value' l -> Matcher l [a]
fromValue = Value' l -> Matcher l [a]
forall l. Value' l -> Matcher l [a]
forall a l. FromValue a => Value' l -> Matcher l [a]
listFromValue

-- | Matches local date literals
instance FromValue Day where
    fromValue :: forall l. Value' l -> Matcher l Day
fromValue (Day' l
_ Day
x) = Day -> Matcher l Day
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Day
x
    fromValue Value' l
v = String -> Value' l -> Matcher l Day
forall l a. String -> Value' l -> Matcher l a
typeError String
"local date" Value' l
v

-- | Matches local time literals
instance FromValue TimeOfDay where
    fromValue :: forall l. Value' l -> Matcher l TimeOfDay
fromValue (TimeOfDay' l
_ TimeOfDay
x) = TimeOfDay -> Matcher l TimeOfDay
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeOfDay
x
    fromValue Value' l
v = String -> Value' l -> Matcher l TimeOfDay
forall l a. String -> Value' l -> Matcher l a
typeError String
"local time" Value' l
v

-- | Matches offset date-time literals
instance FromValue ZonedTime where
    fromValue :: forall l. Value' l -> Matcher l ZonedTime
fromValue (ZonedTime' l
_ ZonedTime
x) = ZonedTime -> Matcher l ZonedTime
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ZonedTime
x
    fromValue Value' l
v = String -> Value' l -> Matcher l ZonedTime
forall l a. String -> Value' l -> Matcher l a
typeError String
"offset date-time" Value' l
v

-- | Matches local date-time literals
instance FromValue LocalTime where
    fromValue :: forall l. Value' l -> Matcher l LocalTime
fromValue (LocalTime' l
_ LocalTime
x) = LocalTime -> Matcher l LocalTime
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalTime
x
    fromValue Value' l
v = String -> Value' l -> Matcher l LocalTime
forall l a. String -> Value' l -> Matcher l a
typeError String
"local date-time" Value' l
v

-- | Matches all values, used for pass-through
instance FromValue Value where
    fromValue :: forall l. Value' l -> Matcher l Value
fromValue = Value -> Matcher l Value
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Matcher l Value)
-> (Value' l -> Value) -> Value' l -> Matcher l Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' l -> Value
forall a. Value' a -> Value
forgetValueAnns

-- | Convenience function for matching an optional key with a 'FromValue'
-- instance.
--
-- @optKey key = 'optKeyOf' key 'fromValue'@
optKey :: FromValue a => Text -> ParseTable l (Maybe a)
optKey :: forall a l. FromValue a => Text -> ParseTable l (Maybe a)
optKey Text
key = Text -> (Value' l -> Matcher l a) -> ParseTable l (Maybe a)
forall l a.
Text -> (Value' l -> Matcher l a) -> ParseTable l (Maybe a)
optKeyOf Text
key Value' l -> Matcher l a
forall l. Value' l -> Matcher l a
forall a l. FromValue a => Value' l -> Matcher l a
fromValue

-- | Convenience function for matching a required key with a 'FromValue'
-- instance.
--
-- @reqKey key = 'reqKeyOf' key 'fromValue'@
reqKey :: FromValue a => Text -> ParseTable l a
reqKey :: forall a l. FromValue a => Text -> ParseTable l a
reqKey Text
key = Text -> (Value' l -> Matcher l a) -> ParseTable l a
forall l a. Text -> (Value' l -> Matcher l a) -> ParseTable l a
reqKeyOf Text
key Value' l -> Matcher l a
forall l. Value' l -> Matcher l a
forall a l. FromValue a => Value' l -> Matcher l a
fromValue

-- | Match a table entry by key if it exists or return 'Nothing' if not.
-- If the key is defined, it is matched by the given function.
--
-- See 'pickKey' for more complex cases.
optKeyOf ::
    Text                      {- ^ key           -} ->
    (Value' l -> Matcher l a) {- ^ value matcher -} ->
    ParseTable l (Maybe a)
optKeyOf :: forall l a.
Text -> (Value' l -> Matcher l a) -> ParseTable l (Maybe a)
optKeyOf Text
key Value' l -> Matcher l a
k = [KeyAlt l (Maybe a)] -> ParseTable l (Maybe a)
forall l a. [KeyAlt l a] -> ParseTable l a
pickKey [Text -> (Value' l -> Matcher l (Maybe a)) -> KeyAlt l (Maybe a)
forall l a. Text -> (Value' l -> Matcher l a) -> KeyAlt l a
Key Text
key ((a -> Maybe a) -> Matcher l a -> Matcher l (Maybe a)
forall a b. (a -> b) -> Matcher l a -> Matcher l b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Matcher l a -> Matcher l (Maybe a))
-> (Value' l -> Matcher l a) -> Value' l -> Matcher l (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' l -> Matcher l a
k), Matcher l (Maybe a) -> KeyAlt l (Maybe a)
forall l a. Matcher l a -> KeyAlt l a
Else (Maybe a -> Matcher l (Maybe a)
forall a. a -> Matcher l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)]

-- | Match a table entry by key or report an error if missing.
--
-- See 'pickKey' for more complex cases.
reqKeyOf ::
    Text                      {- ^ key           -} ->
    (Value' l -> Matcher l a) {- ^ value matcher -} ->
    ParseTable l a
reqKeyOf :: forall l a. Text -> (Value' l -> Matcher l a) -> ParseTable l a
reqKeyOf Text
key Value' l -> Matcher l a
k = [KeyAlt l a] -> ParseTable l a
forall l a. [KeyAlt l a] -> ParseTable l a
pickKey [Text -> (Value' l -> Matcher l a) -> KeyAlt l a
forall l a. Text -> (Value' l -> Matcher l a) -> KeyAlt l a
Key Text
key Value' l -> Matcher l a
k]