@@ -1,7 +1,9 @@
11{-# language DeriveFunctor #-}
22{-# language DerivingStrategies #-}
33{-# language FlexibleContexts #-}
4+{-# language LambdaCase #-}
45{-# language TupleSections #-}
6+{-# language UndecidableInstances #-}
57
68module Rel8.Tabulate
79 ( Tabulation
@@ -54,6 +56,10 @@ import Rel8.Query.Order ( orderBy )
5456import Rel8.Query.These ( alignBy )
5557import Rel8.Table ( Table )
5658import Rel8.Table.Aggregate ( groupBy, listAgg, nonEmptyAgg )
59+import Rel8.Table.Alternative
60+ ( AltTable, (<|>:)
61+ , AlternativeTable, emptyTable
62+ )
5763import Rel8.Table.Eq ( EqTable, (==:) )
5864import Rel8.Table.List ( ListTable )
5965import Rel8.Table.Maybe ( MaybeTable, maybeTable )
@@ -75,7 +81,7 @@ import Data.Semigroup.Traversable.Class ( bitraverse1 )
7581-- \"Identity\" 'Tabulation's are created using 'tabulate'. 'Tabulation's can
7682-- be composed with 'Query's with 'prebind' or 'postbind' to form new
7783-- 'Tabulation's.
78−newtype Tabulation k a = Tabulation (k -> Query (Maybe k, a))
84+newtype Tabulation k a = Tabulation (Either k k -> Query (Maybe k, a))
7985 deriving stock Functor
8086
8187
@@ -100,7 +106,7 @@ instance EqTable k => Monad (Tabulation k) where
100106 Tabulation bs -> bs i
101107 Just k -> case f a of
102108 Tabulation bs -> do
103− (mk', b) <- bs k
109+ (mk', b) <- bs (Right k)
104110 case mk' of
105111 Nothing -> pure (mk, b)
106112 Just k' -> do
@@ -108,6 +114,27 @@ instance EqTable k => Monad (Tabulation k) where
108114 pure (mk', b)
109115
110116
117+instance EqTable k => AltTable (Tabulation k) where
118+ kas <|>: kbs = do
119+ as <- toQuery kas
120+ bs <- toQuery kbs
121+ fromQuery $ as <|>: bs
122+
123+
124+instance EqTable k => AlternativeTable (Tabulation k) where
125+ emptyTable = fromQuery emptyTable
126+
127+
128+instance (EqTable k, Table Expr a, Semigroup a) => Semigroup (Tabulation k a)
129+ where
130+ (<>) = alignWith (theseTable id id (<>))
131+
132+
133+instance (EqTable k, Table Expr a, Semigroup a) => Monoid (Tabulation k a)
134+ where
135+ mempty = emptyTable
136+
137+
111138-- | This "undoes" 'fromQuery'.
112139--
113140-- @
@@ -120,16 +147,14 @@ instance EqTable k => Monad (Tabulation k) where
120147-- will always produce zero rows.
121148runTabulation :: EqTable k => Tabulation k a -> Query (k, a)
122149runTabulation (Tabulation f) = do
123− (mk, a) <- f i
150+ (mk, a) <- f (Left undefined)
124151 case mk of
125152 Nothing -> do
126153 -- Opaleye tries to be too clever optimising "WHERE FALSE" and generates
127154 -- invalid SQL, so we use "WHERE NOT TRUE" instead
128155 where_ $ not_ true
129− pure (i, a)
156+ pure (undefined, a)
130157 Just k -> pure (k, a)
131− where
132− i = undefined
133158
134159
135160liftQuery :: Query a -> Tabulation k a
@@ -177,7 +202,7 @@ fromQuery = Tabulation . const . fmap (first Just)
177202
178203indexed :: Tabulation k a -> Tabulation k (k, a)
179204indexed (Tabulation query) = Tabulation $ \i ->
180− (\(mk, a) -> (mk, (fromMaybe i mk, a))) <$> query i
205+ (\(mk, a) -> (mk, (fromMaybe (either id id i) mk, a))) <$> query i
181206
182207
183208ifilter :: (k -> a -> Expr Bool) -> Tabulation k a -> Tabulation k a
@@ -209,7 +234,7 @@ infixr 1 `postbind`
209234-- 'lookup' can and often does contain multiple results.
210235lookup :: EqTable k => k -> Tabulation k a -> Query a
211236lookup key (Tabulation query) = do
212− (mk, a) <- query key
237+ (mk, a) <- query (Right key)
213238 traverse_ (where_ . (key ==:)) mk
214239 pure a
215240
@@ -345,9 +370,12 @@ orderTabulation ordering (Tabulation as) =
345370
346371optionalTabulation :: EqTable k
347372 => Tabulation k a -> Tabulation k (MaybeTable a)
348−optionalTabulation as = Tabulation $ \k -> do
349− ma <- optional $ lookup k as
350− pure (Just k, ma)
373+optionalTabulation as = Tabulation $ \case
374+ Left k -> case as of
375+ Tabulation f -> fmap pure <$> f (Left k)
376+ Right k -> do
377+ ma <- optional $ lookup k as
378+ pure (Just k, ma)
351379
352380
353381manyTabulation :: (EqTable k, Table Expr a)
@@ -366,4 +394,4 @@ someTabulation = aggregateTabulation . fmap nonEmptyAgg
366394
367395toQuery :: Tabulation k a -> Tabulation k (Query (k, a))
368396toQuery (Tabulation as) = Tabulation $ \k ->
369− pure (Nothing, first (fromMaybe k) <$> as k)
397+ pure (Nothing, first (fromMaybe (either id id k)) <$> as k)