module Hasql.TH.Extraction.Exp where

import Hasql.TH.Prelude
import Language.Haskell.TH
import qualified Hasql.Encoders as Encoders
import qualified Hasql.Decoders as Decoders
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 qualified Hasql.TH.Construction.Exp as Exp
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