module Hasql.TH.Extraction.Exp where import qualified Hasql.Decoders as Decoders import qualified Hasql.Encoders as Encoders import qualified Hasql.TH.Construction.Exp as Exp import qualified Hasql.TH.Extraction.InputTypeList as InputTypeList import qualified Hasql.TH.Extraction.OutputTypeList as OutputTypeList import qualified Hasql.TH.Extraction.PrimitiveType as PrimitiveType import Hasql.TH.Prelude import Language.Haskell.TH import qualified PostgresqlSyntax.Ast as Ast import qualified PostgresqlSyntax.Rendering as Rendering undecodedStatement :: (Exp -> Exp) -> Ast.PreparableStmt -> Either Text Exp undecodedStatement :: (Exp -> Exp) -> PreparableStmt -> Either Text Exp undecodedStatement Exp -> Exp _decoderProj PreparableStmt _ast = let _sql :: Exp _sql = (ByteString -> Exp Exp.byteString (ByteString -> Exp) -> (PreparableStmt -> ByteString) -> PreparableStmt -> Exp forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Builder -> ByteString Rendering.toByteString (Builder -> ByteString) -> (PreparableStmt -> Builder) -> PreparableStmt -> ByteString forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . PreparableStmt -> Builder Rendering.preparableStmt) PreparableStmt _ast in do Exp _encoder <- PreparableStmt -> Either Text Exp paramsEncoder PreparableStmt _ast Exp _rowDecoder <- PreparableStmt -> Either Text Exp rowDecoder PreparableStmt _ast return (Exp -> Exp -> Exp -> Exp Exp.statement Exp _sql Exp _encoder (Exp -> Exp _decoderProj Exp _rowDecoder)) foldStatement :: Ast.PreparableStmt -> Either Text Exp foldStatement :: PreparableStmt -> Either Text Exp foldStatement PreparableStmt _ast = let _sql :: Exp _sql = (ByteString -> Exp Exp.byteString (ByteString -> Exp) -> (PreparableStmt -> ByteString) -> PreparableStmt -> Exp forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Builder -> ByteString Rendering.toByteString (Builder -> ByteString) -> (PreparableStmt -> Builder) -> PreparableStmt -> ByteString forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . PreparableStmt -> Builder Rendering.preparableStmt) PreparableStmt _ast in do Exp _encoder <- PreparableStmt -> Either Text Exp paramsEncoder PreparableStmt _ast Exp _rowDecoder <- PreparableStmt -> Either Text Exp rowDecoder PreparableStmt _ast return (Exp -> Exp -> Exp -> Exp Exp.foldStatement Exp _sql Exp _encoder Exp _rowDecoder) paramsEncoder :: Ast.PreparableStmt -> Either Text Exp paramsEncoder :: PreparableStmt -> Either Text Exp paramsEncoder PreparableStmt a = do [Typename] b <- PreparableStmt -> Either Text [Typename] InputTypeList.preparableStmt PreparableStmt a [Exp] c <- (Typename -> Either Text Exp) -> [Typename] -> Either Text [Exp] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse Typename -> Either Text Exp paramEncoder [Typename] b return ([Exp] -> Exp Exp.contrazip [Exp] c) rowDecoder :: Ast.PreparableStmt -> Either Text Exp rowDecoder :: PreparableStmt -> Either Text Exp rowDecoder PreparableStmt a = do [Typename] b <- PreparableStmt -> Either Text [Typename] OutputTypeList.preparableStmt PreparableStmt a [Exp] c <- (Typename -> Either Text Exp) -> [Typename] -> Either Text [Exp] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse Typename -> Either Text Exp columnDecoder [Typename] b return ([Exp] -> Exp Exp.cozip [Exp] c) paramEncoder :: Ast.Typename -> Either Text Exp paramEncoder :: Typename -> Either Text Exp paramEncoder = (PrimitiveType -> Bool -> Either Text Exp) -> (PrimitiveType -> Bool -> Int -> Bool -> Either Text Exp) -> Typename -> Either Text Exp byTypename (\PrimitiveType a Bool b -> PrimitiveType -> Either Text Exp valueEncoder PrimitiveType a Either Text Exp -> (Either Text Exp -> Either Text Exp) -> Either Text Exp forall a b. a -> (a -> b) -> b & (Exp -> Exp) -> Either Text Exp -> Either Text Exp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Bool -> Exp -> Exp Exp.unidimensionalParamEncoder Bool b)) (\PrimitiveType a Bool b Int c Bool d -> PrimitiveType -> Either Text Exp valueEncoder PrimitiveType a Either Text Exp -> (Either Text Exp -> Either Text Exp) -> Either Text Exp forall a b. a -> (a -> b) -> b & (Exp -> Exp) -> Either Text Exp -> Either Text Exp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Bool -> Int -> Bool -> Exp -> Exp Exp.multidimensionalParamEncoder Bool b Int c Bool d)) columnDecoder :: Ast.Typename -> Either Text Exp columnDecoder :: Typename -> Either Text Exp columnDecoder = (PrimitiveType -> Bool -> Either Text Exp) -> (PrimitiveType -> Bool -> Int -> Bool -> Either Text Exp) -> Typename -> Either Text Exp byTypename (\PrimitiveType a Bool b -> PrimitiveType -> Either Text Exp valueDecoder PrimitiveType a Either Text Exp -> (Either Text Exp -> Either Text Exp) -> Either Text Exp forall a b. a -> (a -> b) -> b & (Exp -> Exp) -> Either Text Exp -> Either Text Exp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Bool -> Exp -> Exp Exp.unidimensionalColumnDecoder Bool b)) (\PrimitiveType a Bool b Int c Bool d -> PrimitiveType -> Either Text Exp valueDecoder PrimitiveType a Either Text Exp -> (Either Text Exp -> Either Text Exp) -> Either Text Exp forall a b. a -> (a -> b) -> b & (Exp -> Exp) -> Either Text Exp -> Either Text Exp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Bool -> Int -> Bool -> Exp -> Exp Exp.multidimensionalColumnDecoder Bool b Int c Bool d)) byTypename :: (PrimitiveType.PrimitiveType -> Bool -> Either Text Exp) -> (PrimitiveType.PrimitiveType -> Bool -> Int -> Bool -> Either Text Exp) -> Ast.Typename -> Either Text Exp byTypename :: (PrimitiveType -> Bool -> Either Text Exp) -> (PrimitiveType -> Bool -> Int -> Bool -> Either Text Exp) -> Typename -> Either Text Exp byTypename PrimitiveType -> Bool -> Either Text Exp unidimensional PrimitiveType -> Bool -> Int -> Bool -> Either Text Exp multidimensional (Ast.Typename Bool a SimpleTypename b Bool c Maybe (TypenameArrayDimensions, Bool) d) = if Bool a then Text -> Either Text Exp forall a b. a -> Either a b Left Text "SETOF is not supported" else do PrimitiveType e <- SimpleTypename -> Either Text PrimitiveType PrimitiveType.simpleTypename SimpleTypename b case Maybe (TypenameArrayDimensions, Bool) d of Maybe (TypenameArrayDimensions, Bool) Nothing -> PrimitiveType -> Bool -> Either Text Exp unidimensional PrimitiveType e Bool c Just (TypenameArrayDimensions f, Bool g) -> case TypenameArrayDimensions f of Ast.BoundsTypenameArrayDimensions ArrayBounds h -> PrimitiveType -> Bool -> Int -> Bool -> Either Text Exp multidimensional PrimitiveType e Bool c (ArrayBounds -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ArrayBounds h) Bool g Ast.ExplicitTypenameArrayDimensions Maybe Iconst _ -> PrimitiveType -> Bool -> Int -> Bool -> Either Text Exp multidimensional PrimitiveType e Bool c Int 1 Bool g valueEncoder :: PrimitiveType.PrimitiveType -> Either Text Exp valueEncoder :: PrimitiveType -> Either Text Exp valueEncoder = Exp -> Either Text Exp forall a b. b -> Either a b Right (Exp -> Either Text Exp) -> (PrimitiveType -> Exp) -> PrimitiveType -> Either Text Exp forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Name -> Exp VarE (Name -> Exp) -> (PrimitiveType -> Name) -> PrimitiveType -> Exp forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . \case PrimitiveType PrimitiveType.BoolPrimitiveType -> 'Encoders.bool PrimitiveType PrimitiveType.Int2PrimitiveType -> 'Encoders.int2 PrimitiveType PrimitiveType.Int4PrimitiveType -> 'Encoders.int4 PrimitiveType PrimitiveType.Int8PrimitiveType -> 'Encoders.int8 PrimitiveType PrimitiveType.Float4PrimitiveType -> 'Encoders.float4 PrimitiveType PrimitiveType.Float8PrimitiveType -> 'Encoders.float8 PrimitiveType PrimitiveType.NumericPrimitiveType -> 'Encoders.numeric PrimitiveType PrimitiveType.CharPrimitiveType -> 'Encoders.char PrimitiveType PrimitiveType.TextPrimitiveType -> 'Encoders.text PrimitiveType PrimitiveType.ByteaPrimitiveType -> 'Encoders.bytea PrimitiveType PrimitiveType.DatePrimitiveType -> 'Encoders.date PrimitiveType PrimitiveType.TimestampPrimitiveType -> 'Encoders.timestamp PrimitiveType PrimitiveType.TimestamptzPrimitiveType -> 'Encoders.timestamptz PrimitiveType PrimitiveType.TimePrimitiveType -> 'Encoders.time PrimitiveType PrimitiveType.TimetzPrimitiveType -> 'Encoders.timetz PrimitiveType PrimitiveType.IntervalPrimitiveType -> 'Encoders.interval PrimitiveType PrimitiveType.UuidPrimitiveType -> 'Encoders.uuid PrimitiveType PrimitiveType.InetPrimitiveType -> 'Encoders.inet PrimitiveType PrimitiveType.JsonPrimitiveType -> 'Encoders.json PrimitiveType PrimitiveType.JsonbPrimitiveType -> 'Encoders.jsonb valueDecoder :: PrimitiveType.PrimitiveType -> Either Text Exp valueDecoder :: PrimitiveType -> Either Text Exp valueDecoder = Exp -> Either Text Exp forall a b. b -> Either a b Right (Exp -> Either Text Exp) -> (PrimitiveType -> Exp) -> PrimitiveType -> Either Text Exp forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Name -> Exp VarE (Name -> Exp) -> (PrimitiveType -> Name) -> PrimitiveType -> Exp forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . \case PrimitiveType PrimitiveType.BoolPrimitiveType -> 'Decoders.bool PrimitiveType PrimitiveType.Int2PrimitiveType -> 'Decoders.int2 PrimitiveType PrimitiveType.Int4PrimitiveType -> 'Decoders.int4 PrimitiveType PrimitiveType.Int8PrimitiveType -> 'Decoders.int8 PrimitiveType PrimitiveType.Float4PrimitiveType -> 'Decoders.float4 PrimitiveType PrimitiveType.Float8PrimitiveType -> 'Decoders.float8 PrimitiveType PrimitiveType.NumericPrimitiveType -> 'Decoders.numeric PrimitiveType PrimitiveType.CharPrimitiveType -> 'Decoders.char PrimitiveType PrimitiveType.TextPrimitiveType -> 'Decoders.text PrimitiveType PrimitiveType.ByteaPrimitiveType -> 'Decoders.bytea PrimitiveType PrimitiveType.DatePrimitiveType -> 'Decoders.date PrimitiveType PrimitiveType.TimestampPrimitiveType -> 'Decoders.timestamp PrimitiveType PrimitiveType.TimestamptzPrimitiveType -> 'Decoders.timestamptz PrimitiveType PrimitiveType.TimePrimitiveType -> 'Decoders.time PrimitiveType PrimitiveType.TimetzPrimitiveType -> 'Decoders.timetz PrimitiveType PrimitiveType.IntervalPrimitiveType -> 'Decoders.interval PrimitiveType PrimitiveType.UuidPrimitiveType -> 'Decoders.uuid PrimitiveType PrimitiveType.InetPrimitiveType -> 'Decoders.inet PrimitiveType PrimitiveType.JsonPrimitiveType -> 'Decoders.json PrimitiveType PrimitiveType.JsonbPrimitiveType -> 'Decoders.jsonb