{-|
AST traversal extracting input types.
-}
module Hasql.TH.Extraction.InputTypeList where

import Hasql.TH.Prelude
import PostgresqlSyntax.Ast
import qualified Hasql.TH.Extraction.PlaceholderTypeMap as PlaceholderTypeMap
import qualified Data.IntMap.Strict as IntMap

{-|
>>> import qualified PostgresqlSyntax.Parsing as P
>>> test = either fail (return . preparableStmt) . P.run P.preparableStmt

>>> test "select $1 :: INT"
Right [Typename False (NumericSimpleTypename IntNumeric) False Nothing]

>>> test "select $1 :: INT, a + $2 :: INTEGER"
Right [Typename False (NumericSimpleTypename IntNumeric) False Nothing,Typename False (NumericSimpleTypename IntegerNumeric) False Nothing]

>>> test "select $1 :: INT4"
Right [Typename False (GenericTypeSimpleTypename (GenericType (UnquotedIdent "int4") Nothing Nothing)) False Nothing]

>>> test "select $1 :: text[]?"
Right [Typename False (GenericTypeSimpleTypename (GenericType (UnquotedIdent "text") Nothing Nothing)) False (Just (BoundsTypenameArrayDimensions (Nothing :| []),True))]

>>> test "select $1 :: text?[]?"
Right [Typename False (GenericTypeSimpleTypename (GenericType (UnquotedIdent "text") Nothing Nothing)) True (Just (BoundsTypenameArrayDimensions (Nothing :| []),True))]

>>> test "select $1"
Left "Placeholder $1 misses an explicit typecast"

>>> test "select $2 :: int4, $1 :: int4, $2 :: int4"
Right [Typename False (GenericTypeSimpleTypename (GenericType (UnquotedIdent "int4") Nothing Nothing)) False Nothing,Typename False (GenericTypeSimpleTypename (GenericType (UnquotedIdent "int4") Nothing Nothing)) False Nothing]

>>> test "select $1 :: int4, $1 :: text"
Left "Placeholder $1 has conflicting type annotations"

>>> test "select $2 :: int4, $2 :: text"
Left "Placeholder $2 has conflicting type annotations"

>>> test "select $3 :: int4, $1 :: int4"
Left "You've missed placeholder $2"

-}
preparableStmt :: PreparableStmt -> Either Text [Typename]
preparableStmt :: PreparableStmt -> Either Text [Typename]
preparableStmt = IntMap Typename -> Either Text [Typename]
placeholderTypeMap (IntMap Typename -> Either Text [Typename])
-> (PreparableStmt -> Either Text (IntMap Typename))
-> PreparableStmt
-> Either Text [Typename]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< PreparableStmt -> Either Text (IntMap Typename)
PlaceholderTypeMap.preparableStmt

placeholderTypeMap :: IntMap Typename -> Either Text [Typename]
placeholderTypeMap :: IntMap Typename -> Either Text [Typename]
placeholderTypeMap IntMap Typename
a = do
  (Key -> Key -> Either Text ())
-> [Key] -> [Key] -> Either Text [()]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\ Key
a Key
b -> if Key
a Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
b then () -> Either Text ()
forall a b. b -> Either a b
Right () else Text -> Either Text ()
forall a b. a -> Either a b
Left (Text
"You've missed placeholder $" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
forall a. Show a => a -> Text
showAsText Key
b))
    (IntMap Typename -> [Key]
forall a. IntMap a -> [Key]
IntMap.keys IntMap Typename
a) [Key
1..]
  return (IntMap Typename -> [Typename]
forall a. IntMap a -> [a]
IntMap.elems IntMap Typename
a)