-- | SQL types and functions to create 'Opaleye.Field.Field_'s of
-- those types.  To create fields you may find it more convenient to use
-- "Opaleye.ToFields" instead.

module Opaleye.SqlTypes (
  -- * Numeric
  -- ** Creating values
  sqlInt4,
  sqlDouble,
  sqlInt8,
  sqlNumeric,
  -- ** Types
  SqlInt4,
  SqlFloat8,
  SqlNumeric,
  SqlInt8,
  SqlInt2,
  SqlFloat4,
  -- ** Type classes
  IC.SqlNum,
  IC.SqlIntegral,
  IC.SqlFractional,
  -- * Date and time
  -- ** Creating values
  sqlDay,
  sqlUTCTime,
  sqlLocalTime,
  sqlZonedTime,
  sqlTimeOfDay,
  P.sqlInterval,
  -- ** Types
  SqlDate,
  SqlTime,
  SqlTimestamp,
  SqlTimestamptz,
  SqlInterval,
  -- * JSON
  -- ** Creating values
  sqlJSON,
  sqlStrictJSON,
  sqlLazyJSON,
  sqlValueJSON,
  -- ** Types
  SqlJson,
  -- * JSONB
  -- ** Creating values
  sqlJSONB,
  sqlStrictJSONB,
  sqlLazyJSONB,
  sqlValueJSONB,
  -- ** Types
  SqlJsonb,
  -- * Text
  -- ** Creating values
  sqlString,
  sqlStrictText,
  sqlLazyText,
  P.sqlStringVarcharN,
  P.sqlStrictTextVarcharN,
  P.sqlLazyTextVarcharN,
  sqlCiStrictText,
  sqlCiLazyText,
  -- ** Types
  SqlText,
  SqlVarcharN,
  SqlCitext,
  -- ** Type classes
  IC.SqlString,
  -- * Array
  -- ** Creating values
  sqlArray,
  -- ** Types
  SqlArray,
  SqlArray_,
  -- * Range
  -- ** Creating values
  sqlRange,
  -- ** Types
  SqlRange,
  P.IsRangeType,
  -- * Other
  -- ** Creating values
  sqlBool,
  sqlUUID,
  sqlLazyByteString,
  sqlStrictByteString,
  -- ** Types
  SqlBool,
  SqlUuid,
  SqlBytea,
  -- * @IsSqlType@
  P.IsSqlType(P.showSqlType),
  IPT.sqlTypeWithSchema,
  ) where

import qualified Opaleye.Field   as F
import qualified Opaleye.Internal.Column as IC
import qualified Opaleye.Internal.PGTypes as IPT
import qualified Opaleye.Internal.PGTypesExternal as P
import           Opaleye.Internal.PGTypesExternal (IsSqlType, IsRangeType)
import           Opaleye.Internal.PGTypesExternal (SqlBool,
                                                   SqlDate,
                                                   SqlFloat4,
                                                   SqlFloat8,
                                                   SqlInt8,
                                                   SqlInt4,
                                                   SqlInt2,
                                                   SqlNumeric,
                                                   SqlText,
                                                   SqlVarcharN,
                                                   SqlTime,
                                                   SqlTimestamp,
                                                   SqlTimestamptz,
                                                   SqlInterval,
                                                   SqlUuid,
                                                   SqlCitext,
                                                   SqlArray,
                                                   SqlArray_,
                                                   SqlBytea,
                                                   SqlJson,
                                                   SqlJsonb,
                                                   SqlRange)

import qualified Data.Aeson as Ae
import qualified Data.ByteString as SByteString
import qualified Data.ByteString.Lazy as LByteString
import qualified Data.CaseInsensitive as CI
import           Data.Int (Int64)
import           Data.Scientific as Sci
import qualified Data.Text as SText
import qualified Data.Text.Lazy as LText
import qualified Data.Time.Compat as Time
import qualified Data.UUID as UUID

import qualified Database.PostgreSQL.Simple.Range as R

-- * Creating SQL values

sqlString :: String -> F.Field SqlText
sqlString :: String -> Field SqlText
sqlString = String -> Field SqlText
P.pgString

sqlLazyByteString :: LByteString.ByteString -> F.Field SqlBytea
sqlLazyByteString :: ByteString -> Field SqlBytea
sqlLazyByteString = ByteString -> Field SqlBytea
P.pgLazyByteString

sqlStrictByteString :: SByteString.ByteString -> F.Field SqlBytea
sqlStrictByteString :: ByteString -> Field SqlBytea
sqlStrictByteString = ByteString -> Field SqlBytea
P.pgStrictByteString

sqlStrictText :: SText.Text -> F.Field SqlText
sqlStrictText :: Text -> Field SqlText
sqlStrictText = Text -> Field SqlText
P.pgStrictText

sqlLazyText :: LText.Text -> F.Field SqlText
sqlLazyText :: Text -> Field SqlText
sqlLazyText = Text -> Field SqlText
P.pgLazyText

sqlNumeric :: Sci.Scientific -> F.Field SqlNumeric
sqlNumeric :: Scientific -> Field SqlNumeric
sqlNumeric = Scientific -> Field SqlNumeric
P.pgNumeric

sqlInt4 :: Int -> F.Field SqlInt4
sqlInt4 :: Int -> Field SqlInt4
sqlInt4 = Int -> Field SqlInt4
P.pgInt4

sqlInt8 :: Int64 -> F.Field SqlInt8
sqlInt8 :: Int64 -> Field SqlInt8
sqlInt8 = Int64 -> Field SqlInt8
P.pgInt8

sqlDouble :: Double -> F.Field SqlFloat8
sqlDouble :: Double -> Field SqlFloat8
sqlDouble = Double -> Field SqlFloat8
P.pgDouble

sqlBool :: Bool -> F.Field SqlBool
sqlBool :: Bool -> Field SqlBool
sqlBool = Bool -> Field SqlBool
P.pgBool

sqlUUID :: UUID.UUID -> F.Field SqlUuid
sqlUUID :: UUID -> Field SqlUuid
sqlUUID = UUID -> Field SqlUuid
P.pgUUID

sqlDay :: Time.Day -> F.Field SqlDate
sqlDay :: Day -> Field SqlDate
sqlDay = Day -> Field SqlDate
P.pgDay

sqlUTCTime :: Time.UTCTime -> F.Field SqlTimestamptz
sqlUTCTime :: UTCTime -> Field SqlTimestamptz
sqlUTCTime = UTCTime -> Field SqlTimestamptz
P.pgUTCTime

sqlLocalTime :: Time.LocalTime -> F.Field SqlTimestamp
sqlLocalTime :: LocalTime -> Field SqlTimestamp
sqlLocalTime = LocalTime -> Field SqlTimestamp
P.pgLocalTime

sqlZonedTime :: Time.ZonedTime -> F.Field SqlTimestamptz
sqlZonedTime :: ZonedTime -> Field SqlTimestamptz
sqlZonedTime = ZonedTime -> Field SqlTimestamptz
P.pgZonedTime

sqlTimeOfDay :: Time.TimeOfDay -> F.Field SqlTime
sqlTimeOfDay :: TimeOfDay -> Field SqlTime
sqlTimeOfDay = TimeOfDay -> Field SqlTime
P.pgTimeOfDay

-- "We recommend not using the type time with time zone"
-- http://www.postgresql.org/docs/8.3/static/datatype-datetime.html

sqlCiStrictText :: CI.CI SText.Text -> F.Field SqlCitext
sqlCiStrictText :: CI Text -> Field SqlCitext
sqlCiStrictText = CI Text -> Field SqlCitext
P.pgCiStrictText

sqlCiLazyText :: CI.CI LText.Text -> F.Field SqlCitext
sqlCiLazyText :: CI Text -> Field SqlCitext
sqlCiLazyText = CI Text -> Field SqlCitext
P.pgCiLazyText

-- No CI String instance since postgresql-simple doesn't define FromField (CI String)

-- The json data type was introduced in PostgreSQL version 9.2
-- JSON values must be SQL string quoted
sqlJSON :: String -> F.Field SqlJson
sqlJSON :: String -> Field SqlJson
sqlJSON = String -> Field SqlJson
P.pgJSON

sqlStrictJSON :: SByteString.ByteString -> F.Field SqlJson
sqlStrictJSON :: ByteString -> Field SqlJson
sqlStrictJSON = ByteString -> Field SqlJson
P.pgStrictJSON

sqlLazyJSON :: LByteString.ByteString -> F.Field SqlJson
sqlLazyJSON :: ByteString -> Field SqlJson
sqlLazyJSON = ByteString -> Field SqlJson
P.pgLazyJSON

sqlValueJSON :: Ae.ToJSON a => a -> F.Field SqlJson
sqlValueJSON :: forall a. ToJSON a => a -> Field SqlJson
sqlValueJSON = a -> Field SqlJson
forall a. ToJSON a => a -> Field SqlJson
P.pgValueJSON

-- The jsonb data type was introduced in PostgreSQL version 9.4
-- JSONB values must be SQL string quoted
--
-- TODO: We need to add literal JSON and JSONB types so we can say
-- `castToTypeTyped JSONB` rather than `castToType "jsonb"`.
sqlJSONB :: String -> F.Field SqlJsonb
sqlJSONB :: String -> Field SqlJsonb
sqlJSONB = String -> Field SqlJsonb
P.pgJSONB

sqlStrictJSONB :: SByteString.ByteString -> F.Field SqlJsonb
sqlStrictJSONB :: ByteString -> Field SqlJsonb
sqlStrictJSONB = ByteString -> Field SqlJsonb
P.pgStrictJSONB

sqlLazyJSONB :: LByteString.ByteString -> F.Field SqlJsonb
sqlLazyJSONB :: ByteString -> Field SqlJsonb
sqlLazyJSONB = ByteString -> Field SqlJsonb
P.pgLazyJSONB

sqlValueJSONB :: Ae.ToJSON a => a -> F.Field SqlJsonb
sqlValueJSONB :: forall a. ToJSON a => a -> Field SqlJsonb
sqlValueJSONB = a -> Field SqlJsonb
forall a. ToJSON a => a -> Field SqlJsonb
P.pgValueJSONB

sqlArray :: IsSqlType b => (a -> F.Field_ n b) -> [a] -> F.Field (SqlArray_ n b)
sqlArray :: forall b a (n :: Nullability).
IsSqlType b =>
(a -> Field_ n b) -> [a] -> Field (SqlArray_ n b)
sqlArray = (a -> Field_ n b) -> [a] -> Field (SqlArray_ n b)
forall a b (n :: Nullability).
IsSqlType b =>
(a -> Field_ n b) -> [a] -> Field (SqlArray_ n b)
P.pgArray

sqlRange :: IsRangeType b
         => (a -> F.Field b)
         -> R.RangeBound a
         -> R.RangeBound a
         -> F.Field (SqlRange b)
sqlRange :: forall b a.
IsRangeType b =>
(a -> Field b)
-> RangeBound a -> RangeBound a -> Field (SqlRange b)
sqlRange = (a -> Field_ 'NonNullable b)
-> RangeBound a -> RangeBound a -> Field_ 'NonNullable (SqlRange b)
forall a b (n :: Nullability) (n' :: Nullability).
IsRangeType b =>
(a -> Field_ n b)
-> RangeBound a -> RangeBound a -> Field_ n' (SqlRange b)
P.pgRange