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