{-# LANGUAGE AllowAmbiguousTypes       #-}
{-# LANGUAGE DataKinds                 #-}
{-# LANGUAGE DeriveAnyClass            #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE KindSignatures            #-}

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

Existential wrapper over 'Value' type and matching functions.

@since 0.0.0
-}

module Toml.Type.AnyValue
       ( AnyValue (..)
       , reifyAnyValues
       , toMArray

         -- * Matching
       , 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)


{- | Existential wrapper for 'Value'.

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

-- | Value type mismatch error.
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)

-- | Helper function to create 'MatchError'.
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

----------------------------------------------------------------------------
-- Matching functions for values
----------------------------------------------------------------------------

-- | Extract 'Prelude.Bool' from 'Value'.
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 #-}

-- | Extract 'Prelude.Integer' from 'Value'.
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 #-}

-- | Extract 'Prelude.Double' from 'Value'.
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 #-}

-- | Extract 'Data.Text.Text' from 'Value'.
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 #-}

-- | Extract 'Data.Time.ZonedTime' from 'Value'.
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 #-}

-- | Extract 'Data.Time.LocalTime' from 'Value'.
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 #-}

-- | Extract 'Data.Time.Day' from 'Value'.
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 #-}

-- | Extract 'Data.Time.TimeOfDay' from 'Value'.
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 #-}

-- | Extract list of elements of type @a@ from array.
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 #-}

-- | Make function that works with 'AnyValue' also work with specific 'Value'.
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

-- | Checks whether all elements inside given list of 'AnyValue' have the same
-- type as given 'Value'. Returns list of @Value t@ without given 'Value'.
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

-- | Function for creating 'Array' from list of 'AnyValue'.
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)