module Hasql.Generic.HasRow
( HasRow
, HasDField
, HasDValue
, mkRow
, mkDField
, mkDValue
, gRow
, gDEnumValue
) where
import BinaryParser
import Control.Monad (replicateM)
import qualified Data.Aeson.Types as JSON
import Data.ByteString (ByteString)
import Data.Functor.Contravariant
import Data.Int (Int16, Int32, Int64)
import qualified Data.Map as Map
import Data.Scientific (Scientific)
import Data.Text
import Data.Time (Day, DiffTime, LocalTime,
TimeOfDay, TimeZone, UTCTime)
import Data.UUID (UUID)
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Data.Word (Word16, Word32, Word64)
import Generics.SOP
import qualified GHC.Generics as GHC
import Hasql.Decoders
#if MIN_VERSION_postgresql_binary(0,12,1)
import qualified PostgreSQL.Binary.Decoding as Decoder
#else
import qualified PostgreSQL.Binary.Decoder as Decoder
#endif
class HasRow a where
mkRow :: Row a
default mkRow :: (Generic a, Code a ~ '[ xs ], All HasDField xs) => Row a
mkRow = gRow
class HasDField a where
mkDField :: Row a
class HasDValue a where
mkDValue :: Value a
gRow :: (Generic a, Code a ~ '[ xs ], All HasDField xs) => Row a
gRow =
to . SOP . Z <$> hsequence (hcpure (Proxy :: Proxy HasDField) mkDField)
class (a ~ b) => Equal a b
instance (a ~ b) => Equal a b
gDEnumValue :: (Generic a, All (Equal '[]) (Code a)) => NP (K Text) (Code a) -> Value a
gDEnumValue names = enum $ \n -> Map.lookup n table
where
table =
Map.fromList
(hcollapse
(hczipWith (Proxy :: Proxy (Equal '[]))
(\ (K n) (Fn c) -> K (n, to (SOP (unK (c Nil)))))
names injections
)
)
instance HasDValue Bool where
mkDValue = bool
instance HasDValue Int16 where
mkDValue = int2
instance HasDValue Int32 where
mkDValue = int4
instance HasDValue Int64 where
mkDValue = int8
instance HasDValue Word16 where
mkDValue = word2
instance HasDValue Word32 where
mkDValue = word4
instance HasDValue Word64 where
mkDValue = word8
instance HasDValue Float where
mkDValue = float4
instance HasDValue Double where
mkDValue = float8
instance HasDValue Scientific where
mkDValue = numeric
instance HasDValue Char where
mkDValue = char
instance HasDValue Text where
mkDValue = text
instance HasDValue ByteString where
mkDValue = bytea
instance HasDValue Day where
mkDValue = date
instance HasDValue LocalTime where
mkDValue = timestamp
instance HasDValue UTCTime where
mkDValue = timestamptz
instance HasDValue TimeOfDay where
mkDValue = time
instance HasDValue (TimeOfDay, TimeZone) where
mkDValue = timetz
instance HasDValue DiffTime where
mkDValue = interval
instance HasDValue UUID where
mkDValue = uuid
instance HasDValue JSON.Value where
mkDValue = jsonb
instance HasDValue a => HasDField [Maybe a] where
mkDField = value $ array (arrayDimension replicateM (arrayNullableValue mkDValue))
instance HasDValue a => HasDField [a] where
mkDField = value $ array (arrayDimension replicateM (arrayValue mkDValue))
instance HasDValue a => HasDField (Vector (Maybe a)) where
mkDField = value $ array (arrayDimension Vector.replicateM (arrayNullableValue mkDValue))
instance HasDValue a => HasDField (Vector a) where
mkDField = value $ array (arrayDimension Vector.replicateM (arrayValue mkDValue))
instance HasDValue a => HasDField (Maybe a) where
mkDField = nullableValue mkDValue
instance HasDValue a => HasDField a where
mkDField = value mkDValue
instance HasDField Int where
mkDField = fmap fromIntegral (value int8)
instance HasDField (Maybe Int) where
mkDField = fmap (fmap fromIntegral) (nullableValue int8)
word2 :: Value Word16
word2 = custom $ \b -> BinaryParser.run Decoder.int
word4 :: Value Word32
word4 = custom $ \b -> BinaryParser.run Decoder.int
word8 :: Value Word64
word8 = custom $ \b -> BinaryParser.run Decoder.int
#define HASROW(T) instance (Code T ~ '[xs], All HasDField xs) => HasRow T
instance HasRow ()
instance All HasDField [a,b] => HasRow (a,b)
instance All HasDField [a,b,c] => HasRow (a,b,c)
instance All HasDField [a,b,c,d] => HasRow (a,b,c,d)
instance All HasDField [a,b,c,d,e] => HasRow (a,b,c,d,e)
instance All HasDField [a,b,c,d,e,f] => HasRow (a,b,c,d,e,f)
instance All HasDField [a,b,c,d,e,f,g] => HasRow (a,b,c,d,e,f,g)
instance All HasDField [a,b,c,d,e,f,g,h] => HasRow (a,b,c,d,e,f,g,h)
instance All HasDField [a,b,c,d,e,f,g,h,i] => HasRow (a,b,c,d,e,f,g,h,i)
instance All HasDField [a,b,c,d,e,f,g,h,i,j] => HasRow (a,b,c,d,e,f,g,h,i,j)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k] => HasRow (a,b,c,d,e,f,g,h,i,j,k)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l,m] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l,m)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l,m,n] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y)
instance All HasDField [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z] => HasRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z)