module Hasql.TH.Extraction.PlaceholderTypeMap where import qualified Data.IntMap.Strict as IntMap import Hasql.TH.Extraction.ChildExprList (ChildExpr (..)) import qualified Hasql.TH.Extraction.ChildExprList as ChildExprList import Hasql.TH.Prelude hiding (union) import PostgresqlSyntax.Ast preparableStmt :: PreparableStmt -> Either Text (IntMap Typename) preparableStmt :: PreparableStmt -> Either Text (IntMap Typename) preparableStmt = [ChildExpr] -> Either Text (IntMap Typename) childExprList ([ChildExpr] -> Either Text (IntMap Typename)) -> (PreparableStmt -> [ChildExpr]) -> PreparableStmt -> Either Text (IntMap Typename) forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . PreparableStmt -> [ChildExpr] ChildExprList.preparableStmt childExprList :: [ChildExpr] -> Either Text (IntMap Typename) childExprList :: [ChildExpr] -> Either Text (IntMap Typename) childExprList = (IntMap Typename -> IntMap Typename -> Either Text (IntMap Typename)) -> IntMap Typename -> [IntMap Typename] -> Either Text (IntMap Typename) forall (t :: * -> *) (m :: * -> *) b a. (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b foldM IntMap Typename -> IntMap Typename -> Either Text (IntMap Typename) union IntMap Typename forall a. IntMap a IntMap.empty ([IntMap Typename] -> Either Text (IntMap Typename)) -> ([ChildExpr] -> Either Text [IntMap Typename]) -> [ChildExpr] -> Either Text (IntMap Typename) forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< (ChildExpr -> Either Text (IntMap Typename)) -> [ChildExpr] -> Either Text [IntMap Typename] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse ChildExpr -> Either Text (IntMap Typename) childExpr union :: IntMap Typename -> IntMap Typename -> Either Text (IntMap Typename) union :: IntMap Typename -> IntMap Typename -> Either Text (IntMap Typename) union IntMap Typename a IntMap Typename b = (Key -> Typename -> Typename -> Maybe (Either Text Typename)) -> (IntMap Typename -> IntMap (Either Text Typename)) -> (IntMap Typename -> IntMap (Either Text Typename)) -> IntMap Typename -> IntMap Typename -> IntMap (Either Text Typename) forall a b c. (Key -> a -> b -> Maybe c) -> (IntMap a -> IntMap c) -> (IntMap b -> IntMap c) -> IntMap a -> IntMap b -> IntMap c IntMap.mergeWithKey Key -> Typename -> Typename -> Maybe (Either Text Typename) forall b a t. (Eq b, Semigroup a, IsString a, Show t) => t -> b -> b -> Maybe (Either a b) merge ((Typename -> Either Text Typename) -> IntMap Typename -> IntMap (Either Text Typename) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Typename -> Either Text Typename forall a b. b -> Either a b Right) ((Typename -> Either Text Typename) -> IntMap Typename -> IntMap (Either Text Typename) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Typename -> Either Text Typename forall a b. b -> Either a b Right) IntMap Typename a IntMap Typename b IntMap (Either Text Typename) -> (IntMap (Either Text Typename) -> Either Text (IntMap Typename)) -> Either Text (IntMap Typename) forall a b. a -> (a -> b) -> b & IntMap (Either Text Typename) -> Either Text (IntMap Typename) forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence where merge :: t -> b -> b -> Maybe (Either a b) merge t index b a b b = if b a b -> b -> Bool forall a. Eq a => a -> a -> Bool == b b then Either a b -> Maybe (Either a b) forall a. a -> Maybe a Just (b -> Either a b forall a b. b -> Either a b Right b a) else Either a b -> Maybe (Either a b) forall a. a -> Maybe a Just (a -> Either a b forall a b. a -> Either a b Left (a "Placeholder $" a -> a -> a forall a. Semigroup a => a -> a -> a <> (String -> a forall a. IsString a => String -> a fromString (String -> a) -> (t -> String) -> t -> a forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . t -> String forall a. Show a => a -> String show) t index a -> a -> a forall a. Semigroup a => a -> a -> a <> a " has conflicting type annotations")) childExpr :: ChildExpr -> Either Text (IntMap Typename) childExpr :: ChildExpr -> Either Text (IntMap Typename) childExpr = \case AChildExpr AExpr a -> AExpr -> Either Text (IntMap Typename) aExpr AExpr a BChildExpr BExpr a -> BExpr -> Either Text (IntMap Typename) bExpr BExpr a CChildExpr CExpr a -> CExpr -> Either Text (IntMap Typename) cExpr CExpr a aExpr :: AExpr -> Either Text (IntMap Typename) aExpr = \case CExprAExpr CExpr a -> CExpr -> Either Text (IntMap Typename) cExpr CExpr a TypecastAExpr AExpr a Typename b -> Typename -> AExpr -> Either Text (IntMap Typename) castedAExpr Typename b AExpr a AExpr a -> [ChildExpr] -> Either Text (IntMap Typename) childExprList (AExpr -> [ChildExpr] ChildExprList.aChildExpr AExpr a) bExpr :: BExpr -> Either Text (IntMap Typename) bExpr = \case CExprBExpr CExpr a -> CExpr -> Either Text (IntMap Typename) cExpr CExpr a TypecastBExpr BExpr a Typename b -> Typename -> BExpr -> Either Text (IntMap Typename) castedBExpr Typename b BExpr a BExpr a -> [ChildExpr] -> Either Text (IntMap Typename) childExprList (BExpr -> [ChildExpr] ChildExprList.bChildExpr BExpr a) cExpr :: CExpr -> Either Text (IntMap Typename) cExpr = \case ParamCExpr Key a Maybe Indirection _ -> Text -> Either Text (IntMap Typename) forall a b. a -> Either a b Left (Text "Placeholder $" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> (String -> Text forall a. IsString a => String -> a fromString (String -> Text) -> (Key -> String) -> Key -> Text forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Key -> String forall a. Show a => a -> String show) Key a Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text " misses an explicit typecast") CExpr a -> [ChildExpr] -> Either Text (IntMap Typename) childExprList (CExpr -> [ChildExpr] ChildExprList.cChildExpr CExpr a) castedAExpr :: Typename -> AExpr -> Either Text (IntMap Typename) castedAExpr Typename a = \case CExprAExpr CExpr b -> Typename -> CExpr -> Either Text (IntMap Typename) castedCExpr Typename a CExpr b TypecastAExpr AExpr b Typename c -> Typename -> AExpr -> Either Text (IntMap Typename) castedAExpr Typename c AExpr b AExpr b -> AExpr -> Either Text (IntMap Typename) aExpr AExpr b castedBExpr :: Typename -> BExpr -> Either Text (IntMap Typename) castedBExpr Typename a = \case CExprBExpr CExpr b -> Typename -> CExpr -> Either Text (IntMap Typename) castedCExpr Typename a CExpr b TypecastBExpr BExpr b Typename c -> Typename -> BExpr -> Either Text (IntMap Typename) castedBExpr Typename c BExpr b BExpr b -> BExpr -> Either Text (IntMap Typename) bExpr BExpr b castedCExpr :: Typename -> CExpr -> Either Text (IntMap Typename) castedCExpr Typename a = \case ParamCExpr Key b Maybe Indirection _ -> IntMap Typename -> Either Text (IntMap Typename) forall a b. b -> Either a b Right (Key -> Typename -> IntMap Typename forall a. Key -> a -> IntMap a IntMap.singleton Key b Typename a) InParensCExpr AExpr b Maybe Indirection _ -> Typename -> AExpr -> Either Text (IntMap Typename) castedAExpr Typename a AExpr b CExpr b -> CExpr -> Either Text (IntMap Typename) cExpr CExpr b