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
|
, Table
|
||||||
|
|
||||||
-- * Querying Tables
|
-- * Querying Tables
|
||||||
, O.Query, O.QueryArr
|
, O.Query
|
||||||
, queryTable
|
, queryTable
|
||||||
, leftJoin
|
, leftJoin
|
||||||
, leftJoinA
|
|
||||||
, fullJoin
|
, fullJoin
|
||||||
, unionAll
|
, unionAll
|
||||||
, exceptAll
|
, exceptAll
|
||||||
@ -126,6 +125,7 @@ module Rel8
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Applicative (liftA2)
|
import Control.Applicative (liftA2)
|
||||||
|
import Control.Arrow (app)
|
||||||
import Control.Category ((.), id)
|
import Control.Category ((.), id)
|
||||||
import Control.Monad.Rel8
|
import Control.Monad.Rel8
|
||||||
import Data.List (foldl')
|
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.HaskellDB.PrimQuery as O
|
||||||
import qualified Opaleye.Internal.Join as O
|
import qualified Opaleye.Internal.Join as O
|
||||||
import qualified Opaleye.Internal.PackMap 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.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.Join as O
|
||||||
import qualified Opaleye.Operators as O
|
import qualified Opaleye.Operators as O
|
||||||
import qualified Opaleye.Order as O
|
import qualified Opaleye.Order as O
|
||||||
@ -215,43 +212,6 @@ leftJoin condition l r =
|
|||||||
(\(a, (_, b)) -> exprToColumn (toNullable (condition a b)))
|
(\(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.
|
-- | Take the @FULL OUTER JOIN@ of two queries.
|
||||||
fullJoin
|
fullJoin
|
||||||
@ -280,15 +240,15 @@ distinct =
|
|||||||
(O.Aggregator (O.PackMap (\f -> traversePrimExprs (\e -> f (Nothing,e))))))
|
(O.Aggregator (O.PackMap (\f -> traversePrimExprs (\e -> f (Nothing,e))))))
|
||||||
|
|
||||||
-- | Restrict a 'O.QueryArr' to only contain rows that satisfy a given predicate.
|
-- | Restrict a 'O.QueryArr' to only contain rows that satisfy a given predicate.
|
||||||
where_ :: Predicate bool => O.QueryArr (Expr bool) ()
|
where_ :: Predicate bool => Expr bool -> O.Query ()
|
||||||
where_ = lmap (exprToColumn . toNullable) O.restrict
|
where_ x = lmap (const (exprToColumn (toNullable x))) O.restrict
|
||||||
|
|
||||||
-- | Filter a 'O.Query' into a new query where all rows satisfy a given
|
-- | Filter a 'O.Query' into a new query where all rows satisfy a given
|
||||||
-- predicate.
|
-- predicate.
|
||||||
filterQuery :: Predicate bool => (a -> Expr bool) -> O.Query a -> O.Query a
|
filterQuery :: Predicate bool => (a -> Expr bool) -> O.Query a -> O.Query a
|
||||||
filterQuery f q = proc _ -> do
|
filterQuery f q = proc _ -> do
|
||||||
row <- q -< ()
|
row <- q -< ()
|
||||||
where_ -< f row
|
app -< (where_ (f row), ())
|
||||||
id -< row
|
id -< row
|
||||||
|
|
||||||
-- | Corresponds to the @IS NULL@ operator.
|
-- | Corresponds to the @IS NULL@ operator.
|
||||||
|
@ -58,20 +58,6 @@ allPartCities = partCity <$> allParts
|
|||||||
londonParts :: Query (Part Expr)
|
londonParts :: Query (Part Expr)
|
||||||
londonParts = filterQuery (\p -> partCity p ==. "London") allParts
|
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
|
data Supplier f = Supplier
|
||||||
{ supplierId :: C f "SID" 'HasDefault Int32
|
{ supplierId :: C f "SID" 'HasDefault Int32
|
||||||
, supplierName :: C f "SName" 'NoDefault String
|
, supplierName :: C f "SName" 'NoDefault String
|
||||||
@ -98,19 +84,6 @@ partsAndSuppliers =
|
|||||||
(\(part, supplier) -> partCity part ==. supplierCity supplier)
|
(\(part, supplier) -> partCity part ==. supplierCity supplier)
|
||||||
allPartsAndSuppliers
|
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 :: IO ()
|
||||||
main = return ()
|
main = return ()
|
||||||
|
Loading…
Reference in New Issue
Block a user