{-# LANGUAGE AllowAmbiguousTypes, UndecidableInstances, FlexibleInstances, IncoherentInstances, PolyKinds #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Consolidates all postgresql-simple FromField\/ToField\/FromRow orphan instances
-- for IHP model types.
--
-- Note: JobStatus FromField\/ToField instances remain in "IHP.Job.Queue" to
-- avoid a circular dependency through @IHP.Job.Types -> IHP.Prelude -> IHP.ModelSupport@.
module IHP.PGSimpleCompat () where

import Prelude
import Data.String (IsString(..))
import Data.String.Conversions (cs)
import Data.Data (Typeable)
import GHC.TypeLits (KnownSymbol, symbolVal)
import Database.PostgreSQL.Simple.FromField (FromField(..))
import Database.PostgreSQL.Simple.ToField (ToField(..), Action(..))
import qualified Database.PostgreSQL.Simple.FromRow as PGFR
import qualified Database.PostgreSQL.Simple.Types as PG
import IHP.ModelSupport.Types (Id'(..), PrimaryKey, LabeledData(..), FieldWithDefault(..), FieldWithUpdate(..))
import IHP.NameSupport (fieldNameToColumnName)

-- Id instances

instance FromField (PrimaryKey model) => FromField (Id' model) where
    {-# INLINE fromField #-}
    fromField :: FieldParser (Id' model)
fromField Field
value Maybe ByteString
metaData = do
        fieldValue <- FieldParser (PrimaryKey model)
forall a. FromField a => FieldParser a
fromField Field
value Maybe ByteString
metaData
        pure (Id fieldValue)

instance ToField (PrimaryKey model) => ToField (Id' model) where
    {-# INLINE toField #-}
    toField :: Id' model -> Action
toField (Id PrimaryKey model
pk) = PrimaryKey model -> Action
forall a. ToField a => a -> Action
toField PrimaryKey model
pk

instance (ToField (Id' a), ToField (Id' b)) => ToField (Id' a, Id' b) where
    {-# INLINE toField #-}
    toField :: (Id' a, Id' b) -> Action
toField (Id' a
a, Id' b
b) = [Action] -> Action
Many [Builder -> Action
Plain Builder
"(", Id' a -> Action
forall a. ToField a => a -> Action
toField Id' a
a, Builder -> Action
Plain Builder
",", Id' b -> Action
forall a. ToField a => a -> Action
toField Id' b
b, Builder -> Action
Plain Builder
")"]

-- LabeledData instance

instance (FromField label, PGFR.FromRow a) => PGFR.FromRow (LabeledData label a) where
    fromRow :: RowParser (LabeledData label a)
fromRow = label -> a -> LabeledData label a
forall a b. a -> b -> LabeledData a b
LabeledData (label -> a -> LabeledData label a)
-> RowParser label -> RowParser (a -> LabeledData label a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser label
forall a. FromField a => RowParser a
PGFR.field RowParser (a -> LabeledData label a)
-> RowParser a -> RowParser (LabeledData label a)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser a
forall a. FromRow a => RowParser a
PGFR.fromRow

-- FieldWithDefault / FieldWithUpdate instances

instance ToField valueType => ToField (FieldWithDefault valueType) where
    toField :: FieldWithDefault valueType -> Action
toField FieldWithDefault valueType
Default = Builder -> Action
Plain Builder
"DEFAULT"
    toField (NonDefault valueType
a) = valueType -> Action
forall a. ToField a => a -> Action
toField valueType
a

instance (KnownSymbol name, ToField value) => ToField (FieldWithUpdate name value) where
    toField :: FieldWithUpdate name value -> Action
toField (NoUpdate Proxy name
name) =
        Builder -> Action
Plain (String -> Builder
forall a. IsString a => String -> a
fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
fieldNameToColumnName (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy name
name)
    toField (Update value
a) = value -> Action
forall a. ToField a => a -> Action
toField value
a

-- List instances (PGArray wrappers)

instance ToField value => ToField [value] where
    toField :: [value] -> Action
toField [value]
list = PGArray value -> Action
forall a. ToField a => a -> Action
toField ([value] -> PGArray value
forall a. [a] -> PGArray a
PG.PGArray [value]
list)

instance (FromField value, Typeable value) => FromField [value] where
    fromField :: FieldParser [value]
fromField Field
field Maybe ByteString
value = PGArray value -> [value]
forall a. PGArray a -> [a]
PG.fromPGArray (PGArray value -> [value])
-> Conversion (PGArray value) -> Conversion [value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FieldParser (PGArray value)
forall a. FromField a => FieldParser a
fromField Field
field Maybe ByteString
value)