{-# language DisambiguateRecordFields #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language LambdaCase #-}
{-# language MonoLocalBinds #-}
{-# language MultiWayIf #-}
{-# language OverloadedStrings #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language UndecidableInstances #-}
module Rel8.Type
( DBType (typeInformation)
)
where
import Data.Aeson ( Value )
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Text as Aeson
import qualified Data.Attoparsec.ByteString.Char8 as A
import Control.Applicative ((<|>))
import Data.Fixed (Fixed)
import Data.Functor.Contravariant ((>$<))
import Data.Int (Int16, Int32, Int64)
import Data.List.NonEmpty ( NonEmpty )
import Data.Kind ( Constraint, Type )
import Prelude
import Text.Read (readMaybe)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as Lazy ( ByteString )
import qualified Data.ByteString.Lazy as ByteString ( fromStrict, toStrict )
import qualified Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim (primBounded)
import Data.CaseInsensitive ( CI )
import qualified Data.CaseInsensitive as CI
import qualified Hasql.Decoders as Decoders
import qualified Hasql.Encoders as Encoders
import Data.IP (IPRange)
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
import qualified Opaleye.Internal.HaskellDB.Sql.Default as Opaleye ( quote )
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.Encoder (Encoder (..))
import Rel8.Type.Information ( TypeInformation(..), mapTypeInformation )
import Rel8.Type.Name (TypeName (..))
import Rel8.Type.Parser (parse)
import qualified Rel8.Type.Builder.ByteString as Builder
import qualified Rel8.Type.Parser.ByteString as Parser
import qualified Rel8.Type.Builder.Time as Builder
import qualified Rel8.Type.Parser.Time as Parser
import Data.ByteString.Builder.Scientific (scientificBuilder)
import Data.Scientific (Scientific)
import Data.Text ( Text )
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text (decodeUtf8, encodeUtf8Builder)
import qualified Data.Text.Lazy as Lazy (Text, unpack)
import qualified Data.Text.Lazy as Text (fromStrict, toStrict)
import Data.Time.Calendar (Day)
import Data.Time.Clock (DiffTime, UTCTime)
import Data.Time.LocalTime
( CalendarDiffTime (CalendarDiffTime)
, LocalTime
, TimeOfDay
)
import Data.Time.Format (formatTime, defaultTimeLocale)
import qualified Data.ByteString.UTF8 as UTF8
import Data.UUID ( UUID )
import qualified Data.UUID as UUID
type DBType :: Type -> Constraint
class NotNull a => DBType a where
typeInformation :: TypeInformation a
instance DBType Bool where
typeInformation :: TypeInformation Bool
typeInformation = TypeInformation
{ encode :: Encoder Bool
encode =
Encoder
{ binary :: Value Bool
binary = Value Bool
Encoders.bool
, text :: Bool -> Builder
text = \case
Bool
False -> Builder
"f"
Bool
True -> Builder
"t"
, quote :: Bool -> PrimExpr
quote = 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
Decoders.bool
, text :: Parser Bool
text = \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"
}
instance DBType Char where
typeInformation :: TypeInformation Char
typeInformation = TypeInformation
{ encode :: Encoder Char
encode =
Encoder
{ binary :: Value Char
binary = Value Char
Encoders.char
, text :: Char -> Builder
text = Char -> Builder
B.charUtf8
, quote :: Char -> PrimExpr
quote = 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
}
, decode :: Decoder Char
decode =
Decoder
{ binary :: Value Char
binary = Value Char
Decoders.char
, text :: Parser Char
text = \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
','
, typeName :: TypeName
typeName =
TypeName
{ name :: QualifiedName
name = QualifiedName
"bpchar"
, modifiers :: [String]
modifiers = [String
"1"]
, arrayDepth :: Word
arrayDepth = Word
0
}
}
instance DBType Int16 where
typeInformation :: TypeInformation Int16
typeInformation = TypeInformation
{ encode :: Encoder Int16
encode =
Encoder
{ binary :: Value Int16
binary = Value Int16
Encoders.int2
, text :: Int16 -> Builder
text = Int16 -> Builder
B.int16Dec
, quote :: Int16 -> PrimExpr
quote = 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
Decoders.int2
, text :: Parser Int16
text = 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"
}
instance DBType Int32 where
typeInformation :: TypeInformation Int32
typeInformation = TypeInformation
{ encode :: Encoder Int32
encode =
Encoder
{ binary :: Value Int32
binary = Value Int32
Encoders.int4
, text :: Int32 -> Builder
text = Int32 -> Builder
B.int32Dec
, quote :: Int32 -> PrimExpr
quote = 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
Decoders.int4
, text :: Parser Int32
text = 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"
}
instance DBType Int64 where
typeInformation :: TypeInformation Int64
typeInformation = TypeInformation
{ encode :: Encoder Int64
encode =
Encoder
{ binary :: Value Int64
binary = Value Int64
Encoders.int8
, text :: Int64 -> Builder
text = Int64 -> Builder
B.int64Dec
, quote :: Int64 -> PrimExpr
quote = 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
Decoders.int8
, text :: Parser Int64
text = 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"
}
instance DBType Float where
typeInformation :: TypeInformation Float
typeInformation = TypeInformation
{ encode :: Encoder Float
encode =
Encoder
{ binary :: Value Float
binary = Value Float
Encoders.float4
, text :: Float -> Builder
text =
\Float
x ->
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) -> Builder
"Infinity"
| Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
x -> Builder
"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) -> Builder
"-Infinity"
| Bool
otherwise -> Float -> Builder
B.floatDec Float
x
, quote :: Float -> PrimExpr
quote =
\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
Decoders.float4
, text :: Parser Float
text = 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"
}
instance DBType Double where
typeInformation :: TypeInformation Double
typeInformation = TypeInformation
{ encode :: Encoder Double
encode =
Encoder
{ binary :: Value Double
binary = Value Double
Encoders.float8
, text :: Double -> Builder
text =
\Double
x ->
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) -> Builder
"Infinity"
| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x -> Builder
"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) -> Builder
"-Infinity"
| Bool
otherwise -> Double -> Builder
B.doubleDec Double
x
, quote :: Double -> PrimExpr
quote =
\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
Decoders.float8
, text :: Parser Double
text = 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"
}
instance DBType Scientific where
typeInformation :: TypeInformation Scientific
typeInformation = TypeInformation
{ encode :: Encoder Scientific
encode =
Encoder
{ binary :: Value Scientific
binary = Value Scientific
Encoders.numeric
, text :: Scientific -> Builder
text = Scientific -> Builder
scientificBuilder
, quote :: Scientific -> PrimExpr
quote = 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
Decoders.numeric
, text :: Parser Scientific
text = 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"
}
instance PowerOf10 n => DBType (Fixed n) where
typeInformation :: TypeInformation (Fixed n)
typeInformation =
(Scientific -> Fixed n)
-> (Fixed n -> Scientific)
-> TypeInformation Scientific
-> TypeInformation (Fixed n)
forall a b.
(a -> b) -> (b -> a) -> TypeInformation a -> TypeInformation b
mapTypeInformation Scientific -> Fixed n
forall a b. (Real a, Fractional b) => a -> b
realToFrac Fixed n -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac (forall a. DBType a => TypeInformation a
typeInformation @Scientific)
{ typeName =
TypeName
{ name = "numeric"
, modifiers = ["1000", show (resolution @n)]
, arrayDepth = 0
}
}
instance DBType UTCTime where
typeInformation :: TypeInformation UTCTime
typeInformation = TypeInformation
{ encode :: Encoder UTCTime
encode =
Encoder
{ binary :: Value UTCTime
binary = Value UTCTime
Encoders.timestamptz
, text :: UTCTime -> Builder
text = BoundedPrim UTCTime -> UTCTime -> Builder
forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim UTCTime
Builder.utcTime
, quote :: UTCTime -> PrimExpr
quote =
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
Decoders.timestamptz
, text :: Parser UTCTime
text = Parser UTCTime -> Parser UTCTime
forall a. Parser a -> ByteString -> Either String a
parse Parser UTCTime
Parser.utcTime
}
, delimiter :: Char
delimiter = Char
','
, typeName :: TypeName
typeName = TypeName
"timestamptz"
}
instance DBType Day where
typeInformation :: TypeInformation Day
typeInformation = TypeInformation
{ encode :: Encoder Day
encode =
Encoder
{ binary :: Value Day
binary = Value Day
Encoders.date
, text :: Day -> Builder
text = BoundedPrim Day -> Day -> Builder
forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim Day
Builder.day
, quote :: Day -> PrimExpr
quote =
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
Decoders.date
, text :: Parser Day
text = Parser Day -> Parser Day
forall a. Parser a -> ByteString -> Either String a
parse Parser Day
Parser.day
}
, delimiter :: Char
delimiter = Char
','
, typeName :: TypeName
typeName = TypeName
"date"
}
instance DBType LocalTime where
typeInformation :: TypeInformation LocalTime
typeInformation = TypeInformation
{ encode :: Encoder LocalTime
encode =
Encoder
{ binary :: Value LocalTime
binary = Value LocalTime
Encoders.timestamp
, text :: LocalTime -> Builder
text = BoundedPrim LocalTime -> LocalTime -> Builder
forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim LocalTime
Builder.localTime
, quote :: LocalTime -> PrimExpr
quote =
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
Decoders.timestamp
, text :: Parser LocalTime
text = Parser LocalTime -> Parser LocalTime
forall a. Parser a -> ByteString -> Either String a
parse Parser LocalTime
Parser.localTime
}
, delimiter :: Char
delimiter = Char
','
, typeName :: TypeName
typeName = TypeName
"timestamp"
}
instance DBType TimeOfDay where
typeInformation :: TypeInformation TimeOfDay
typeInformation = TypeInformation
{ encode :: Encoder TimeOfDay
encode =
Encoder
{ binary :: Value TimeOfDay
binary = Value TimeOfDay
Encoders.time
, text :: TimeOfDay -> Builder
text = BoundedPrim TimeOfDay -> TimeOfDay -> Builder
forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim TimeOfDay
Builder.timeOfDay
, quote :: TimeOfDay -> PrimExpr
quote =
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
Decoders.time
, text :: Parser TimeOfDay
text = Parser TimeOfDay -> Parser TimeOfDay
forall a. Parser a -> ByteString -> Either String a
parse Parser TimeOfDay
Parser.timeOfDay
}
, delimiter :: Char
delimiter = Char
','
, typeName :: TypeName
typeName = TypeName
"time"
}
instance DBType CalendarDiffTime where
typeInformation :: TypeInformation CalendarDiffTime
typeInformation = TypeInformation
{ encode :: Encoder CalendarDiffTime
encode =
Encoder
{ binary :: Value CalendarDiffTime
binary = CalendarDiffTime -> DiffTime
toDiffTime (CalendarDiffTime -> DiffTime)
-> Value DiffTime -> Value CalendarDiffTime
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Value DiffTime
Encoders.interval
, text :: CalendarDiffTime -> Builder
text = CalendarDiffTime -> Builder
Builder.calendarDiffTime
, quote :: CalendarDiffTime -> PrimExpr
quote =
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
Decoders.interval
, text :: Parser CalendarDiffTime
text = Parser CalendarDiffTime -> Parser CalendarDiffTime
forall a. Parser a -> ByteString -> Either String a
parse Parser CalendarDiffTime
Parser.calendarDiffTime
}
, delimiter :: Char
delimiter = Char
','
, typeName :: TypeName
typeName = TypeName
"interval"
}
instance DBType Text where
typeInformation :: TypeInformation Text
typeInformation = TypeInformation
{ encode :: Encoder Text
encode =
Encoder
{ binary :: Value Text
binary = Value Text
Encoders.text
, text :: Text -> Builder
text = Text -> Builder
Text.encodeUtf8Builder
, quote :: Text -> PrimExpr
quote = 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
Decoders.text
, text :: Parser Text
text = 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"
}
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
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"
}
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"
}
instance DBType ByteString where
typeInformation :: TypeInformation ByteString
typeInformation = TypeInformation
{ encode :: Encoder ByteString
encode =
Encoder
{ binary :: Value ByteString
binary = Value ByteString
Encoders.bytea
, text :: ByteString -> Builder
text = ByteString -> Builder
Builder.bytestring
, quote :: ByteString -> PrimExpr
quote = 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
Decoders.bytea
, text :: Parser ByteString
text = Parser ByteString -> Parser ByteString
forall a. Parser a -> ByteString -> Either String a
parse Parser ByteString
Parser.bytestring
}
, delimiter :: Char
delimiter = Char
','
, typeName :: TypeName
typeName = TypeName
"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
instance DBType UUID where
typeInformation :: TypeInformation UUID
typeInformation = TypeInformation
{ encode :: Encoder UUID
encode =
Encoder
{ binary :: Value UUID
binary = Value UUID
Encoders.uuid
, text :: UUID -> Builder
text = ByteString -> Builder
B.byteString (ByteString -> Builder) -> (UUID -> ByteString) -> UUID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> ByteString
UUID.toASCIIBytes
, quote :: UUID -> PrimExpr
quote = 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
Decoders.uuid
, text :: Parser UUID
text = \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"
}
instance DBType Value where
typeInformation :: TypeInformation Value
typeInformation = TypeInformation
{ encode :: Encoder Value
encode =
Encoder
{ binary :: Value Value
binary = Value Value
Encoders.jsonb
, text :: Value -> Builder
text = Encoding' Value -> Builder
forall tag. Encoding' tag -> Builder
Aeson.fromEncoding (Encoding' Value -> Builder)
-> (Value -> Encoding' Value) -> Value -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Encoding' Value
forall a. ToJSON a => a -> Encoding' Value
Aeson.toEncoding
, quote :: Value -> PrimExpr
quote =
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
. Value -> Text
forall a. ToJSON a => a -> Text
Aeson.encodeToLazyText
}
, decode :: Decoder Value
decode =
Decoder
{ binary :: Value Value
binary = Value Value
Decoders.jsonb
, text :: Parser Value
text = Parser Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict
}
, delimiter :: Char
delimiter = Char
','
, typeName :: TypeName
typeName = TypeName
"jsonb"
}
instance DBType IPRange where
typeInformation :: TypeInformation IPRange
typeInformation = TypeInformation
{ encode :: Encoder IPRange
encode =
Encoder
{ binary :: Value IPRange
binary = Value IPRange
Encoders.inet
, text :: IPRange -> Builder
text = String -> Builder
B.string7 (String -> Builder) -> (IPRange -> String) -> IPRange -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPRange -> String
forall a. Show a => a -> String
show
, quote :: IPRange -> PrimExpr
quote = Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr)
-> (IPRange -> Literal) -> IPRange -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
Opaleye.StringLit (String -> Literal) -> (IPRange -> String) -> IPRange -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPRange -> String
forall a. Show a => a -> String
show
}
, decode :: Decoder IPRange
decode =
Decoder
{ binary :: Value IPRange
binary = Value IPRange
Decoders.inet
, text :: Parser IPRange
text = \ByteString
str -> case String -> Maybe IPRange
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe IPRange) -> String -> Maybe IPRange
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS8.unpack ByteString
str of
Just IPRange
x -> IPRange -> Either String IPRange
forall a b. b -> Either a b
Right IPRange
x
Maybe IPRange
Nothing -> String -> Either String IPRange
forall a b. a -> Either a b
Left String
"Failed to parse inet"
}
, 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"
toDiffTime :: CalendarDiffTime -> DiffTime
toDiffTime :: CalendarDiffTime -> DiffTime
toDiffTime (CalendarDiffTime Integer
months NominalDiffTime
seconds) =
Integer -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Integer
months Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
30 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
24 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60) DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
seconds