{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}

module Simplex.Messaging.Agent.Store.Entity
  ( DBStored (..),
    SDBStored (..),
    DBStoredI (..),
    DBEntityId,
    DBEntityId' (..),
  )
where

import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson as J
import qualified Data.Aeson.Encoding as JE
import Data.Int (Int64)
import Data.Scientific (floatingOrInteger)
import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))

data DBStored = DBStored | DBNew

data SDBStored (s :: DBStored) where
  SDBStored :: SDBStored 'DBStored
  SDBNew :: SDBStored 'DBNew

deriving instance Show (SDBStored s)

class DBStoredI s where sdbStored :: SDBStored s

instance DBStoredI 'DBStored where sdbStored :: SDBStored 'DBStored
sdbStored = SDBStored 'DBStored
SDBStored

instance DBStoredI 'DBNew where sdbStored :: SDBStored 'DBNew
sdbStored = SDBStored 'DBNew
SDBNew

data DBEntityId' (s :: DBStored) where
  DBEntityId :: Int64 -> DBEntityId' 'DBStored
  DBNewEntity :: DBEntityId' 'DBNew

deriving instance Show (DBEntityId' s)

deriving instance Eq (DBEntityId' s)

type DBEntityId = DBEntityId' 'DBStored

type DBNewEntity = DBEntityId' 'DBNew

instance ToJSON (DBEntityId' s) where
  toEncoding :: DBEntityId' s -> Encoding
toEncoding = \case
    DBEntityId Int64
i -> Int64 -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Int64
i
    DBEntityId' s
DBNewEntity -> Encoding
JE.null_
  toJSON :: DBEntityId' s -> Value
toJSON = \case
    DBEntityId Int64
i -> Int64 -> Value
forall a. ToJSON a => a -> Value
toJSON Int64
i
    DBEntityId' s
DBNewEntity -> Value
J.Null

instance DBStoredI s => FromJSON (DBEntityId' s) where
  parseJSON :: Value -> Parser (DBEntityId' s)
parseJSON Value
v = case (Value
v, forall (s :: DBStored). DBStoredI s => SDBStored s
sdbStored @s) of
    (Value
J.Null, SDBStored s
SDBNew) -> DBEntityId' s -> Parser (DBEntityId' s)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DBEntityId' s
DBEntityId' 'DBNew
DBNewEntity
    (J.Number Scientific
n, SDBStored s
SDBStored) -> case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
n of
      Left (Double
_ :: Double) -> String -> Parser (DBEntityId' s)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad DBEntityId"
      Right Integer
i -> DBEntityId' 'DBStored -> Parser (DBEntityId' 'DBStored)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DBEntityId' 'DBStored -> Parser (DBEntityId' 'DBStored))
-> DBEntityId' 'DBStored -> Parser (DBEntityId' 'DBStored)
forall a b. (a -> b) -> a -> b
$ Int64 -> DBEntityId' 'DBStored
DBEntityId (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
i)
    (Value, SDBStored s)
_ -> String -> Parser (DBEntityId' s)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad DBEntityId"
  omittedField :: Maybe (DBEntityId' s)
omittedField = case forall (s :: DBStored). DBStoredI s => SDBStored s
sdbStored @s of
    SDBStored s
SDBStored -> Maybe (DBEntityId' s)
forall a. Maybe a
Nothing
    SDBStored s
SDBNew -> DBEntityId' s -> Maybe (DBEntityId' s)
forall a. a -> Maybe a
Just DBEntityId' s
DBEntityId' 'DBNew
DBNewEntity

instance FromField DBEntityId where
#if defined(dbPostgres)
  fromField x dat = DBEntityId <$> fromField x dat
#else
  fromField :: FieldParser (DBEntityId' 'DBStored)
fromField Field
x = Int64 -> DBEntityId' 'DBStored
DBEntityId (Int64 -> DBEntityId' 'DBStored)
-> Ok Int64 -> Ok (DBEntityId' 'DBStored)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser Int64
forall a. FromField a => FieldParser a
fromField Field
x
#endif

instance ToField DBEntityId where toField :: DBEntityId' 'DBStored -> SQLData
toField (DBEntityId Int64
i) = Int64 -> SQLData
forall a. ToField a => a -> SQLData
toField Int64
i