{-# language LambdaCase #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language MonoLocalBinds #-}
{-# language MultiWayIf #-}
{-# language OverloadedStrings #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language UndecidableInstances #-}

module Rel8.Type
  ( DBType (typeInformation)
  )
where

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

-- attoparsec
import qualified Data.Attoparsec.ByteString.Char8 as A

-- attoparsec-aeson
import qualified Data.Aeson.Parser as Aeson

-- base
import Control.Applicative ((<|>))
import Data.Fixed (Fixed)
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 as BS
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

-- data-textual
import Data.Textual (textual)

-- hasql
import qualified Hasql.Decoders as Hasql

-- network-ip
import qualified Network.IP.Addr as IP

-- 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.Decimal (PowerOf10, resolution)
import Rel8.Type.Decoder ( Decoder(..) )
import Rel8.Type.Information ( TypeInformation(..), mapTypeInformation )
import Rel8.Type.Name (TypeName (..))
import Rel8.Type.Parser (parse)
import Rel8.Type.Parser.ByteString (bytestring)
import qualified Rel8.Type.Parser.Time as Time

-- scientific
import Data.Scientific ( Scientific )

-- text
import Data.Text ( Text )
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text (decodeUtf8)
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)

-- utf8
import qualified Data.ByteString.UTF8 as UTF8

-- 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
    { 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 :: Decoder Bool
decode =
        Decoder
          { binary :: Value Bool
binary = Value Bool
Hasql.bool
          , parser :: Parser Bool
parser = \case
              ByteString
"t" -> Bool -> Either String Bool
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
              ByteString
"f" -> Bool -> Either String Bool
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
              ByteString
input -> String -> Either String Bool
forall a b. a -> Either a b
Left (String -> Either String Bool) -> String -> Either String Bool
forall a b. (a -> b) -> a -> b
$ String
"bool: bad bool " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
input
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"bool"
    }


-- | Corresponds to @char@
instance DBType Char where
  typeInformation :: TypeInformation Char
typeInformation = 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 a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    , typeName :: TypeName
typeName =
        TypeName
          { name :: QualifiedName
name = QualifiedName
"bpchar"
          , modifiers :: [String]
modifiers = [String
"1"]
          , arrayDepth :: Word
arrayDepth = Word
0
          }
    , decode :: Decoder Char
decode = 
        Decoder
          { binary :: Value Char
binary = Value Char
Hasql.char
          , parser :: Parser Char
parser = \ByteString
input -> case ByteString -> Maybe (Char, ByteString)
UTF8.uncons ByteString
input of
              Just (Char
char, ByteString
rest) | ByteString -> Bool
BS.null ByteString
rest -> Char -> Either String Char
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
char
              Maybe (Char, ByteString)
_ -> String -> Either String Char
forall a b. a -> Either a b
Left (String -> Either String Char) -> String -> Either String Char
forall a b. (a -> b) -> a -> b
$ String
"char: bad char " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
input
          , delimiter :: Char
delimiter = Char
','
          }
    }


-- | Corresponds to @int2@
instance DBType Int16 where
  typeInformation :: TypeInformation Int16
typeInformation = 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 :: Decoder Int16
decode =
        Decoder
          { binary :: Value Int16
binary = Value Int16
Hasql.int2
          , parser :: Parser Int16
parser = Parser Int16 -> Parser Int16
forall a. Parser a -> ByteString -> Either String a
parse (Parser Int16 -> Parser Int16
forall a. Num a => Parser a -> Parser a
A.signed Parser Int16
forall a. Integral a => Parser a
A.decimal)
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"int2"
    }


-- | Corresponds to @int4@
instance DBType Int32 where
  typeInformation :: TypeInformation Int32
typeInformation = 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 :: Decoder Int32
decode =
        Decoder
          { binary :: Value Int32
binary = Value Int32
Hasql.int4
          , parser :: Parser Int32
parser = Parser Int32 -> Parser Int32
forall a. Parser a -> ByteString -> Either String a
parse (Parser Int32 -> Parser Int32
forall a. Num a => Parser a -> Parser a
A.signed Parser Int32
forall a. Integral a => Parser a
A.decimal)
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"int4"
    }


-- | Corresponds to @int8@
instance DBType Int64 where
  typeInformation :: TypeInformation Int64
typeInformation = 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 :: Decoder Int64
decode =
        Decoder
          { binary :: Value Int64
binary = Value Int64
Hasql.int8
          , parser :: Parser Int64
parser = Parser Int64 -> Parser Int64
forall a. Parser a -> ByteString -> Either String a
parse (Parser Int64 -> Parser Int64
forall a. Num a => Parser a -> Parser a
A.signed Parser Int64
forall a. Integral a => Parser a
A.decimal)
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"int8"
    }


-- | Corresponds to @float4@
instance DBType Float where
  typeInformation :: TypeInformation Float
typeInformation = 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
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
0) -> String -> Literal
Opaleye.OtherLit String
"'-Infinity'"
           | Bool
otherwise     -> Double -> Literal
Opaleye.DoubleLit (Double -> Literal) -> Double -> Literal
forall a b. (a -> b) -> a -> b
$ Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
x
    , decode :: Decoder Float
decode =
        Decoder
          { binary :: Value Float
binary = Value Float
Hasql.float4
          , parser :: Parser Float
parser = Parser Float -> Parser Float
forall a. Parser a -> ByteString -> Either String a
parse (Parser Float -> Parser Float
forall a. Floating a => Parser a -> Parser a
floating (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> Float) -> Parser ByteString Double -> Parser Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Double
A.double))
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"float4"
    }


-- | Corresponds to @float8@
instance DBType Double where
  typeInformation :: TypeInformation Double
typeInformation = 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
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0) -> String -> Literal
Opaleye.OtherLit String
"'-Infinity'"
           | Bool
otherwise     -> Double -> Literal
Opaleye.DoubleLit Double
x
    , decode :: Decoder Double
decode =
        Decoder
          { binary :: Value Double
binary = Value Double
Hasql.float8
          , parser :: Parser Double
parser = Parser ByteString Double -> Parser Double
forall a. Parser a -> ByteString -> Either String a
parse (Parser ByteString Double -> Parser ByteString Double
forall a. Floating a => Parser a -> Parser a
floating Parser ByteString Double
A.double)
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"float8"
    }


-- | Corresponds to @numeric@
instance DBType Scientific where
  typeInformation :: TypeInformation Scientific
typeInformation = 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 :: Decoder Scientific
decode =
        Decoder
          { binary :: Value Scientific
binary = Value Scientific
Hasql.numeric
          , parser :: Parser Scientific
parser = Parser Scientific -> Parser Scientific
forall a. Parser a -> ByteString -> Either String a
parse Parser Scientific
A.scientific
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"numeric"
    }


-- | Corresponds to @numeric(1000, log₁₀ n)@
instance PowerOf10 n => DBType (Fixed n) where
  typeInformation :: TypeInformation (Fixed n)
typeInformation = TypeInformation
    { encode :: Fixed n -> PrimExpr
encode = Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr)
-> (Fixed n -> Literal) -> Fixed n -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Literal
Opaleye.NumericLit (Scientific -> Literal)
-> (Fixed n -> Scientific) -> Fixed n -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed n -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac
    , decode :: Decoder (Fixed n)
decode =
        Scientific -> Fixed n
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Scientific -> Fixed n) -> Decoder Scientific -> Decoder (Fixed n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Decoder
          { binary :: Value Scientific
binary = Value Scientific
Hasql.numeric
          , parser :: Parser Scientific
parser = Parser Scientific -> Parser Scientific
forall a. Parser a -> ByteString -> Either String a
parse Parser Scientific
A.scientific
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName =
        TypeName
          { name :: QualifiedName
name = QualifiedName
"numeric"
          , modifiers :: [String]
modifiers = [String
"1000", Natural -> String
forall a. Show a => a -> String
show (forall n. PowerOf10 n => Natural
forall {a} (n :: a). PowerOf10 n => Natural
resolution @n)]
          , arrayDepth :: Word
arrayDepth = Word
0
          }
    }


-- | Corresponds to @timestamptz@
instance DBType UTCTime where
  typeInformation :: TypeInformation UTCTime
typeInformation = 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 :: Decoder UTCTime
decode =
        Decoder
          { binary :: Value UTCTime
binary = Value UTCTime
Hasql.timestamptz
          , parser :: Parser UTCTime
parser = Parser UTCTime -> Parser UTCTime
forall a. Parser a -> ByteString -> Either String a
parse Parser UTCTime
Time.utcTime
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"timestamptz"
    }


-- | Corresponds to @date@
instance DBType Day where
  typeInformation :: TypeInformation Day
typeInformation = 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 :: Decoder Day
decode =
        Decoder
          { binary :: Value Day
binary = Value Day
Hasql.date
          , parser :: Parser Day
parser = Parser Day -> Parser Day
forall a. Parser a -> ByteString -> Either String a
parse Parser Day
Time.day
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"date"
    }


-- | Corresponds to @timestamp@
instance DBType LocalTime where
  typeInformation :: TypeInformation LocalTime
typeInformation = 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 :: Decoder LocalTime
decode =
        Decoder
          { binary :: Value LocalTime
binary = Value LocalTime
Hasql.timestamp
          , parser :: Parser LocalTime
parser = Parser LocalTime -> Parser LocalTime
forall a. Parser a -> ByteString -> Either String a
parse Parser LocalTime
Time.localTime
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"timestamp"
    }


-- | Corresponds to @time@
instance DBType TimeOfDay where
  typeInformation :: TypeInformation TimeOfDay
typeInformation = 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 :: Decoder TimeOfDay
decode =
        Decoder
          { binary :: Value TimeOfDay
binary = Value TimeOfDay
Hasql.time
          , parser :: Parser TimeOfDay
parser = Parser TimeOfDay -> Parser TimeOfDay
forall a. Parser a -> ByteString -> Either String a
parse Parser TimeOfDay
Time.timeOfDay
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"time"
    }


-- | Corresponds to @interval@
instance DBType CalendarDiffTime where
  typeInformation :: TypeInformation CalendarDiffTime
typeInformation = 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 :: Decoder CalendarDiffTime
decode =
        Decoder
          { binary :: Value CalendarDiffTime
binary = 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
          , parser :: Parser CalendarDiffTime
parser = Parser CalendarDiffTime -> Parser CalendarDiffTime
forall a. Parser a -> ByteString -> Either String a
parse Parser CalendarDiffTime
Time.calendarDiffTime
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"interval"
    }


-- | Corresponds to @text@
instance DBType Text where
  typeInformation :: TypeInformation Text
typeInformation = 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 :: Decoder Text
decode =
        Decoder
          { binary :: Value Text
binary = Value Text
Hasql.text
          , parser :: Parser Text
parser = Text -> Either String Text
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either String Text) -> (ByteString -> Text) -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"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 = "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 = "citext"
    }


-- | Corresponds to @bytea@
instance DBType ByteString where
  typeInformation :: TypeInformation ByteString
typeInformation = 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 :: Decoder ByteString
decode =
        Decoder
          { binary :: Value ByteString
binary = Value ByteString
Hasql.bytea
          , parser :: Parser ByteString
parser = Parser ByteString -> Parser ByteString
forall a. Parser a -> ByteString -> Either String a
parse Parser ByteString
bytestring
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"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
    { 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 :: Decoder UUID
decode =
        Decoder
          { binary :: Value UUID
binary = Value UUID
Hasql.uuid
          , parser :: Parser UUID
parser = \ByteString
input -> case ByteString -> Maybe UUID
UUID.fromASCIIBytes ByteString
input of
              Just UUID
a -> UUID -> Either String UUID
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UUID
a
              Maybe UUID
Nothing -> String -> Either String UUID
forall a b. a -> Either a b
Left (String -> Either String UUID) -> String -> Either String UUID
forall a b. (a -> b) -> a -> b
$ String
"uuid: bad UUID " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
input
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"uuid"
    }


-- | Corresponds to @jsonb@
instance DBType Value where
  typeInformation :: TypeInformation Value
typeInformation = 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 :: Decoder Value
decode =
        Decoder
          { binary :: Value Value
binary = Value Value
Hasql.jsonb
          , parser :: Parser Value
parser = Parser Value -> Parser Value
forall a. Parser a -> ByteString -> Either String a
parse Parser Value
Aeson.value
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"jsonb"
    }


-- | Corresponds to @inet@
instance DBType (IP.NetAddr IP.IP) where
  typeInformation :: TypeInformation (NetAddr IP)
typeInformation = TypeInformation
    { encode :: NetAddr IP -> PrimExpr
encode =
        Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr)
-> (NetAddr IP -> Literal) -> NetAddr IP -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
Opaleye.StringLit (String -> Literal)
-> (NetAddr IP -> String) -> NetAddr IP -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetAddr IP -> String
forall n p.
(IsNetAddr n, Printable (NetHost n), Printer p) =>
n -> p
IP.printNetAddr
    , decode :: Decoder (NetAddr IP)
decode =
        Decoder
          { binary :: Value (NetAddr IP)
binary = Value (NetAddr IP)
Hasql.inet
          , parser :: Parser (NetAddr IP)
parser = Parser (NetAddr IP) -> Parser (NetAddr IP)
forall a. Parser a -> ByteString -> Either String a
parse (Parser (NetAddr IP) -> Parser (NetAddr IP))
-> Parser (NetAddr IP) -> Parser (NetAddr IP)
forall a b. (a -> b) -> a -> b
$
              Parser (NetAddr IP)
forall α (μ :: * -> *). (Textual α, Monad μ, CharParsing μ) => μ α
forall (μ :: * -> *). (Monad μ, CharParsing μ) => μ (NetAddr IP)
textual
                Parser (NetAddr IP) -> Parser (NetAddr IP) -> Parser (NetAddr IP)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (NetHost (NetAddr IP) -> Word8 -> NetAddr IP
forall n. IsNetAddr n => NetHost n -> Word8 -> n
`IP.netAddr` Word8
32) (IP -> NetAddr IP) -> (IP4 -> IP) -> IP4 -> NetAddr IP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IP4 -> IP
forall t₄ t₆. t₄ -> IP46 t₄ t₆
IP.IPv4 (IP4 -> NetAddr IP) -> Parser ByteString IP4 -> Parser (NetAddr IP)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString IP4
forall α (μ :: * -> *). (Textual α, Monad μ, CharParsing μ) => μ α
forall (μ :: * -> *). (Monad μ, CharParsing μ) => μ IP4
textual
                Parser (NetAddr IP) -> Parser (NetAddr IP) -> Parser (NetAddr IP)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (NetHost (NetAddr IP) -> Word8 -> NetAddr IP
forall n. IsNetAddr n => NetHost n -> Word8 -> n
`IP.netAddr` Word8
128) (IP -> NetAddr IP) -> (IP6 -> IP) -> IP6 -> NetAddr IP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IP6 -> IP
forall t₄ t₆. t₆ -> IP46 t₄ t₆
IP.IPv6 (IP6 -> NetAddr IP) -> Parser ByteString IP6 -> Parser (NetAddr IP)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString IP6
forall α (μ :: * -> *). (Textual α, Monad μ, CharParsing μ) => μ α
forall (μ :: * -> *). (Monad μ, CharParsing μ) => μ IP6
textual
          , delimiter :: Char
delimiter = Char
','
          }
    , typeName :: TypeName
typeName = TypeName
"inet"
    }


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


floating :: Floating a => A.Parser a -> A.Parser a
floating :: forall a. Floating a => Parser a -> Parser a
floating Parser a
p = Parser a
p Parser a -> Parser a -> Parser a
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser a -> Parser a
forall a. Num a => Parser a -> Parser a
A.signed (a
1.0 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0 a -> Parser ByteString -> Parser a
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString
"Infinity") Parser a -> Parser a -> Parser a
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a
0.0 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0 a -> Parser ByteString -> Parser a
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString
"NaN"