module Hasql.Simple where
import Data.Aeson
import Data.Aeson.Types
import Data.Bifunctor
import Data.Functor.Contravariant
import Data.Int
import Data.Time
import qualified Data.ByteString as BS
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Hasql.Decoders as D
import qualified Hasql.Encoders as E
req :: DbEncode v => (a -> v) -> E.Params a
req get = get ->. dbEnc
opt :: DbEncode v => (a -> Maybe v) -> E.Params a
opt get = get ->? dbEnc
(->.) :: (a -> v) -> E.Value v -> E.Params a
get ->. ser =
contramap get (E.value ser)
(->?) :: (a -> Maybe v) -> E.Value v -> E.Params a
get ->? ser =
contramap get (E.nullableValue ser)
class RowUnpacker r where
unpackRows :: forall e. D.Row e -> D.Result (r e)
instance RowUnpacker V.Vector where
unpackRows = D.rowsVector
instance RowUnpacker Maybe where
unpackRows = D.maybeRow
type family DbRepr t
class DbEncode t where
packVal :: t -> DbRepr t
dbEnc :: E.Value t
default packVal :: t ~ DbRepr t => t -> DbRepr t
packVal = id
default dbEnc :: DbEncode (DbRepr t) => E.Value t
dbEnc = contramap packVal dbEnc
dbDecVal :: DbDecode t => D.Row t
dbDecVal = D.value dbDec
dbDecOptVal :: DbDecode t => D.Row (Maybe t)
dbDecOptVal = D.nullableValue dbDec
class DbDecode t where
unpackVal :: DbRepr t -> t
dbDec :: D.Value t
default unpackVal :: t ~ DbRepr t => DbRepr t -> t
unpackVal = id
default dbDec :: DbDecode (DbRepr t) => D.Value t
dbDec = unpackVal <$> dbDec
type instance DbRepr Bool = Bool
instance DbEncode Bool where
dbEnc = E.bool
instance DbDecode Bool where
dbDec = D.bool
type instance DbRepr T.Text = T.Text
instance DbEncode T.Text where
dbEnc = E.text
instance DbDecode T.Text where
dbDec = D.text
type instance DbRepr Int64 = Int64
instance DbEncode Int64 where
dbEnc = E.int8
instance DbDecode Int64 where
dbDec = D.int8
type instance DbRepr Double = Double
instance DbEncode Double where
dbEnc = E.float8
instance DbDecode Double where
dbDec = D.float8
type instance DbRepr BS.ByteString = BS.ByteString
instance DbEncode BS.ByteString where
dbEnc = E.bytea
instance DbDecode BS.ByteString where
dbDec = D.bytea
type instance DbRepr UTCTime = UTCTime
instance DbEncode UTCTime where
dbEnc = E.timestamptz
instance DbDecode UTCTime where
dbDec = D.timestamptz
type instance DbRepr Day = Day
instance DbEncode Day where
dbEnc = E.date
instance DbDecode Day where
dbDec = D.date
type instance DbRepr (V.Vector a) = V.Vector a
instance DbEncode a => DbEncode (V.Vector a) where
dbEnc = E.array (E.arrayDimension V.foldl' (E.arrayValue dbEnc))
instance DbDecode a => DbDecode (V.Vector a) where
dbDec = D.array (D.arrayDimension V.replicateM (D.arrayValue dbDec))
type instance DbRepr (HM.HashMap T.Text a) = HM.HashMap T.Text a
instance ToJSON a => DbEncode (HM.HashMap T.Text a) where
dbEnc = jsonbE
instance FromJSON a => DbDecode (HM.HashMap T.Text a) where
dbDec = jsonbD
jsonbE :: ToJSON a => E.Value a
jsonbE = contramap toJSON E.jsonb
jsonbD :: FromJSON a => D.Value a
jsonbD = D.jsonbBytes (first T.pack . eitherDecodeStrict')
jsonbD' :: (Value -> Parser a) -> D.Value a
jsonbD' parser =
D.jsonbBytes $ \raw ->
do v <-
first (\pError -> T.pack (pError ++ ": Value was: " ++ show raw)) $
eitherDecodeStrict' raw
first (\pError -> T.pack (pError ++ ": Value was: " ++ show v)) $ parseEither parser v
jsonVec :: (Value -> Parser a) -> D.Value (V.Vector a)
jsonVec parser =
D.array (D.arrayDimension V.replicateM $ D.arrayValue $ jsonD' parser)
jsonD' :: (Value -> Parser a) -> D.Value a
jsonD' parser =
D.jsonBytes $ \raw ->
do v <-
first (\pError -> T.pack (pError ++ ": Value was: " ++ show raw)) $
eitherDecodeStrict' raw
first (\pError -> T.pack (pError ++ ": Value was: " ++ show v)) $ parseEither parser v