{-# 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
(Int -> UValue -> ShowS)
-> (UValue -> String) -> ([UValue] -> ShowS) -> Show UValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UValue -> ShowS
showsPrec :: Int -> UValue -> ShowS
$cshow :: UValue -> String
show :: UValue -> String
$cshowList :: [UValue] -> ShowS
showList :: [UValue] -> ShowS
Show)

-- | @since 0.0.0
instance Eq UValue where
    (UBool Bool
b1)    == :: UValue -> UValue -> Bool
== (UBool Bool
b2)    = Bool
b1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b2
    (UInteger Integer
i1) == (UInteger Integer
i2) = Integer
i1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
i2
    (UDouble Double
f1)  == (UDouble Double
f2)
        | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
f1 Bool -> Bool -> Bool
&& Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
f2 = Bool
True
        | Bool
otherwise = Double
f1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
f2
    (UText Text
s1)    == (UText Text
s2)    = Text
s1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s2
    (UZoned ZonedTime
a)    == (UZoned ZonedTime
b)    = ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
a UTCTime -> UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
== ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
b
    (ULocal LocalTime
a)    == (ULocal LocalTime
b)    = LocalTime
a LocalTime -> LocalTime -> Bool
forall a. Eq a => a -> a -> Bool
== LocalTime
b
    (UDay Day
a)      == (UDay Day
b)      = Day
a Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
== Day
b
    (UHours TimeOfDay
a)    == (UHours TimeOfDay
b)    = TimeOfDay
a TimeOfDay -> TimeOfDay -> Bool
forall a. Eq a => a -> a -> Bool
== TimeOfDay
b
    (UArray [UValue]
a1)   == (UArray [UValue]
a2)   = [UValue]
a1 [UValue] -> [UValue] -> Bool
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)    = Value 'TBool -> Either TypeMismatchError AnyValue
forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny (Value 'TBool -> Either TypeMismatchError AnyValue)
-> Value 'TBool -> Either TypeMismatchError AnyValue
forall a b. (a -> b) -> a -> b
$ Bool -> Value 'TBool
Bool Bool
b
typeCheck (UInteger Integer
n) = Value 'TInteger -> Either TypeMismatchError AnyValue
forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny (Value 'TInteger -> Either TypeMismatchError AnyValue)
-> Value 'TInteger -> Either TypeMismatchError AnyValue
forall a b. (a -> b) -> a -> b
$ Integer -> Value 'TInteger
Integer Integer
n
typeCheck (UDouble Double
f)  = Value 'TDouble -> Either TypeMismatchError AnyValue
forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny (Value 'TDouble -> Either TypeMismatchError AnyValue)
-> Value 'TDouble -> Either TypeMismatchError AnyValue
forall a b. (a -> b) -> a -> b
$ Double -> Value 'TDouble
Double Double
f
typeCheck (UText Text
s)    = Value 'TText -> Either TypeMismatchError AnyValue
forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny (Value 'TText -> Either TypeMismatchError AnyValue)
-> Value 'TText -> Either TypeMismatchError AnyValue
forall a b. (a -> b) -> a -> b
$ Text -> Value 'TText
Text Text
s
typeCheck (UZoned ZonedTime
d)   = Value 'TZoned -> Either TypeMismatchError AnyValue
forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny (Value 'TZoned -> Either TypeMismatchError AnyValue)
-> Value 'TZoned -> Either TypeMismatchError AnyValue
forall a b. (a -> b) -> a -> b
$ ZonedTime -> Value 'TZoned
Zoned ZonedTime
d
typeCheck (ULocal LocalTime
d)   = Value 'TLocal -> Either TypeMismatchError AnyValue
forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny (Value 'TLocal -> Either TypeMismatchError AnyValue)
-> Value 'TLocal -> Either TypeMismatchError AnyValue
forall a b. (a -> b) -> a -> b
$ LocalTime -> Value 'TLocal
Local LocalTime
d
typeCheck (UDay Day
d)     = Value 'TDay -> Either TypeMismatchError AnyValue
forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny (Value 'TDay -> Either TypeMismatchError AnyValue)
-> Value 'TDay -> Either TypeMismatchError AnyValue
forall a b. (a -> b) -> a -> b
$ Day -> Value 'TDay
Day Day
d
typeCheck (UHours TimeOfDay
d)   = Value 'THours -> Either TypeMismatchError AnyValue
forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny (Value 'THours -> Either TypeMismatchError AnyValue)
-> Value 'THours -> Either TypeMismatchError AnyValue
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> Value 'THours
Hours TimeOfDay
d
typeCheck (UArray [UValue]
a)   = case [UValue]
a of
    []   -> Value 'TArray -> Either TypeMismatchError AnyValue
forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny (Value 'TArray -> Either TypeMismatchError AnyValue)
-> Value 'TArray -> Either TypeMismatchError AnyValue
forall a b. (a -> b) -> a -> b
$ [Value Any] -> Value 'TArray
forall (t1 :: TValue). [Value t1] -> Value 'TArray
Array []
    UValue
x:[UValue]
xs -> do
        AnyValue Value t
v <- UValue -> Either TypeMismatchError AnyValue
typeCheck UValue
x
        Value 'TArray -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue (Value 'TArray -> AnyValue)
-> ([Value t] -> Value 'TArray) -> [Value t] -> AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value t] -> Value 'TArray
forall (t1 :: TValue). [Value t1] -> Value 'TArray
Array ([Value t] -> AnyValue)
-> Either TypeMismatchError [Value t]
-> Either TypeMismatchError AnyValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value t -> [UValue] -> Either TypeMismatchError [Value t]
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 []     = [Value t] -> Either TypeMismatchError [Value t]
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 <- Value t -> Value t -> Either TypeMismatchError (t :~: t)
forall (a :: TValue) (b :: TValue).
Value a -> Value b -> Either TypeMismatchError (a :~: b)
sameValue Value t
v Value t
vx
        (Value t
v Value t -> [Value t] -> [Value t]
forall a. a -> [a] -> [a]
:) ([Value t] -> [Value t])
-> Either TypeMismatchError [Value t]
-> Either TypeMismatchError [Value t]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value t -> [UValue] -> Either TypeMismatchError [Value t]
forall (t :: TValue).
Value t -> [UValue] -> Either TypeMismatchError [Value t]
checkElem Value t
Value t
vx [UValue]
xs

rightAny :: Value t -> Either l AnyValue
rightAny :: forall (t :: TValue) l. Value t -> Either l AnyValue
rightAny = AnyValue -> Either l AnyValue
forall a b. b -> Either a b
Right (AnyValue -> Either l AnyValue)
-> (Value t -> AnyValue) -> Value t -> Either l AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value t -> AnyValue
forall (t :: TValue). Value t -> AnyValue
AnyValue