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