{-# LANGUAGE GADTs #-}

{- |
Module                  : Toml.Type.UValue
Copyright               : (c) 2018-2022 Kowainik
SPDX-License-Identifier : MPL-2.0
Maintainer              : Kowainik <xrom.xkov@gmail.com>
Stability               : Stable
Portability             : Portable

Intermediate untype value representation used for parsing.

@since 0.0.0
-}

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)


{- | Untyped value of @TOML@. You shouldn't use this type in your
code. Use 'Value' instead.

@since 0.0.0
-}
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)

-- | @since 0.0.0
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

{- | Ensures that 'UValue's represents type-safe version of @toml@.

@since 0.0.0
-}
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