mirror of
https://github.com/circuithub/rel8.git
synced 2024-09-12 00:07:34 +03:00
Drop use of QueryArr (#15)
This commit is contained in:
parent
85872081b8
commit
29f1fdd458
50
Rel8.hs
50
Rel8.hs
@ -28,10 +28,9 @@ module Rel8
|
||||
, Table
|
||||
|
||||
-- * Querying Tables
|
||||
, O.Query, O.QueryArr
|
||||
, O.Query
|
||||
, queryTable
|
||||
, leftJoin
|
||||
, leftJoinA
|
||||
, fullJoin
|
||||
, unionAll
|
||||
, exceptAll
|
||||
@ -126,6 +125,7 @@ module Rel8
|
||||
) where
|
||||
|
||||
import Control.Applicative (liftA2)
|
||||
import Control.Arrow (app)
|
||||
import Control.Category ((.), id)
|
||||
import Control.Monad.Rel8
|
||||
import Data.List (foldl')
|
||||
@ -142,10 +142,7 @@ import qualified Opaleye.Internal.Distinct as O
|
||||
import qualified Opaleye.Internal.HaskellDB.PrimQuery as O
|
||||
import qualified Opaleye.Internal.Join as O
|
||||
import qualified Opaleye.Internal.PackMap as O
|
||||
import qualified Opaleye.Internal.PrimQuery as PrimQuery
|
||||
import qualified Opaleye.Internal.QueryArr as O
|
||||
import qualified Opaleye.Internal.Tag as O
|
||||
import qualified Opaleye.Internal.Unpackspec as O
|
||||
import qualified Opaleye.Join as O
|
||||
import qualified Opaleye.Operators as O
|
||||
import qualified Opaleye.Order as O
|
||||
@ -215,43 +212,6 @@ leftJoin condition l r =
|
||||
(\(a, (_, b)) -> exprToColumn (toNullable (condition a b)))
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | A more convenient form of 'leftJoin' when using arrow notation.
|
||||
-- @inlineLeftJoinA@ takes the left join of all proceeding queries against a
|
||||
-- given query. The input to the 'QueryArr' is a predicate function against
|
||||
-- rows in the to-be-joined query.
|
||||
--
|
||||
-- === Example
|
||||
-- @
|
||||
-- -- Return all users and comments, including users who haven't made a comment.
|
||||
-- usersAndComments :: Query (User Expr, MaybeTable (Comment Expr))
|
||||
-- proc _ -> do
|
||||
-- u <- queryTable -< ()
|
||||
-- comment <- inlineLeftJoinA -< \c -> commentUser c ==. userId u
|
||||
-- returnA (u, c)
|
||||
-- @
|
||||
leftJoinA
|
||||
:: (Table a haskell, Predicate bool)
|
||||
=> O.Query a -> O.QueryArr (a -> Expr bool) (MaybeTable a)
|
||||
leftJoinA q =
|
||||
O.QueryArr $ \(p, left, t) ->
|
||||
let O.QueryArr rightQueryF = liftA2 (,) (pure (lit (Just False))) q
|
||||
(right, pqR, t') = rightQueryF ((), PrimQuery.Unit, t)
|
||||
((tag, renamed), ljPEsB) =
|
||||
O.run
|
||||
(O.runUnpackspec unpackColumns (O.extractLeftJoinFields 2 t') right)
|
||||
in ( MaybeTable tag renamed
|
||||
, PrimQuery.Join
|
||||
PrimQuery.LeftJoin
|
||||
(case toNullable (p renamed) of
|
||||
Expr a -> a)
|
||||
[] -- TODO ?
|
||||
ljPEsB
|
||||
left
|
||||
pqR
|
||||
, O.next t')
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Take the @FULL OUTER JOIN@ of two queries.
|
||||
fullJoin
|
||||
@ -280,15 +240,15 @@ distinct =
|
||||
(O.Aggregator (O.PackMap (\f -> traversePrimExprs (\e -> f (Nothing,e))))))
|
||||
|
||||
-- | Restrict a 'O.QueryArr' to only contain rows that satisfy a given predicate.
|
||||
where_ :: Predicate bool => O.QueryArr (Expr bool) ()
|
||||
where_ = lmap (exprToColumn . toNullable) O.restrict
|
||||
where_ :: Predicate bool => Expr bool -> O.Query ()
|
||||
where_ x = lmap (const (exprToColumn (toNullable x))) O.restrict
|
||||
|
||||
-- | Filter a 'O.Query' into a new query where all rows satisfy a given
|
||||
-- predicate.
|
||||
filterQuery :: Predicate bool => (a -> Expr bool) -> O.Query a -> O.Query a
|
||||
filterQuery f q = proc _ -> do
|
||||
row <- q -< ()
|
||||
where_ -< f row
|
||||
app -< (where_ (f row), ())
|
||||
id -< row
|
||||
|
||||
-- | Corresponds to the @IS NULL@ operator.
|
||||
|
@ -58,20 +58,6 @@ allPartCities = partCity <$> allParts
|
||||
londonParts :: Query (Part Expr)
|
||||
londonParts = filterQuery (\p -> partCity p ==. "London") allParts
|
||||
|
||||
heavyParts :: Query (Part Expr)
|
||||
heavyParts = proc _ -> do
|
||||
part <- queryTable -< ()
|
||||
where_ -< partWeight part >. 5
|
||||
returnA -< part
|
||||
|
||||
existsExample :: Query (Part Expr)
|
||||
existsExample = proc _ -> do
|
||||
part <- queryTable -< ()
|
||||
(| restrictExists
|
||||
(do otherPart <- queryTable -< ()
|
||||
where_ -< partWeight otherPart >. partWeight part) |)
|
||||
returnA -< part
|
||||
|
||||
data Supplier f = Supplier
|
||||
{ supplierId :: C f "SID" 'HasDefault Int32
|
||||
, supplierName :: C f "SName" 'NoDefault String
|
||||
@ -98,19 +84,6 @@ partsAndSuppliers =
|
||||
(\(part, supplier) -> partCity part ==. supplierCity supplier)
|
||||
allPartsAndSuppliers
|
||||
|
||||
partsAndSuppliersLJ :: Query (Part Expr, MaybeTable (Supplier Expr))
|
||||
partsAndSuppliersLJ = proc _ -> do
|
||||
part <- queryTable -< ()
|
||||
maybeSupplier <- leftJoinA queryTable -<
|
||||
\supplier -> partCity part ==. supplierCity supplier
|
||||
returnA -< (part, maybeSupplier)
|
||||
|
||||
partsWithoutSuppliersInCity :: Query (Part Expr)
|
||||
partsWithoutSuppliersInCity = proc _ -> do
|
||||
(part, maybeSupplier) <- partsAndSuppliersLJ -< ()
|
||||
where_ -< isNull (supplierId $? maybeSupplier)
|
||||
returnA -< part
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
main :: IO ()
|
||||
main = return ()
|
||||
|
Loading…
Reference in New Issue
Block a user