{-# 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
import Data.Aeson ( Value )
import qualified Data.Aeson as Aeson
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.Aeson.Parser as Aeson
import Control.Applicative ((<|>))
import Data.Fixed (Fixed)
import Data.Int ( Int8, Int16, Int32, Int64 )
import Data.Word (Word8, Word32)
import Data.List.NonEmpty ( NonEmpty )
import Data.Kind ( Constraint, Type )
import Prelude
import Data.Bits (Bits (..))
import Data.DoubleWord (fromHiAndLo)
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 Data.CaseInsensitive ( CI )
import qualified Data.CaseInsensitive as CI
import Data.Textual (textual)
import qualified Hasql.Decoders as Hasql
import qualified Network.IP.Addr as IP
import qualified Data.IP
import qualified BinaryParser
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.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
import Data.Scientific ( Scientific )
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 )
import Data.Time.Calendar (Day)
import Data.Time.Clock (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 :: 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"
}
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
','
}
}
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"
}
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"
}
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"
}
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"
}
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"
}
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"
}
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
}
}
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"
}
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"
}
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"
}
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"
}
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"
}
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"
}
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 :: 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"
}
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 :: 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"
}
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"
}
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 = ((Bool -> ByteString -> Either Text (NetAddr IP))
-> Value (NetAddr IP)
forall a. (Bool -> ByteString -> Either Text a) -> Value a
Hasql.custom ((Bool -> ByteString -> Either Text (NetAddr IP))
-> Value (NetAddr IP))
-> (BinaryParser (NetAddr IP)
-> Bool -> ByteString -> Either Text (NetAddr IP))
-> BinaryParser (NetAddr IP)
-> Value (NetAddr IP)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Either Text (NetAddr IP))
-> Bool -> ByteString -> Either Text (NetAddr IP)
forall a b. a -> b -> a
const ((ByteString -> Either Text (NetAddr IP))
-> Bool -> ByteString -> Either Text (NetAddr IP))
-> (BinaryParser (NetAddr IP)
-> ByteString -> Either Text (NetAddr IP))
-> BinaryParser (NetAddr IP)
-> Bool
-> ByteString
-> Either Text (NetAddr IP)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryParser (NetAddr IP) -> ByteString -> Either Text (NetAddr IP)
forall a. BinaryParser a -> ByteString -> Either Text a
BinaryParser.run (BinaryParser (NetAddr IP) -> Value (NetAddr IP))
-> BinaryParser (NetAddr IP) -> Value (NetAddr IP)
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word32 -> NetAddr IP)
-> (Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> NetAddr IP)
-> BinaryParser (NetAddr IP)
forall ip.
(Word8 -> Word32 -> ip)
-> (Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> ip)
-> BinaryParser ip
netaddrParser
(\Word8
netmask Word32
x -> NetHost (NetAddr IP) -> Word8 -> NetAddr IP
forall n. IsNetAddr n => NetHost n -> Word8 -> n
IP.netAddr (IP4 -> IP
forall t₄ t₆. t₄ -> IP46 t₄ t₆
IP.IPv4 (IP4 -> IP) -> IP4 -> IP
forall a b. (a -> b) -> a -> b
$ Word32 -> IP4
IP.IP4 Word32
x) Word8
netmask)
(\Word8
netmask Word32
x1 Word32
x2 Word32
x3 Word32
x4 -> NetHost (NetAddr IP) -> Word8 -> NetAddr IP
forall n. IsNetAddr n => NetHost n -> Word8 -> n
IP.netAddr (IP6 -> IP
forall t₄ t₆. t₆ -> IP46 t₄ t₆
IP.IPv6 (IP6 -> IP) -> IP6 -> IP
forall a b. (a -> b) -> a -> b
$ Word128 -> IP6
IP.IP6 (Word128 -> IP6) -> Word128 -> IP6
forall a b. (a -> b) -> a -> b
$ HiWord Word128 -> LoWord Word128 -> Word128
forall w. DoubleWord w => HiWord w -> LoWord w -> w
fromHiAndLo (HiWord Word64 -> LoWord Word64 -> Word64
forall w. DoubleWord w => HiWord w -> LoWord w -> w
fromHiAndLo Word32
HiWord Word64
x1 Word32
LoWord Word64
x2) (HiWord Word64 -> LoWord Word64 -> Word64
forall w. DoubleWord w => HiWord w -> LoWord w -> w
fromHiAndLo Word32
HiWord Word64
x3 Word32
LoWord Word64
x4)) Word8
netmask) :: Hasql.Value (IP.NetAddr IP.IP))
, 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 DBType Data.IP.IPRange where
typeInformation :: TypeInformation IPRange
typeInformation = TypeInformation
{ encode :: IPRange -> PrimExpr
encode =
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 = ((Bool -> ByteString -> Either Text IPRange) -> Value IPRange
forall a. (Bool -> ByteString -> Either Text a) -> Value a
Hasql.custom ((Bool -> ByteString -> Either Text IPRange) -> Value IPRange)
-> (BinaryParser IPRange
-> Bool -> ByteString -> Either Text IPRange)
-> BinaryParser IPRange
-> Value IPRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Either Text IPRange)
-> Bool -> ByteString -> Either Text IPRange
forall a b. a -> b -> a
const ((ByteString -> Either Text IPRange)
-> Bool -> ByteString -> Either Text IPRange)
-> (BinaryParser IPRange -> ByteString -> Either Text IPRange)
-> BinaryParser IPRange
-> Bool
-> ByteString
-> Either Text IPRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryParser IPRange -> ByteString -> Either Text IPRange
forall a. BinaryParser a -> ByteString -> Either Text a
BinaryParser.run (BinaryParser IPRange -> Value IPRange)
-> BinaryParser IPRange -> Value IPRange
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word32 -> IPRange)
-> (Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> IPRange)
-> BinaryParser IPRange
forall ip.
(Word8 -> Word32 -> ip)
-> (Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> ip)
-> BinaryParser ip
netaddrParser
(\Word8
netmask Word32
x -> AddrRange IPv4 -> IPRange
Data.IP.IPv4Range (AddrRange IPv4 -> IPRange) -> AddrRange IPv4 -> IPRange
forall a b. (a -> b) -> a -> b
$ IPv4 -> Int -> AddrRange IPv4
forall a. Addr a => a -> Int -> AddrRange a
Data.IP.makeAddrRange (Word32 -> IPv4
Data.IP.toIPv4w Word32
x) (Int -> AddrRange IPv4) -> Int -> AddrRange IPv4
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
netmask)
(\Word8
netmask Word32
x1 Word32
x2 Word32
x3 Word32
x4 -> AddrRange IPv6 -> IPRange
Data.IP.IPv6Range (AddrRange IPv6 -> IPRange) -> AddrRange IPv6 -> IPRange
forall a b. (a -> b) -> a -> b
$ IPv6 -> Int -> AddrRange IPv6
forall a. Addr a => a -> Int -> AddrRange a
Data.IP.makeAddrRange ((Word32, Word32, Word32, Word32) -> IPv6
Data.IP.toIPv6w (Word32
x1, Word32
x2, Word32
x3, Word32
x4)) (Int -> AddrRange IPv6) -> Int -> AddrRange IPv6
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
netmask))
, parser :: Parser IPRange
parser = \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"
}
inetAddressFamily :: Word8
inetAddressFamily :: Word8
inetAddressFamily =
Word8
2
inet6AddressFamily :: Word8
inet6AddressFamily :: Word8
inet6AddressFamily =
Word8
3
netaddrParser :: (Word8 -> Word32 -> ip) -> (Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> ip) -> BinaryParser.BinaryParser ip
netaddrParser :: forall ip.
(Word8 -> Word32 -> ip)
-> (Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> ip)
-> BinaryParser ip
netaddrParser Word8 -> Word32 -> ip
mkIpv4 Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> ip
mkIpv6 = do
Word8
af <- Int -> BinaryParser Word8
forall a. (Integral a, Bits a) => Int -> BinaryParser a
intOfSize Int
1
Word8
netmask <- Int -> BinaryParser Word8
forall a. (Integral a, Bits a) => Int -> BinaryParser a
intOfSize Int
1
Int8
isCidr <- forall a. (Integral a, Bits a) => Int -> BinaryParser a
intOfSize @Int8 Int
1
Int8
ipSize <- forall a. (Integral a, Bits a) => Int -> BinaryParser a
intOfSize @Int8 Int
1
if | Word8
af Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
inetAddressFamily ->
Word8 -> Word32 -> ip
mkIpv4 Word8
netmask (Word32 -> ip) -> BinaryParser Word32 -> BinaryParser ip
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BinaryParser Word32
forall a. (Integral a, Bits a) => Int -> BinaryParser a
intOfSize Int
4
| Word8
af Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
inet6AddressFamily ->
Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> ip
mkIpv6 Word8
netmask (Word32 -> Word32 -> Word32 -> Word32 -> ip)
-> BinaryParser Word32
-> BinaryParser (Word32 -> Word32 -> Word32 -> ip)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BinaryParser Word32
forall a. (Integral a, Bits a) => Int -> BinaryParser a
intOfSize Int
4 BinaryParser (Word32 -> Word32 -> Word32 -> ip)
-> BinaryParser Word32 -> BinaryParser (Word32 -> Word32 -> ip)
forall a b.
BinaryParser (a -> b) -> BinaryParser a -> BinaryParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> BinaryParser Word32
forall a. (Integral a, Bits a) => Int -> BinaryParser a
intOfSize Int
4 BinaryParser (Word32 -> Word32 -> ip)
-> BinaryParser Word32 -> BinaryParser (Word32 -> ip)
forall a b.
BinaryParser (a -> b) -> BinaryParser a -> BinaryParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> BinaryParser Word32
forall a. (Integral a, Bits a) => Int -> BinaryParser a
intOfSize Int
4 BinaryParser (Word32 -> ip)
-> BinaryParser Word32 -> BinaryParser ip
forall a b.
BinaryParser (a -> b) -> BinaryParser a -> BinaryParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> BinaryParser Word32
forall a. (Integral a, Bits a) => Int -> BinaryParser a
intOfSize Int
4
| Bool
otherwise -> Text -> BinaryParser ip
forall a. Text -> BinaryParser a
BinaryParser.failure (Text
"Unknown address family: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Word8 -> String
forall a. Show a => a -> String
show Word8
af))
intOfSize :: (Integral a, Bits a) => Int -> BinaryParser.BinaryParser a
intOfSize :: forall a. (Integral a, Bits a) => Int -> BinaryParser a
intOfSize Int
x =
(ByteString -> a) -> BinaryParser ByteString -> BinaryParser a
forall a b. (a -> b) -> BinaryParser a -> BinaryParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> a
integralPack (Int -> BinaryParser ByteString
BinaryParser.bytesOfSize Int
x)
where
integralPack :: ByteString -> a
integralPack = (a -> Word8 -> a) -> a -> ByteString -> a
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (\a
n Word8
h -> a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
n Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.|. Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
h) a
0
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"