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

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

-- |
-- >>> 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)