{-# LANGUAGE FlexibleContexts #-} module Opaleye.Internal.Rebind where import Data.Profunctor.Product.Default (Default, def) import Opaleye.Internal.Unpackspec (Unpackspec, runUnpackspec) import Opaleye.Internal.QueryArr (SelectArr(QueryArr)) import qualified Opaleye.Internal.PackMap as PM import qualified Opaleye.Internal.PrimQuery as PQ import qualified Opaleye.Internal.Tag as Tag rebind :: Default Unpackspec a a => SelectArr a a rebind :: SelectArr a a rebind = Unpackspec a a -> SelectArr a a forall a b. Unpackspec a b -> SelectArr a b rebindExplicit Unpackspec a a forall (p :: * -> * -> *) a b. Default p a b => p a b def rebindExplicit :: Unpackspec a b -> SelectArr a b rebindExplicit :: Unpackspec a b -> SelectArr a b rebindExplicit = String -> Unpackspec a b -> SelectArr a b forall a b. String -> Unpackspec a b -> SelectArr a b rebindExplicitPrefix String "rebind" rebindExplicitPrefix :: String -> Unpackspec a b -> SelectArr a b rebindExplicitPrefix :: String -> Unpackspec a b -> SelectArr a b rebindExplicitPrefix String prefix Unpackspec a b u = (a -> State Tag (b, PrimQueryArr)) -> SelectArr a b forall a b. (a -> State Tag (b, PrimQueryArr)) -> SelectArr a b QueryArr ((a -> State Tag (b, PrimQueryArr)) -> SelectArr a b) -> (a -> State Tag (b, PrimQueryArr)) -> SelectArr a b forall a b. (a -> b) -> a -> b $ \a a -> do Tag tag <- State Tag Tag Tag.fresh let (b b, [(Symbol, PrimExpr)] bindings) = PM [(Symbol, PrimExpr)] b -> (b, [(Symbol, PrimExpr)]) forall a r. PM [a] r -> (r, [a]) PM.run (Unpackspec a b -> (PrimExpr -> StateT ([(Symbol, PrimExpr)], Int) Identity PrimExpr) -> a -> PM [(Symbol, PrimExpr)] b forall (f :: * -> *) columns b. Applicative f => Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b runUnpackspec Unpackspec a b u (String -> Tag -> PrimExpr -> StateT ([(Symbol, PrimExpr)], Int) Identity PrimExpr forall primExpr. String -> Tag -> primExpr -> PM [(Symbol, primExpr)] PrimExpr PM.extractAttr String prefix Tag tag) a a) (b, PrimQueryArr) -> State Tag (b, PrimQueryArr) forall (f :: * -> *) a. Applicative f => a -> f a pure (b b, [(Symbol, PrimExpr)] -> PrimQueryArr PQ.aRebind [(Symbol, PrimExpr)] bindings)