{-# language FlexibleInstances #-}
{-# language MonoLocalBinds #-}
{-# language MultiWayIf #-}
{-# language StandaloneKindSignatures #-}
{-# language UndecidableInstances #-}

module Rel8.Type
  ( DBType (typeInformation)
  )
where

-- aeson
import Data.Aeson ( Value )
import qualified Data.Aeson as Aeson

-- base
import Data.Int ( Int16, Int32, Int64 )
import Data.List.NonEmpty ( NonEmpty )
import Data.Kind ( Constraint, Type )
import Prelude

-- bytestring
import Data.ByteString ( ByteString )
import qualified Data.ByteString.Lazy as Lazy ( ByteString )
import qualified Data.ByteString.Lazy as ByteString ( fromStrict, toStrict )

-- case-insensitive
import Data.CaseInsensitive ( CI )
import qualified Data.CaseInsensitive as CI

-- hasql
import qualified Hasql.Decoders as Hasql

-- opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
import qualified Opaleye.Internal.HaskellDB.Sql.Default as Opaleye ( quote )

-- rel8
import Rel8.Schema.Null ( NotNull, Sql, nullable )
import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )
import Rel8.Type.Information ( TypeInformation(..), mapTypeInformation )

-- scientific
import Data.Scientific ( Scientific )

-- text
import Data.Text ( Text )
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy ( Text, unpack )
import qualified Data.Text.Lazy as Text ( fromStrict, toStrict )
import qualified Data.Text.Lazy.Encoding as Lazy ( decodeUtf8 )

-- time
import Data.Time.Calendar ( Day )
import Data.Time.Clock ( UTCTime )
import Data.Time.LocalTime
  ( CalendarDiffTime( CalendarDiffTime )
  , LocalTime
  , TimeOfDay
  )
import Data.Time.Format ( formatTime, defaultTimeLocale )

-- uuid
import Data.UUID ( UUID )
import qualified Data.UUID as UUID


-- | Haskell types that can be represented as expressions in a database. There
-- should be an instance of @DBType@ for all column types in your database
-- schema (e.g., @int@, @timestamptz@, etc).
-- 
-- Rel8 comes with stock instances for most default types in PostgreSQL, so you
-- should only need to derive instances of this class for custom database
-- types, such as types defined in PostgreSQL extensions, or custom domain
-- types.
type DBType :: Type -> Constraint
class NotNull a => DBType a where
  typeInformation :: TypeInformation a


-- | Corresponds to @bool@
instance DBType Bool where
  typeInformation :: TypeInformation Bool
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: Bool -> PrimExpr
encode = Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr) -> (Bool -> Literal) -> Bool -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Literal
Opaleye.BoolLit
    , decode :: Value Bool
decode = Value Bool
Hasql.bool
    , typeName :: String
typeName = String
"bool"
    }


-- | Corresponds to @char@
instance DBType Char where
  typeInformation :: TypeInformation Char
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: Char -> PrimExpr
encode = Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr) -> (Char -> Literal) -> Char -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
Opaleye.StringLit (String -> Literal) -> (Char -> String) -> Char -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    , decode :: Value Char
decode = Value Char
Hasql.char
    , typeName :: String
typeName = String
"char"
    }


-- | Corresponds to @int2@
instance DBType Int16 where
  typeInformation :: TypeInformation Int16
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: Int16 -> PrimExpr
encode = Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr) -> (Int16 -> Literal) -> Int16 -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
Opaleye.IntegerLit (Integer -> Literal) -> (Int16 -> Integer) -> Int16 -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Integer
forall a. Integral a => a -> Integer
toInteger
    , decode :: Value Int16
decode = Value Int16
Hasql.int2
    , typeName :: String
typeName = String
"int2"
    }


-- | Corresponds to @int4@
instance DBType Int32 where
  typeInformation :: TypeInformation Int32
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: Int32 -> PrimExpr
encode = Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr) -> (Int32 -> Literal) -> Int32 -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
Opaleye.IntegerLit (Integer -> Literal) -> (Int32 -> Integer) -> Int32 -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger
    , decode :: Value Int32
decode = Value Int32
Hasql.int4
    , typeName :: String
typeName = String
"int4"
    }


-- | Corresponds to @int8@
instance DBType Int64 where
  typeInformation :: TypeInformation Int64
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: Int64 -> PrimExpr
encode = Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr) -> (Int64 -> Literal) -> Int64 -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
Opaleye.IntegerLit (Integer -> Literal) -> (Int64 -> Integer) -> Int64 -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger
    , decode :: Value Int64
decode = Value Int64
Hasql.int8
    , typeName :: String
typeName = String
"int8"
    }


-- | Corresponds to @float4@
instance DBType Float where
  typeInformation :: TypeInformation Float
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: Float -> PrimExpr
encode = \Float
x -> Literal -> PrimExpr
Opaleye.ConstExpr
        if | Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== (Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0) -> String -> Literal
Opaleye.OtherLit String
"'Infinity'"
           | Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
x     -> String -> Literal
Opaleye.OtherLit String
"'NaN'"
           | Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== (-Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0) -> String -> Literal
Opaleye.OtherLit String
"'-Infinity'"
           | Bool
otherwise   -> Scientific -> Literal
Opaleye.NumericLit (Scientific -> Literal) -> Scientific -> Literal
forall a b. (a -> b) -> a -> b
$ Float -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x
    , decode :: Value Float
decode = Value Float
Hasql.float4
    , typeName :: String
typeName = String
"float4"
    }


-- | Corresponds to @float8@
instance DBType Double where
  typeInformation :: TypeInformation Double
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: Double -> PrimExpr
encode = \Double
x -> Literal -> PrimExpr
Opaleye.ConstExpr
        if | Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0) -> String -> Literal
Opaleye.OtherLit String
"'Infinity'"
           | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x     -> String -> Literal
Opaleye.OtherLit String
"'NaN'"
           | Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== (-Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0) -> String -> Literal
Opaleye.OtherLit String
"'-Infinity'"
           | Bool
otherwise   -> Scientific -> Literal
Opaleye.NumericLit (Scientific -> Literal) -> Scientific -> Literal
forall a b. (a -> b) -> a -> b
$ Double -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x
    , decode :: Value Double
decode = Value Double
Hasql.float8
    , typeName :: String
typeName = String
"float8"
    }


-- | Corresponds to @numeric@
instance DBType Scientific where
  typeInformation :: TypeInformation Scientific
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: Scientific -> PrimExpr
encode = Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr)
-> (Scientific -> Literal) -> Scientific -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Literal
Opaleye.NumericLit
    , decode :: Value Scientific
decode = Value Scientific
Hasql.numeric
    , typeName :: String
typeName = String
"numeric"
    }


-- | Corresponds to @timestamptz@
instance DBType UTCTime where
  typeInformation :: TypeInformation UTCTime
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: UTCTime -> PrimExpr
encode =
        Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr)
-> (UTCTime -> Literal) -> UTCTime -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
Opaleye.OtherLit (String -> Literal) -> (UTCTime -> String) -> UTCTime -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"'%FT%T%QZ'"
    , decode :: Value UTCTime
decode = Value UTCTime
Hasql.timestamptz
    , typeName :: String
typeName = String
"timestamptz"
    }


-- | Corresponds to @date@
instance DBType Day where
  typeInformation :: TypeInformation Day
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: Day -> PrimExpr
encode =
        Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr) -> (Day -> Literal) -> Day -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
Opaleye.OtherLit (String -> Literal) -> (Day -> String) -> Day -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"'%F'"
    , decode :: Value Day
decode = Value Day
Hasql.date
    , typeName :: String
typeName = String
"date"
    }


-- | Corresponds to @timestamp@
instance DBType LocalTime where
  typeInformation :: TypeInformation LocalTime
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: LocalTime -> PrimExpr
encode =
        Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr)
-> (LocalTime -> Literal) -> LocalTime -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
Opaleye.OtherLit (String -> Literal)
-> (LocalTime -> String) -> LocalTime -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        TimeLocale -> String -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"'%FT%T%Q'"
    , decode :: Value LocalTime
decode = Value LocalTime
Hasql.timestamp
    , typeName :: String
typeName = String
"timestamp"
    }


-- | Corresponds to @time@
instance DBType TimeOfDay where
  typeInformation :: TypeInformation TimeOfDay
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: TimeOfDay -> PrimExpr
encode =
        Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr)
-> (TimeOfDay -> Literal) -> TimeOfDay -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
Opaleye.OtherLit (String -> Literal)
-> (TimeOfDay -> String) -> TimeOfDay -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        TimeLocale -> String -> TimeOfDay -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"'%T%Q'"
    , decode :: Value TimeOfDay
decode = Value TimeOfDay
Hasql.time
    , typeName :: String
typeName = String
"time"
    }


-- | Corresponds to @interval@
instance DBType CalendarDiffTime where
  typeInformation :: TypeInformation CalendarDiffTime
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: CalendarDiffTime -> PrimExpr
encode =
        Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr)
-> (CalendarDiffTime -> Literal) -> CalendarDiffTime -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
Opaleye.OtherLit (String -> Literal)
-> (CalendarDiffTime -> String) -> CalendarDiffTime -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        TimeLocale -> String -> CalendarDiffTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"'%bmon %0Es'"
    , decode :: Value CalendarDiffTime
decode = Integer -> NominalDiffTime -> CalendarDiffTime
CalendarDiffTime Integer
0 (NominalDiffTime -> CalendarDiffTime)
-> (DiffTime -> NominalDiffTime) -> DiffTime -> CalendarDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (DiffTime -> CalendarDiffTime)
-> Value DiffTime -> Value CalendarDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value DiffTime
Hasql.interval
    , typeName :: String
typeName = String
"interval"
    }


-- | Corresponds to @text@
instance DBType Text where
  typeInformation :: TypeInformation Text
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: Text -> PrimExpr
encode = Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr) -> (Text -> Literal) -> Text -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
Opaleye.StringLit (String -> Literal) -> (Text -> String) -> Text -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
    , decode :: Value Text
decode = Value Text
Hasql.text
    , typeName :: String
typeName = String
"text"
    }


-- | Corresponds to @text@
instance DBType Lazy.Text where
  typeInformation :: TypeInformation Text
typeInformation =
    (Text -> Text)
-> (Text -> Text) -> TypeInformation Text -> TypeInformation Text
forall a b.
(a -> b) -> (b -> a) -> TypeInformation a -> TypeInformation b
mapTypeInformation Text -> Text
Text.fromStrict Text -> Text
Text.toStrict TypeInformation Text
forall a. DBType a => TypeInformation a
typeInformation


-- | Corresponds to @citext@
instance DBType (CI Text) where
  typeInformation :: TypeInformation (CI Text)
typeInformation = (Text -> CI Text)
-> (CI Text -> Text)
-> TypeInformation Text
-> TypeInformation (CI Text)
forall a b.
(a -> b) -> (b -> a) -> TypeInformation a -> TypeInformation b
mapTypeInformation Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk CI Text -> Text
forall s. CI s -> s
CI.original TypeInformation Text
forall a. DBType a => TypeInformation a
typeInformation
    { typeName :: String
typeName = String
"citext"
    }


-- | Corresponds to @citext@
instance DBType (CI Lazy.Text) where
  typeInformation :: TypeInformation (CI Text)
typeInformation = (Text -> CI Text)
-> (CI Text -> Text)
-> TypeInformation Text
-> TypeInformation (CI Text)
forall a b.
(a -> b) -> (b -> a) -> TypeInformation a -> TypeInformation b
mapTypeInformation Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk CI Text -> Text
forall s. CI s -> s
CI.original TypeInformation Text
forall a. DBType a => TypeInformation a
typeInformation
    { typeName :: String
typeName = String
"citext"
    }


-- | Corresponds to @bytea@
instance DBType ByteString where
  typeInformation :: TypeInformation ByteString
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: ByteString -> PrimExpr
encode = Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr)
-> (ByteString -> Literal) -> ByteString -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Literal
Opaleye.ByteStringLit
    , decode :: Value ByteString
decode = Value ByteString
Hasql.bytea
    , typeName :: String
typeName = String
"bytea"
    }


-- | Corresponds to @bytea@
instance DBType Lazy.ByteString where
  typeInformation :: TypeInformation ByteString
typeInformation =
    (ByteString -> ByteString)
-> (ByteString -> ByteString)
-> TypeInformation ByteString
-> TypeInformation ByteString
forall a b.
(a -> b) -> (b -> a) -> TypeInformation a -> TypeInformation b
mapTypeInformation ByteString -> ByteString
ByteString.fromStrict ByteString -> ByteString
ByteString.toStrict
      TypeInformation ByteString
forall a. DBType a => TypeInformation a
typeInformation


-- | Corresponds to @uuid@
instance DBType UUID where
  typeInformation :: TypeInformation UUID
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: UUID -> PrimExpr
encode = Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr) -> (UUID -> Literal) -> UUID -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
Opaleye.StringLit (String -> Literal) -> (UUID -> String) -> UUID -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
UUID.toString
    , decode :: Value UUID
decode = Value UUID
Hasql.uuid
    , typeName :: String
typeName = String
"uuid"
    }


-- | Corresponds to @jsonb@
instance DBType Value where
  typeInformation :: TypeInformation Value
typeInformation = TypeInformation :: forall a. (a -> PrimExpr) -> Value a -> String -> TypeInformation a
TypeInformation
    { encode :: Value -> PrimExpr
encode =
        Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr) -> (Value -> Literal) -> Value -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
Opaleye.OtherLit (String -> Literal) -> (Value -> String) -> Value -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> String
Opaleye.quote (String -> String) -> (Value -> String) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Text -> String
Lazy.unpack (Text -> String) -> (Value -> Text) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Lazy.decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode
    , decode :: Value Value
decode = Value Value
Hasql.jsonb
    , typeName :: String
typeName = String
"jsonb"
    }


instance Sql DBType a => DBType [a] where
  typeInformation :: TypeInformation [a]
typeInformation = Nullity a -> TypeInformation (Unnullify a) -> TypeInformation [a]
forall a.
Nullity a -> TypeInformation (Unnullify a) -> TypeInformation [a]
listTypeInformation Nullity a
forall a. Nullable a => Nullity a
nullable TypeInformation (Unnullify a)
forall a. DBType a => TypeInformation a
typeInformation


instance Sql DBType a => DBType (NonEmpty a) where
  typeInformation :: TypeInformation (NonEmpty a)
typeInformation = Nullity a
-> TypeInformation (Unnullify a) -> TypeInformation (NonEmpty a)
forall a.
Nullity a
-> TypeInformation (Unnullify a) -> TypeInformation (NonEmpty a)
nonEmptyTypeInformation Nullity a
forall a. Nullable a => Nullity a
nullable TypeInformation (Unnullify a)
forall a. DBType a => TypeInformation a
typeInformation