{-# LANGUAGE DataKinds                 #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE KindSignatures            #-}
{-# LANGUAGE StandaloneDeriving        #-}
{-# LANGUAGE TypeOperators             #-}

{- | Contains specification of TOML via Haskell ADT. -}

module Toml.Type
       ( TOML (..)
       , UValue (..)
       , ValueType (..)
       , Value (..)
       , AnyValue (..)
       , DateTime (..)
       , typeCheck
       ) where

import Data.HashMap.Strict (HashMap)
import Data.Text (Text)
import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime, zonedTimeToUTC)
import Data.Type.Equality ((:~:) (..))

import Toml.PrefixTree (Key (..), PrefixMap)

-- TODO: describe how some TOML document will look like with this type
{- | Represents TOML configuration value. -}
data TOML = TOML
    { tomlPairs  :: HashMap Key AnyValue
    , tomlTables :: PrefixMap TOML
    -- tomlTableArrays :: HashMap Key (NonEmpty TOML)
    } deriving (Show, Eq)

-- Needed for GADT parameterization
data ValueType = TBool | TInt | TFloat | TString | TDate | TArray

-- TODO: examples are copy-pasted from TOML specification. Probably most of them
-- will be moved into parsing module in future.
-- | Value in @key = value@ pair.
data Value (t :: ValueType) where
    {- | Boolean value:

@
bool1 = true
bool2 = false
@
    -}
    Bool :: Bool -> Value 'TBool

    {- | Integer value:

@
int1 = +99
int2 = 42
int3 = 0
int4 = -17
int5 = 5_349_221
hex1 = 0xDEADBEEF
oct2 = 0o755 # useful for Unix file permissions
bin1 = 0b11010110
@
    -}
    Int :: Integer -> Value 'TInt

    {- | Floating point number:

@
flt1 = -3.1415   # fractional
flt2 = 1e6       # exponent
flt3 = 6.626e-34 # both
flt4 = 9_224_617.445_991_228_313
@
    -}
    Float :: Double -> Value 'TFloat

    {- | String value:

@
key = "value"
bare_key = "value"
bare-key = "value"
@
    -}
    String :: Text -> Value 'TString

    -- | Date-time. See documentation for 'DateTime' type.
    Date :: DateTime -> Value 'TDate

    {- | Array of values. According to TOML specification all values in array
      should have the same type. This is guaranteed statically with this type.

@
arr1 = [ 1, 2, 3 ]
arr2 = [ "red", "yellow", "green" ]
arr3 = [ [ 1, 2 ], [3, 4, 5] ]
arr4 = [ "all", 'strings', """are the same""", '''type''']
arr5 = [ [ 1, 2 ], ["a", "b", "c"] ]

arr6 = [ 1, 2.0 ] # INVALID
@
    -}
    Array  :: [Value t] -> Value 'TArray

deriving instance Show (Value t)
instance Eq (Value t) where
    (Bool b1)   == (Bool b2)   = b1 == b2
    (Int i1)    == (Int i2)    = i1 == i2
    (Float f1)  == (Float f2)  = f1 == f2
    (String s1) == (String s2) = s1 == s2
    (Date d1)   == (Date d2)   = d1 == d2
    (Array a1)  == (Array a2)  = eqValueList a1 a2

eqValueList :: [Value a] -> [Value b] -> Bool
eqValueList [] [] = True
eqValueList (x:xs) (y:ys) = case sameValue x y of
    Just Refl -> x == y && eqValueList xs ys
    Nothing   -> False
eqValueList _ _ = False


-- TODO: move into Toml.Type.Internal module then?.. But it uses 'DateTime' which is not internal...
-- | Untyped value of 'TOML'. You shouldn't use this type in your code. Use
-- 'Value' instead.
data UValue
    = UBool !Bool
    | UInt !Integer
    | UFloat !Double
    | UString !Text
    | UDate !DateTime
    | UArray ![UValue]

-- | Existential wrapper for 'Value'.
data AnyValue = forall (t :: ValueType) . AnyValue (Value t)

instance Show AnyValue where
    show (AnyValue v) = show v

instance Eq AnyValue where
    (AnyValue (Bool b1))   == (AnyValue (Bool b2))   = b1 == b2
    (AnyValue (Int i1))    == (AnyValue (Int i2))    = i1 == i2
    (AnyValue (Float f1))  == (AnyValue (Float f2))  = f1 == f2
    (AnyValue (String s1)) == (AnyValue (String s2)) = s1 == s2
    (AnyValue (Date d1))   == (AnyValue (Date d2))   = d1 == d2
    (AnyValue (Array a1))  == (AnyValue (Array a2))  = eqValueList a1 a2
    _                      == _                      = False


data DateTime
      {- | Offset date-time:

@
odt1 = 1979-05-27T07:32:00Z
odt2 = 1979-05-27T00:32:00-07:00
@
      -}
    = Zoned !ZonedTime

      {- | Local date-time (without offset):

@
ldt1 = 1979-05-27T07:32:00
ldt2 = 1979-05-27T00:32:00.999999
@
      -}
    | Local !LocalTime

      {- | Local date (only day):

@
ld1 = 1979-05-27
@
      -}
    | Day !Day

      {- | Local time (time of the day):

@
lt1 = 07:32:00
lt2 = 00:32:00.999999

@
      -}
    | Hours !TimeOfDay
    deriving (Show)

instance Eq DateTime where
    (Zoned a) == (Zoned b) = zonedTimeToUTC a == zonedTimeToUTC b
    (Local a) == (Local b) = a == b
    (Day a)   == (Day b)   = a == b
    (Hours a) == (Hours b) = a == b
    _         == _         = False


-- | Ensures that 'UValue's represents type-safe version of @toml@.
typeCheck :: UValue -> Maybe AnyValue
typeCheck (UBool b)   = justAny $ Bool b
typeCheck (UInt n)    = justAny $ Int n
typeCheck (UFloat f)  = justAny $ Float f
typeCheck (UString s) = justAny $ String s
typeCheck (UDate d)   = justAny $ Date d
typeCheck (UArray a)  = case a of
    []     -> justAny $ Array []
    (x:xs) -> do
        AnyValue v <- typeCheck x
        AnyValue . Array <$> checkElem v xs
  where
    checkElem :: Value t -> [UValue] -> Maybe [Value t]
    checkElem v []     = Just [v]
    checkElem v (x:xs) = do
        AnyValue vx <- typeCheck x
        Refl <- sameValue v vx
        (v :) <$> checkElem vx xs

justAny :: Value t -> Maybe AnyValue
justAny = Just . AnyValue

sameValue :: Value a -> Value b -> Maybe (a :~: b)
sameValue Bool{}   Bool{}   = Just Refl
sameValue Int{}    Int{}    = Just Refl
sameValue Float{}  Float{}  = Just Refl
sameValue String{} String{} = Just Refl
sameValue Date{}   Date{}   = Just Refl
sameValue Array{}  Array{}  = Just Refl
sameValue _        _        = Nothing