{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
module Toml.Type.AnyValue
( AnyValue (..)
, reifyAnyValues
, toMArray
, MatchError (..)
, mkMatchError
, matchBool
, matchInteger
, matchDouble
, matchText
, matchZoned
, matchLocal
, matchDay
, matchHours
, matchArray
, applyAsToAny
) where
import Control.DeepSeq (NFData, rnf)
import Data.Text (Text)
import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime)
import Data.Type.Equality ((:~:) (..))
import GHC.Generics (Generic)
import Toml.Type.Value (TValue (..), TypeMismatchError (..), Value (..), sameValue)
data AnyValue = forall (t :: TValue) . AnyValue (Value t)
instance Show AnyValue where
show :: AnyValue -> String
show (AnyValue Value t
v) = forall a. Show a => a -> String
show Value t
v
instance Eq AnyValue where
(AnyValue Value t
val1) == :: AnyValue -> AnyValue -> Bool
== (AnyValue Value t
val2) = case forall (a :: TValue) (b :: TValue).
Value a -> Value b -> Either TypeMismatchError (a :~: b)
sameValue Value t
val1 Value t
val2 of
Right t :~: t
Refl -> Value t
val1 forall a. Eq a => a -> a -> Bool
== Value t
val2
Left TypeMismatchError
_ -> Bool
False
instance NFData AnyValue where
rnf :: AnyValue -> ()
rnf (AnyValue Value t
val) = forall a. NFData a => a -> ()
rnf Value t
val
data MatchError = MatchError
{ MatchError -> TValue
valueExpected :: !TValue
, MatchError -> AnyValue
valueActual :: !AnyValue
} deriving stock (MatchError -> MatchError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchError -> MatchError -> Bool
$c/= :: MatchError -> MatchError -> Bool
== :: MatchError -> MatchError -> Bool
$c== :: MatchError -> MatchError -> Bool
Eq, Int -> MatchError -> ShowS
[MatchError] -> ShowS
MatchError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchError] -> ShowS
$cshowList :: [MatchError] -> ShowS
show :: MatchError -> String
$cshow :: MatchError -> String
showsPrec :: Int -> MatchError -> ShowS
$cshowsPrec :: Int -> MatchError -> ShowS
Show, forall x. Rep MatchError x -> MatchError
forall x. MatchError -> Rep MatchError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MatchError x -> MatchError
$cfrom :: forall x. MatchError -> Rep MatchError x
Generic)
deriving anyclass (MatchError -> ()
forall a. (a -> ()) -> NFData a
rnf :: MatchError -> ()
$crnf :: MatchError -> ()
NFData)
mkMatchError :: TValue -> Value t -> Either MatchError a
mkMatchError :: forall (t :: TValue) a. TValue -> Value t -> Either MatchError a
mkMatchError TValue
t = forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. TValue -> AnyValue -> MatchError
MatchError TValue
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: TValue). Value t -> AnyValue
AnyValue
matchBool :: Value t -> Either MatchError Bool
matchBool :: forall (t :: TValue). Value t -> Either MatchError Bool
matchBool (Bool Bool
b) = forall a b. b -> Either a b
Right Bool
b
matchBool Value t
value = forall (t :: TValue) a. TValue -> Value t -> Either MatchError a
mkMatchError TValue
TBool Value t
value
{-# INLINE matchBool #-}
matchInteger :: Value t -> Either MatchError Integer
matchInteger :: forall (t :: TValue). Value t -> Either MatchError Integer
matchInteger (Integer Integer
n) = forall a b. b -> Either a b
Right Integer
n
matchInteger Value t
value = forall (t :: TValue) a. TValue -> Value t -> Either MatchError a
mkMatchError TValue
TInteger Value t
value
{-# INLINE matchInteger #-}
matchDouble :: Value t -> Either MatchError Double
matchDouble :: forall (t :: TValue). Value t -> Either MatchError Double
matchDouble (Double Double
f) = forall a b. b -> Either a b
Right Double
f
matchDouble Value t
value = forall (t :: TValue) a. TValue -> Value t -> Either MatchError a
mkMatchError TValue
TDouble Value t
value
{-# INLINE matchDouble #-}
matchText :: Value t -> Either MatchError Text
matchText :: forall (t :: TValue). Value t -> Either MatchError Text
matchText (Text Text
s) = forall a b. b -> Either a b
Right Text
s
matchText Value t
value = forall (t :: TValue) a. TValue -> Value t -> Either MatchError a
mkMatchError TValue
TText Value t
value
{-# INLINE matchText #-}
matchZoned :: Value t -> Either MatchError ZonedTime
matchZoned :: forall (t :: TValue). Value t -> Either MatchError ZonedTime
matchZoned (Zoned ZonedTime
d) = forall a b. b -> Either a b
Right ZonedTime
d
matchZoned Value t
value = forall (t :: TValue) a. TValue -> Value t -> Either MatchError a
mkMatchError TValue
TZoned Value t
value
{-# INLINE matchZoned #-}
matchLocal :: Value t -> Either MatchError LocalTime
matchLocal :: forall (t :: TValue). Value t -> Either MatchError LocalTime
matchLocal (Local LocalTime
d) = forall a b. b -> Either a b
Right LocalTime
d
matchLocal Value t
value = forall (t :: TValue) a. TValue -> Value t -> Either MatchError a
mkMatchError TValue
TLocal Value t
value
{-# INLINE matchLocal #-}
matchDay :: Value t -> Either MatchError Day
matchDay :: forall (t :: TValue). Value t -> Either MatchError Day
matchDay (Day Day
d) = forall a b. b -> Either a b
Right Day
d
matchDay Value t
value = forall (t :: TValue) a. TValue -> Value t -> Either MatchError a
mkMatchError TValue
TDay Value t
value
{-# INLINE matchDay #-}
matchHours :: Value t -> Either MatchError TimeOfDay
matchHours :: forall (t :: TValue). Value t -> Either MatchError TimeOfDay
matchHours (Hours TimeOfDay
d) = forall a b. b -> Either a b
Right TimeOfDay
d
matchHours Value t
value = forall (t :: TValue) a. TValue -> Value t -> Either MatchError a
mkMatchError TValue
THours Value t
value
{-# INLINE matchHours #-}
matchArray :: (AnyValue -> Either MatchError a) -> Value t -> Either MatchError [a]
matchArray :: forall a (t :: TValue).
(AnyValue -> Either MatchError a)
-> Value t -> Either MatchError [a]
matchArray AnyValue -> Either MatchError a
matchValue (Array [Value t]
a) = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall r (t :: TValue). (AnyValue -> r) -> Value t -> r
applyAsToAny AnyValue -> Either MatchError a
matchValue) [Value t]
a
matchArray AnyValue -> Either MatchError a
_ Value t
value = forall (t :: TValue) a. TValue -> Value t -> Either MatchError a
mkMatchError TValue
TArray Value t
value
{-# INLINE matchArray #-}
applyAsToAny :: (AnyValue -> r) -> (Value t -> r)
applyAsToAny :: forall r (t :: TValue). (AnyValue -> r) -> Value t -> r
applyAsToAny AnyValue -> r
f = AnyValue -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: TValue). Value t -> AnyValue
AnyValue
reifyAnyValues :: Value t -> [AnyValue] -> Either TypeMismatchError [Value t]
reifyAnyValues :: forall (t :: TValue).
Value t -> [AnyValue] -> Either TypeMismatchError [Value t]
reifyAnyValues Value t
_ [] = forall a b. b -> Either a b
Right []
reifyAnyValues Value t
v (AnyValue Value t
av : [AnyValue]
xs) = forall (a :: TValue) (b :: TValue).
Value a -> Value b -> Either TypeMismatchError (a :~: b)
sameValue Value t
v Value t
av forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t :~: t
Refl -> (Value t
av forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: TValue).
Value t -> [AnyValue] -> Either TypeMismatchError [Value t]
reifyAnyValues Value t
v [AnyValue]
xs
toMArray :: [AnyValue] -> Either MatchError (Value 'TArray)
toMArray :: [AnyValue] -> Either MatchError (Value 'TArray)
toMArray [] = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (t :: TValue). [Value t] -> Value 'TArray
Array []
toMArray (AnyValue Value t
x : [AnyValue]
xs) = case forall (t :: TValue).
Value t -> [AnyValue] -> Either TypeMismatchError [Value t]
reifyAnyValues Value t
x [AnyValue]
xs of
Left TypeMismatchError{TValue
typeActual :: TypeMismatchError -> TValue
typeExpected :: TypeMismatchError -> TValue
typeActual :: TValue
typeExpected :: TValue
..} -> forall (t :: TValue) a. TValue -> Value t -> Either MatchError a
mkMatchError TValue
typeExpected Value t
x
Right [Value t]
vals -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (t :: TValue). [Value t] -> Value 'TArray
Array (Value t
x forall a. a -> [a] -> [a]
: [Value t]
vals)