@@ -1,13 +1,11 @@
11{-# language DeriveFunctor #-}
22{-# language DerivingStrategies #-}
33{-# language FlexibleContexts #-}
4−{-# language LambdaCase #-}
54{-# language TupleSections #-}
65{-# language UndecidableInstances #-}
76
87module Rel8.Tabulate
98 ( Tabulation
10− , runTabulation
119 , tabulate
1210 , tabulateA
1311 , fromQuery
@@ -41,12 +39,11 @@ import Data.Bifunctor ( bimap, first )
4139import Data.Foldable ( traverse_ )
4240import Data.Functor.Contravariant ( (>$<) )
4341import Data.Maybe ( fromMaybe )
44−import Prelude hiding ( filter, lookup, undefined, zip, zipWith )
42+import Prelude hiding ( filter, lookup, zip, zipWith )
4543
4644-- rel8
4745import Rel8.Aggregate ( Aggregate )
4846import Rel8.Expr ( Expr )
49−import Rel8.Expr.Bool ( not_, true )
5047import Rel8.Order ( Order )
5148import Rel8.Query ( Query )
5249import Rel8.Query.Aggregate ( aggregate )
@@ -66,7 +63,6 @@ import Rel8.Table.List ( ListTable )
6663import Rel8.Table.Maybe ( MaybeTable, maybeTable )
6764import Rel8.Table.NonEmpty ( NonEmptyTable )
6865import Rel8.Table.These ( TheseTable, theseTable )
69−import Rel8.Table.Undefined ( undefined )
7066
7167-- semigroupoids
7268import Data.Functor.Apply ( Apply, liftF2 )
@@ -82,7 +78,7 @@ import Data.Semigroup.Traversable.Class ( bitraverse1 )
8278-- \"Identity\" 'Tabulation's are created using 'tabulate'. 'Tabulation's can
8379-- be composed with 'Query's with 'prebind' or 'postbind' to form new
8480-- 'Tabulation's.
85−newtype Tabulation k a = Tabulation (Either k k -> Query (Maybe k, a))
81+newtype Tabulation k a = Tabulation (k -> Query (Maybe k, a))
8682 deriving stock Functor
8783
8884
@@ -107,7 +103,7 @@ instance EqTable k => Monad (Tabulation k) where
107103 Tabulation bs -> bs i
108104 Just k -> case f a of
109105 Tabulation bs -> do
110− (mk', b) <- bs (Right k)
106+ (mk', b) <- bs k
111107 case mk' of
112108 Nothing -> pure (mk, b)
113109 Just k' -> do
@@ -136,28 +132,6 @@ instance (EqTable k, Table Expr a, Semigroup a) => Monoid (Tabulation k a)
136132 mempty = emptyTable
137133
138134
139−-- | This "undoes" 'fromQuery'.
140−--
141−-- @
142−-- 'runTabulation' . 'fromQuery' = id
143−-- 'fromQuery' . 'runTabulation' = id
144−-- @
145−--
146−-- Note however that it produces nonsense when passed a 'Tabulation' that was
147−-- made with from 'liftQuery' or 'pure'. In such cases the returned 'Query'
148−-- will always produce zero rows.
149−runTabulation :: EqTable k => Tabulation k a -> Query (k, a)
150−runTabulation (Tabulation f) = do
151− (mk, a) <- f (Left undefined)
152− case mk of
153− Nothing -> do
154− -- Opaleye tries to be too clever optimising "WHERE FALSE" and generates
155− -- invalid SQL, so we use "WHERE NOT TRUE" instead
156− where_ $ not_ true
157− pure (undefined, a)
158− Just k -> pure (k, a)
159−
160−
161135liftQuery :: Query a -> Tabulation k a
162136liftQuery query = Tabulation $ const $ fmap (Nothing,) query
163137
@@ -203,7 +177,7 @@ fromQuery = Tabulation . const . fmap (first Just)
203177
204178indexed :: Tabulation k a -> Tabulation k (k, a)
205179indexed (Tabulation query) = Tabulation $ \i ->
206− (\(mk, a) -> (mk, (fromMaybe (either id id i) mk, a))) <$> query i
180+ (\(mk, a) -> (mk, (fromMaybe i mk, a))) <$> query i
207181
208182
209183ifilter :: (k -> a -> Expr Bool) -> Tabulation k a -> Tabulation k a
@@ -235,7 +209,7 @@ infixr 1 `postbind`
235209-- 'lookup' can and often does contain multiple results.
236210lookup :: EqTable k => k -> Tabulation k a -> Query a
237211lookup key (Tabulation query) = do
238− (mk, a) <- query (Right key)
212+ (mk, a) <- query key
239213 traverse_ (where_ . (key ==:)) mk
240214 pure a
241215
@@ -379,12 +353,9 @@ singularize = aggregateTabulation . fmap headAgg
379353
380354optionalTabulation :: EqTable k
381355 => Tabulation k a -> Tabulation k (MaybeTable a)
382−optionalTabulation as = Tabulation $ \case
383− Left k -> case as of
384− Tabulation f -> fmap pure <$> f (Left k)
385− Right k -> do
386− ma <- optional $ lookup k as
387− pure (Just k, ma)
356+optionalTabulation as = Tabulation $ \k -> do
357+ ma <- optional $ lookup k as
358+ pure (Just k, ma)
388359
389360
390361manyTabulation :: (EqTable k, Table Expr a)
@@ -403,4 +374,4 @@ someTabulation = aggregateTabulation . fmap nonEmptyAgg
403374
404375toQuery :: Tabulation k a -> Tabulation k (Query (k, a))
405376toQuery (Tabulation as) = Tabulation $ \k ->
406− pure (Nothing, first (fromMaybe (either id id k)) <$> as k)
377+ pure (Nothing, first (fromMaybe k) <$> as k)