{-# LANGUAGE GADTs #-}
module Toml.Type.UValue
( UValue (..)
, typeCheck
) where
import Data.Text (Text)
import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime, zonedTimeToUTC)
import Data.Type.Equality ((:~:) (..))
import Toml.Type.AnyValue (AnyValue (..))
import Toml.Type.Value (TypeMismatchError, Value (..), sameValue)
data UValue
= UBool !Bool
| UInteger !Integer
| UDouble !Double
| UText !Text
| UZoned !ZonedTime
| ULocal !LocalTime
| UDay !Day
| UHours !TimeOfDay
| UArray ![UValue]
deriving stock (Int -> UValue -> ShowS
[UValue] -> ShowS
UValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UValue] -> ShowS
$cshowList :: [UValue] -> ShowS
show :: UValue -> String
$cshow :: UValue -> String
showsPrec :: Int -> UValue -> ShowS
$cshowsPrec :: Int -> UValue -> ShowS
Show)
instance Eq UValue where
(UBool Bool
b1) == :: UValue -> UValue -> Bool
== (UBool Bool
b2) = Bool
b1 forall a. Eq a => a -> a -> Bool
== Bool
b2
(UInteger Integer
i1) == (UInteger Integer
i2) = Integer
i1 forall a. Eq a => a -> a -> Bool
== Integer
i2
(UDouble Double
f1) == (UDouble Double
f2)
| forall a. RealFloat a => a -> Bool
isNaN Double
f1 Bool -> Bool -> Bool
&& forall a. RealFloat a => a -> Bool
isNaN Double
f2 = Bool
True
| Bool
otherwise = Double
f1 forall a. Eq a => a -> a -> Bool
== Double
f2
(UText Text
s1) == (UText Text
s2) = Text
s1 forall a. Eq a => a -> a -> Bool
== Text
s2
(UZoned ZonedTime
a) == (UZoned ZonedTime
b) = ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
a forall a. Eq a => a -> a -> Bool
== ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
b
(ULocal LocalTime
a) == (ULocal LocalTime
b) = LocalTime
a forall a. Eq a => a -> a -> Bool
== LocalTime
b
(UDay Day
a) == (UDay Day
b) = Day
a forall a. Eq a => a -> a -> Bool
== Day
b
(UHours TimeOfDay
a) == (UHours TimeOfDay
b) = TimeOfDay
a forall a. Eq a => a -> a -> Bool
== TimeOfDay
b
(UArray [UValue]
a1) == (UArray [UValue]
a2) = [UValue]
a1 forall a. Eq a => a -> a -> Bool
== [UValue]
a2
UValue
_ == UValue
_ = Bool
False
typeCheck :: UValue -> Either TypeMismatchError AnyValue
typeCheck :: UValue -> Either TypeMismatchError AnyValue
typeCheck (UBool Bool
b) = forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny forall a b. (a -> b) -> a -> b
$ Bool -> Value 'TBool
Bool Bool
b
typeCheck (UInteger Integer
n) = forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny forall a b. (a -> b) -> a -> b
$ Integer -> Value 'TInteger
Integer Integer
n
typeCheck (UDouble Double
f) = forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny forall a b. (a -> b) -> a -> b
$ Double -> Value 'TDouble
Double Double
f
typeCheck (UText Text
s) = forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny forall a b. (a -> b) -> a -> b
$ Text -> Value 'TText
Text Text
s
typeCheck (UZoned ZonedTime
d) = forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny forall a b. (a -> b) -> a -> b
$ ZonedTime -> Value 'TZoned
Zoned ZonedTime
d
typeCheck (ULocal LocalTime
d) = forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny forall a b. (a -> b) -> a -> b
$ LocalTime -> Value 'TLocal
Local LocalTime
d
typeCheck (UDay Day
d) = forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny forall a b. (a -> b) -> a -> b
$ Day -> Value 'TDay
Day Day
d
typeCheck (UHours TimeOfDay
d) = forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny forall a b. (a -> b) -> a -> b
$ TimeOfDay -> Value 'THours
Hours TimeOfDay
d
typeCheck (UArray [UValue]
a) = case [UValue]
a of
[] -> forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny forall a b. (a -> b) -> a -> b
$ forall (t :: TValue). [Value t] -> Value 'TArray
Array []
UValue
x:[UValue]
xs -> do
AnyValue Value t
v <- UValue -> Either TypeMismatchError AnyValue
typeCheck UValue
x
forall (t :: TValue). Value t -> AnyValue
AnyValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: TValue). [Value t] -> Value 'TArray
Array forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: TValue).
Value t -> [UValue] -> Either TypeMismatchError [Value t]
checkElem Value t
v [UValue]
xs
where
checkElem :: Value t -> [UValue] -> Either TypeMismatchError [Value t]
checkElem :: forall (t :: TValue).
Value t -> [UValue] -> Either TypeMismatchError [Value t]
checkElem Value t
v [] = forall a b. b -> Either a b
Right [Value t
v]
checkElem Value t
v (UValue
x:[UValue]
xs) = do
AnyValue Value t
vx <- UValue -> Either TypeMismatchError AnyValue
typeCheck UValue
x
t :~: t
Refl <- forall (a :: TValue) (b :: TValue).
Value a -> Value b -> Either TypeMismatchError (a :~: b)
sameValue Value t
v Value t
vx
(Value t
v forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: TValue).
Value t -> [UValue] -> Either TypeMismatchError [Value t]
checkElem Value t
vx [UValue]
xs
rightAny :: Value t -> Either l AnyValue
rightAny :: forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: TValue). Value t -> AnyValue
AnyValue