bdcfd29 · rel8 · git.iko.soy

git.iko.soy/rel8

Optimize `<|>:` implementation of `Tabulation` (#178)

`Tabulation` has an instance of `AltTable`, which is intended to uphold the following law: ```haskell fromQuery a <|>: fromQuery b = fromQuery (a <|>: b) ``` The previous implementation was not actually defined in terms of `Query`'s `<|>:` (i.e., `UNION ALL`), because not every `Tabulation` can be safely `toQuery`'d. Instead it used a combination of `alignWith`, `catNonEmptyTable` and `some` that worked even on "magic" `Tabulation`s. However, using `unsafePeekQuery`, we can actually "statically" determine if a `Tabulation` is "magic" or not, which means we can selectively switch the implementation to use `Query`'s `<|>:` where possible. This produces a simpler and usually faster query.

commitbdcfd2962317278a7b2ec8d238f69314f1871590 authorShane <shane.obrien@circuithub.com> dateThu 9 Jun 2022, 14:54 (4 years ago) parent6183b23

1 file changed+20−9

compare with master

unifiedsplit

src/Rel8/Tabulate.hs+20−9

src/Rel8/Tabulate.hs+20−9

@@ -58,7 +58,7 @@ import Data.Function ( on )

5858import Data.Functor.Contravariant ( Contravariant, (>$<), contramap )

5959import Data.Int ( Int64 )

6060import Data.Kind ( Type )

61−import Data.Maybe ( fromMaybe )

61+import Data.Maybe ( fromJust, fromMaybe )

6262import Prelude hiding ( lookup, zip, zipWith )

6363

6464-- bifunctors

@@ -90,7 +90,6 @@ import Rel8.Order ( Order( Order ) )

9090import Rel8.Query ( Query )

9191import qualified Rel8.Query.Exists as Q ( exists, present, absent )

9292import Rel8.Query.Filter ( where_ )

93−import Rel8.Query.Limit ( limit )

9493import Rel8.Query.List ( catNonEmptyTable )

9594import qualified Rel8.Query.Maybe as Q ( optional )

9695import Rel8.Query.Opaleye ( mapOpaleye, unsafePeekQuery )

@@ -234,7 +233,13 @@ instance EqTable k => Monad (Tabulation k) where

234233-- | If @'Tabulation' k a@ is @Map k (NonEmpty a)@, then @(<|>:)@ is

235234-- @unionWith (<>)@.

236235instance EqTable k => AltTable (Tabulation k) where

237− as <|>: bs = catNonEmptyTable `through` ((<>) `on` some) as bs

236+ tas <|>: tbs = do

237+ eas <- peek tas

238+ ebs <- peek tbs

239+ case (eas, ebs) of

240+ (Left as, Left bs) -> liftQuery $ as <|>: bs

241+ (Right as, Right bs) -> fromQuery $ as <|>: bs

242+ _ -> catNonEmptyTable `through` ((<>) `on` some) tas tbs

238243

239244

240245instance EqTable k => AlternativeTable (Tabulation k) where

@@ -343,12 +348,8 @@ aggregate (Tabulation f) = Tabulation $

343348-- \"first\" value it encounters for each key, but note that \"first\" is

344349-- undefined unless you first call 'order'.

345350distinct :: EqTable k => Tabulation k a -> Tabulation k a

346−distinct (Tabulation f) = Tabulation $ \p ->

347− -- workaround for https://github.com/tomjaguarpaw/haskell-opaleye/pull/518

348− case fst (unsafePeekQuery (f p)) of

349− Nothing -> limit 1 (f p)

350− Just _ ->

351− mapOpaleye (Opaleye.distinctOnExplicit (key unpackspec) fst) (f p)

351+distinct (Tabulation f) = Tabulation $

352+ mapOpaleye (Opaleye.distinctOnExplicit (key unpackspec) fst) . f

352353

353354

354355-- | 'order' orders the /values/ of a 'Tabulation' within their

@@ -626,3 +627,13 @@ similarity a b = a <* present b

626627-- @do@-notation.

627628difference :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k a

628629difference a b = a <* absent b

630+

631+

632+-- | 'Tabulation's can be produced with either 'fromQuery' or 'liftQuery', and

633+-- in some cases we might want to treat these differently. 'peek' uses

634+-- 'unsafePeekQuery' to determine which type of 'Tabulation' we have.

635+peek :: Tabulation k a -> Tabulation k (Either (Query a) (Query (k, a)))

636+peek (Tabulation f) = Tabulation $ \p ->

637+ pure $ (empty,) $ case unsafePeekQuery (f p) of

638+ (Nothing, _) -> Left $ fmap snd (f p)

639+ (Just _, _) -> Right $ fmap (first fromJust) (f p)