Drop use of QueryArr (#15)

This commit is contained in:
Ollie Charles 2020-09-22 08:57:54 +01:00 committed by GitHub
parent 85872081b8
commit 29f1fdd458
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 5 additions and 72 deletions

50
Rel8.hs
View File

@ -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.

View File

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