content: {-# language FlexibleContexts #-}
  {-# language MonoLocalBinds #-}
  {-# language ScopedTypeVariables #-}
  {-# language StandaloneKindSignatures #-}
  {-# language TupleSections #-}
  {-# language UndecidableInstances #-}
  
  -- | "Rel8.Tabulate" provides an alternative API ('Tabulation') for writing
  -- queries that complements the main "Rel8" API ('Query').
  
  module Rel8.Tabulate
    (
      Tabulation
  
      -- * Interfacing with 'Query's
    , fromQuery
    , toQuery
    , liftQuery
    , through
    , lookup
  
      -- * Aggregation and Ordering
    , aggregate
    , aggregate1
    , distinct
    , order
  
      -- * Materialize
    , materialize
  
      -- ** Magic 'Tabulation's
      -- $magic
    , count
    , optional
    , many
    , some
    , exists
    , present
    , absent
  
      -- * Natural joins
    , align
    , alignWith
    , leftAlign
    , leftAlignWith
    , rightAlign
    , rightAlignWith
    , zip
    , zipWith
    , similarity
    , difference
    )
  where
  
  -- base
  import Control.Applicative ( (<|>), empty, liftA2 )
  import Control.Monad ( liftM2 )
  import Data.Bifunctor ( Bifunctor, bimap, first, second )
  import Data.Foldable ( traverse_ )
  import Data.Function ( on )
  import Data.Functor.Contravariant ( Contravariant, (>$<), contramap )
  import Data.Int ( Int64 )
  import Data.Kind ( Type )
  import Data.Maybe ( fromJust, fromMaybe )
  import Prelude hiding ( lookup, zip, zipWith )
  
  -- bifunctors
  import Data.Bifunctor.Clown ( Clown( Clown ), runClown )
  
  -- comonad
  import Control.Comonad ( extract )
  
  -- opaleye
  import qualified Opaleye.Order as Opaleye ( orderBy, distinctOnExplicit )
  
  -- profunctors
  import Data.Profunctor ( dimap, lmap )
  
  -- product-profunctors
  import Data.Profunctor.Product
    ( ProductProfunctor, (***!)
    , SumProfunctor, (+++!)
    )
  import qualified Data.Profunctor.Product as PP
  
  -- rel8
  import Rel8.Aggregate (Aggregator' (Aggregator), Aggregator, toAggregator1)
  import Rel8.Aggregate.Fold (Fallback (Fallback))
  import Rel8.Expr ( Expr )
  import Rel8.Expr.Aggregate (countStar)
  import Rel8.Expr.Bool ( true )
  import Rel8.Order ( Order( Order ) )
  import Rel8.Query ( Query )
  import qualified Rel8.Query.Aggregate as Q
  import qualified Rel8.Query.Exists as Q ( exists, present, absent )
  import Rel8.Query.Filter ( where_ )
  import Rel8.Query.List ( catNonEmptyTable )
  import qualified Rel8.Query.Materialize as Q
  import qualified Rel8.Query.Maybe as Q ( optional )
  import Rel8.Query.Opaleye ( mapOpaleye, unsafePeekQuery )
  import Rel8.Query.Rebind ( rebind )
  import Rel8.Query.These ( alignBy )
  import Rel8.Table ( Table, fromColumns, toColumns )
  import Rel8.Table.Aggregate (groupBy, listAgg, nonEmptyAgg)
  import Rel8.Table.Alternative
    ( AltTable, (<|>:)
    , AlternativeTable, emptyTable
    )
  import Rel8.Table.Eq (EqTable, (==:))
  import Rel8.Table.List (ListTable)
  import Rel8.Table.Maybe (MaybeTable (MaybeTable), fromMaybeTable)
  import Rel8.Table.NonEmpty (NonEmptyTable)
  import Rel8.Table.Opaleye ( unpackspec )
  import Rel8.Table.Ord ( OrdTable )
  import Rel8.Table.Order ( ascTable )
  import Rel8.Table.Projection
    ( Biprojectable, biproject
    , Projectable, project
    , apply
    )
  import Rel8.Table.These ( TheseTable( TheseTable ), theseTable )
  
  -- semigroupoids
  import Data.Functor.Apply ( Apply, liftF2 )
  import Data.Functor.Bind ( Bind, (>>-) )
  
  
  type Key :: Type -> Type
  type Key = Maybe
  
  
  cat :: Table Expr k => Key k -> Query k
  cat = maybe emptyTable pure
  
  
  key :: (ProductProfunctor p, SumProfunctor p)
    => p a b -> p (Key a) (Key b)
  key a = dimap from to (PP.empty +++! a)
    where
      from = maybe (Left ()) Right
      to = either (const Nothing) Just
  
  
  keyed :: (ProductProfunctor p, SumProfunctor p)
    => p k l -> p a b -> p (Key k, a) (Key l, b)
  keyed k a = key k ***! a
  
  
  type Predicate :: Type -> Type
  newtype Predicate a = Predicate (Maybe (a -> Expr Bool))
  
  
  instance Contravariant Predicate where
    contramap f (Predicate a) = Predicate (lmap f <$> a)
  
  
  instance Semigroup (Predicate k) where
    Predicate ma <> Predicate mb = Predicate $ ma <|> mb
  
  
  instance Monoid (Predicate k) where
    mempty = Predicate Nothing
  
  
  match :: EqTable k => Key k -> Predicate k
  match = Predicate . fmap (==:)
  
  
  ensure :: Predicate k -> Key k -> Query ()
  ensure (Predicate mp) = traverse_ (\k -> traverse_ (\p -> where_ (p k)) mp)
  
  
  -- | A @'Tabulation' k a@ is like a @'Query' a@, except that each row also
  -- has a key @k@ in addition to the value @a@. 'Tabulation's can be composed
  -- monadically just like 'Query's, but the resulting join is more like a
  -- @NATURAL JOIN@ (based on the common key column(s) @k@) than the
  -- @CROSS JOIN@ given by 'Query'.
  --
  -- Another way to think of @'Tabulation' k a@ is as analogous to @Map k a@ in
  -- the same way @'Query' a@ is analogous to @[a]@. However, there's nothing
  -- stopping a 'Tabulation' from containing multiple rows with the same key, so
  -- technically @Map k (NonEmpty a)@ is more accurate.
  --
  -- 'Tabulation's can be created from 'Query's with 'fromQuery' and 'liftQuery'
  -- and converted back to 'Query's with 'lookup' and 'toQuery' (though note the
  -- caveats that come with the latter).
  type Tabulation :: Type -> Type -> Type
  newtype Tabulation k a = Tabulation (Predicate k -> Query (Key k, a))
  
  
  instance Biprojectable Tabulation where
    biproject f g =
      bimap
        (fromColumns . apply f . toColumns)
        (fromColumns . apply g . toColumns)
  
  
  instance Bifunctor Tabulation where
    bimap f g (Tabulation a) = Tabulation $ \p ->
      bimap (fmap f) g <$> a (f >$< p)
  
  
  instance Functor (Tabulation k) where
    fmap = second
  
  
  instance Projectable (Tabulation k) where
    project f = fmap (fromColumns . apply f . toColumns)
  
  
  -- | If @'Tabulation' k a@ is @Map k (NonEmpty a)@, then @(<.>)@ is
  -- @intersectionWith (liftA2 (<*>))@
  instance EqTable k => Apply (Tabulation k) where
    liftF2 = liftA2
  
  
  -- | @pure = 'liftQuery' . pure@
  instance EqTable k => Applicative (Tabulation k) where
    pure = liftQuery . pure
    liftA2 = liftM2
  
  
  instance EqTable k => Bind (Tabulation k) where
    Tabulation as >>- f = Tabulation $ \p -> do
      (k, a) <- as p
      case f a of
        Tabulation bs -> do
          let p' = match k
          (k', b) <- bs (p' <> p)
          ensure p' k'
          pure (k' <|> k, b)
  
  
  instance EqTable k => Monad (Tabulation k) where
    (>>=) = (>>-)
  
  
  -- | If @'Tabulation' k a@ is @Map k (NonEmpty a)@, then @(<|>:)@ is
  -- @unionWith (<>)@.
  instance EqTable k => AltTable (Tabulation k) where
    tas <|>: tbs = do
      eas <- peek tas
      ebs <- peek tbs
      case (eas, ebs) of
        (Left as, Left bs) -> liftQuery $ as <|>: bs
        (Right as, Right bs) -> fromQuery $ as <|>: bs
        _ -> catNonEmptyTable `through` ((<>) `on` some) tas tbs
  
  
  instance EqTable k => AlternativeTable (Tabulation k) where
    emptyTable = Tabulation $ const $ fmap (empty,) emptyTable
  
  
  -- | If @'Tabulation' k a@ is @Map k (NonEmpty a)@, then @(<>)@ is
  -- @unionWith (liftA2 (<>))@.
  instance (EqTable k, Table Expr a, Semigroup a) => Semigroup (Tabulation k a)
   where
    (<>) = alignWith (theseTable id id (<>))
  
  
  instance (EqTable k, Table Expr a, Semigroup a) => Monoid (Tabulation k a)
   where
    mempty = emptyTable
  
  
  -- | Any 'Query' of key-value pairs @(k, a)@ can be a @'Tabulation' k a@.
  fromQuery :: Query (k, a) -> Tabulation k a
  fromQuery = Tabulation . const . fmap (first pure)
  
  
  -- | Convert a @'Tabulation' k a@ back into a 'Query' of key-value pairs.
  --
  -- Note that the result of a 'toQuery' is undefined (will always return zero
  -- rows) on 'Tabulation's constructed with 'liftQuery' or 'pure'. So while
  -- @toQuery . fromQuery@ is always @id@, @fromQuery . toQuery@ is not.
  --
  -- A safer, more predictable alternative to 'toQuery' is to use 'lookup' with
  -- an explicit set of keys:
  --
  -- @
  -- do
  --    k <- keys
  --    a <- lookup k tabulation
  --    pure (k, a)
  -- @
  --
  -- Having said that, in practice, most legitimate uses of 'Tabulation' will
  -- have a well-defined 'toQuery'. It would be possible in theory to encode
  -- the necessary invariants at the type level using an indexed monad, but we
  -- would lose the ability to use @do@-notation, which is the main benefit
  -- of having 'Tabulation' as a monad in the first place.
  --
  -- In particular, @'toQuery' t@ is well-defined for any 'Tabulation' @t@
  -- defined as @t = fromQuery _@. @'toQuery' t@ is also well-defined for any
  -- 'Tabulation' @t@ defined as @t = t' >>= _@ or @t = t' *> _@ where
  -- @'toQuery' t'@ is well-defined. There are other valid permutations too.
  -- Generally, anything that uses 'fromQuery' at some point, unless wrapped in
  -- a top-level 'present' or 'absent', will have a well-defined 'toQuery'.
  toQuery :: Table Expr k => Tabulation k a -> Query (k, a)
  toQuery (Tabulation f) = do
    (mk, a) <- f mempty
    k <- cat mk
    pure (k, a)
  
  
  -- | A @'Query' a@ can be treated as a @'Tabulation' k a@ where the given @a@
  -- values exist at every possible key @k@.
  liftQuery :: Query a -> Tabulation k a
  liftQuery = Tabulation . const . fmap (empty,)
  
  
  -- | Run a Kleisli arrow in the the 'Query' monad \"through\" a 'Tabulation'.
  -- Useful for 'Rel8.filter'ing a 'Tabulation'.
  --
  -- @
  -- 'Rel8.filter' ((>=. 30) . userAge) `'through'` usersById
  -- @
  through :: (a -> Query b) -> Tabulation k a -> Tabulation k b
  through f (Tabulation as) = Tabulation $ \p -> do
    (k, a) <- as p
    b <- f a
    pure (k, b)
  infixr 1 `through`
  
  
  -- | @'lookup' k t@ returns the value(s) at the key @k@ in the tabulation @t@.
  lookup :: EqTable k => k -> Tabulation k a -> Query a
  lookup k (Tabulation f) = do
    (k', a) <- f p
    ensure p k'
    pure a
    where
      p = match (pure k)
  
  
  -- | 'aggregate' produces a \"magic\" 'Tabulation' whereby the values within
  -- each group of keys in the given 'Tabulation' is aggregated according to
  -- the given aggregator, and every other possible key contains a single
  -- \"fallback\" row is returned, composed of the identity elements of the
  -- constituent aggregation functions.
  aggregate :: (EqTable k, Table Expr i, Table Expr a)
    => Aggregator i a -> Tabulation k i -> Tabulation k a
  aggregate aggregator@(Aggregator (Fallback fallback) _) =
    fmap (fromMaybeTable fallback) . optional . aggregate1 aggregator
  
  
  -- | 'aggregate1' aggregates the values within each key of a
  -- 'Tabulation'. There is an implicit @GROUP BY@ on all the key columns.
  aggregate1 :: (EqTable k, Table Expr i)
    => Aggregator' fold i a -> Tabulation k i -> Tabulation k a
  aggregate1 aggregator (Tabulation f) =
    Tabulation $ Q.aggregateU (keyed unpackspec unpackspec) (keyed groupBy (toAggregator1 aggregator)) . f
  
  
  -- | 'distinct' ensures a 'Tabulation' has at most one value for
  -- each key, i.e., it drops duplicates. In general it keeps only the
  -- \"first\" value it encounters for each key, but note that \"first\" is
  -- undefined unless you first call 'order'.
  distinct :: EqTable k => Tabulation k a -> Tabulation k a
  distinct (Tabulation f) = Tabulation $
    mapOpaleye (Opaleye.distinctOnExplicit (key unpackspec) fst) . f
  
  
  -- | 'order' orders the /values/ of a 'Tabulation' within their
  -- respective keys. This specifies a defined order for 'distinct'.
  -- It also defines the order of the lists produced by 'many' and
  -- 'some'.
  order :: OrdTable k => Order a -> Tabulation k a -> Tabulation k a
  order ordering (Tabulation f) =
    Tabulation $ mapOpaleye (Opaleye.orderBy ordering') . f
    where
      Order ordering' = runClown (keyed (Clown ascTable) (Clown ordering))
  
  
  -- $magic
  --
  -- Some of the following combinators produce \"magic\" 'Tabulation's. Let's
  -- use 'count' as an example to demonstrate this concept. Consider
  -- the following:
  --
  -- @
  -- count $ fromQuery $ values
  --   [ (lit 'a', lit True)
  --   , (lit 'a', lit False)
  --   , (lit 'b', lit True)
  --   ]
  -- @
  --
  -- You might expect this to be equivalent to the following 'Tabulation':
  --
  -- @
  -- fromQuery $ values
  --   [ (lit 'a', 2)
  --   , (lit 'b', 1)
  --   ]
  -- @
  --
  -- However, it isn't quite. While the resulting 'Tabulation' does effectively
  -- contain the above entries, it also behaves as though it contained the value
  -- @0@ at every other possible key.
  --
  -- This means you can do:
  --
  -- @
  -- do
  --   user <- usersById
  --   orderCount <- count ordersByUserId
  -- @
  --
  -- To see how many orders a user has (getting @0@ if they have no orders).
  
  
  -- | 'count' returns a count of how many entries are in the given
  -- 'Tabulation' at each key.
  --
  -- The resulting 'Tabulation' is \"magic\" in that the value @0@ exists at
  -- every possible key that wasn't in the given 'Tabulation'.
  count :: EqTable k => Tabulation k a -> Tabulation k (Expr Int64)
  count = aggregate countStar . (true <$)
  
  
  -- | 'optional' produces a \"magic\" 'Tabulation' whereby each
  -- entry in the given 'Tabulation' is wrapped in 'Rel8.justTable', and every
  -- other possible key contains a single 'Rel8.nothingTable'.
  --
  -- This is used to implement 'leftAlignWith'.
  optional :: Tabulation k a -> Tabulation k (MaybeTable Expr a)
  optional (Tabulation f) = Tabulation $ \p -> case p of
    Predicate Nothing -> fmap pure <$> f p
    _ -> fmap (\m -> (empty, snd <$> m)) $ Q.optional $ do
      (k, a) <- f p
      ensure p k
      pure (k, a)
  
  
  -- | 'many' aggregates each entry with a particular key into a
  -- single entry with all of the values contained in a 'ListTable'.
  --
  -- 'order' can be used to give this 'ListTable' a defined order.
  --
  -- The resulting 'Tabulation' is \"magic\" in that the value
  -- @'Rel8.listTable []'@ exists at every possible key that wasn't in the given
  -- 'Tabulation'.
  many :: (EqTable k, Table Expr a)
    => Tabulation k a -> Tabulation k (ListTable Expr a)
  many = aggregate listAgg
  
  
  -- | 'some' aggregates each entry with a particular key into a
  -- single entry with all of the values contained in a 'NonEmptyTable'.
  --
  -- 'order' can be used to give this 'NonEmptyTable' a defined order.
  some :: (EqTable k, Table Expr a)
    => Tabulation k a -> Tabulation k (NonEmptyTable Expr a)
  some = aggregate1 nonEmptyAgg
  
  
  -- | 'exists' produces a \"magic\" 'Tabulation' which contains the
  -- value 'Rel8.true' at each key in the given 'Tabulation', and the value
  -- 'Rel8.false' at every other possible key.
  exists :: Tabulation k a -> Tabulation k (Expr Bool)
  exists (Tabulation f) = Tabulation $ \p -> case p of
    Predicate Nothing -> (true <$) <$> f p
    _ -> fmap (empty,) $ Q.exists $ do
      (k, _) <- f p
      ensure p k
  
  
  -- | 'present' produces a 'Tabulation' where a single @()@ row
  -- exists for every key that was present in the given 'Tabulation'.
  --
  -- This is used to implement 'similarity'.
  present :: Tabulation k a -> Tabulation k ()
  present (Tabulation f) = Tabulation $ \p -> do
    Q.present $ do
      (k, _) <- f p
      ensure p k
    pure (empty, ())
  
  
  -- | 'absent' produces a 'Tabulation' where a single @()@ row exists
  -- at every possible key that absent from the given 'Tabulation'.
  --
  -- This is used to implement 'difference'.
  absent :: Tabulation k a -> Tabulation k ()
  absent (Tabulation f) = Tabulation $ \p -> do
    Q.absent $ do
      (k, _) <- f p
      ensure p k
    pure (empty, ())
  
  
  -- | Performs a @NATURAL FULL OUTER JOIN@ based on the common key columns.
  --
  -- Analogous to 'Data.Semialign.align'.
  align :: EqTable k
    => Tabulation k a -> Tabulation k b -> Tabulation k (TheseTable Expr a b)
  align = alignWith id
  
  
  -- | Performs a @NATURAL FULL OUTER JOIN@ based on the common key columns.
  --
  -- Analogous to 'Data.Semialign.alignWith'.
  alignWith :: EqTable k
    => (TheseTable Expr a b -> c)
    -> Tabulation k a -> Tabulation k b -> Tabulation k c
  alignWith f (Tabulation as) (Tabulation bs) = Tabulation $ \p -> do
    tkab <- liftF2 (alignBy condition) as bs p
    k <- traverse (rebind "key") $ recover $ bimap fst fst tkab
    let
      tab = bimap snd snd tkab
    pure (k, f tab)
    where
      condition (k, _) (k', _) = fromMaybe true (liftA2 (==:) k k')
      recover (TheseTable mma@(MaybeTable _ ma) mmb@(MaybeTable _ mb)) =
        case extract ma of
          Nothing -> extract mb
          Just a -> case extract mb of
            Nothing -> extract ma
            Just b -> case a <$ mma <|>: b <$ mmb of
              MaybeTable _ c -> pure (extract c)
  
  
  -- | Performs a @NATURAL LEFT OUTER JOIN@ based on the common key columns.
  --
  -- Analogous to 'Data.Semialign.rpadZip'.
  --
  -- Note that you can achieve the same effect with 'optional' and the
  -- 'Applicative' instance for 'Tabulation', i.e., this is just
  -- @\\left right -> liftA2 (,) left (optional right)@. You can also
  -- use @do@-notation.
  leftAlign :: EqTable k
    => Tabulation k a -> Tabulation k b -> Tabulation k (a, MaybeTable Expr b)
  leftAlign = leftAlignWith (,)
  
  
  -- | Performs a @NATURAL LEFT OUTER JOIN@ based on the common key columns.
  --
  -- Analogous to 'Data.Semialign.rpadZipWith'.
  --
  -- Note that you can achieve the same effect with 'optional' and the
  -- 'Applicative' instance for 'Tabulation', i.e., this is just
  -- @\\f left right -> liftA2 f left (optional right)@. You can also
  -- use @do@-notation.
  leftAlignWith :: EqTable k
    => (a -> MaybeTable Expr b -> c)
    -> Tabulation k a -> Tabulation k b -> Tabulation k c
  leftAlignWith f left right = liftA2 f left (optional right)
  
  
  -- | Performs a @NATURAL RIGHT OUTER JOIN@ based on the common key columns.
  --
  -- Analogous to 'Data.Semialign.lpadZip'.
  --
  -- Note that you can achieve the same effect with 'optional' and the
  -- 'Applicative' instance for 'Tabulation', i.e., this is just
  -- @\\left right -> liftA2 (flip (,)) right (optional left)@. You can
  -- also use @do@-notation.
  rightAlign :: EqTable k
    => Tabulation k a -> Tabulation k b -> Tabulation k (MaybeTable Expr a, b)
  rightAlign = rightAlignWith (,)
  
  
  -- | Performs a @NATURAL RIGHT OUTER JOIN@ based on the common key columns.
  --
  -- Analogous to 'Data.Semialign.lpadZipWith'.
  --
  -- Note that you can achieve the same effect with 'optional' and the
  -- 'Applicative' instance for 'Tabulation', i.e., this is just
  -- @\\f left right -> liftA2 (flip f) right (optional left)@. You can
  -- also use @do@-notation.
  rightAlignWith :: EqTable k
    => (MaybeTable Expr a -> b -> c)
    -> Tabulation k a -> Tabulation k b -> Tabulation k c
  rightAlignWith f left right = liftA2 (flip f) right (optional left)
  
  
  -- | Performs a @NATURAL INNER JOIN@ based on the common key columns.
  --
  -- Analagous to 'Data.Semialign.zip'.
  --
  -- Note that you can achieve the same effect with the 'Applicative' instance
  -- of 'Tabulation', i.e., this is just @'liftA2 (,)'@. You can also use
  -- @do@-notation.
  zip :: EqTable k
    => Tabulation k a -> Tabulation k b -> Tabulation k (a, b)
  zip = zipWith (,)
  
  
  -- | Performs a @NATURAL INNER JOIN@ based on the common key columns.
  --
  -- Analagous to 'Data.Semialign.zipWith'.
  --
  -- Note that you can achieve the same effect with the 'Applicative' instance
  -- of 'Tabulation', i.e., this is just @'liftA2'@. You can also use
  -- @do@-notation.
  zipWith :: EqTable k
    => (a -> b -> c) -> Tabulation k a -> Tabulation k b -> Tabulation k c
  zipWith = liftA2
  
  
  -- | Performs a [@NATURAL SEMI JOIN@](https://en.wikipedia.org/wiki/Relational_algebra#Semijoin_%28%E2%8B%89%29%28%E2%8B%8A%29)
  -- based on the common key columns.
  --
  -- The result is a subset of the left tabulation where only entries which have
  -- a corresponding entry in the right tabulation are kept.
  --
  -- Note that you can achieve a similar effect with 'present' and the
  -- 'Applicative' instance of 'Tabulation', i.e., this is just
  -- @\\left right -> left <* present right@. You can also use
  -- @do@-notation.
  similarity :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k a
  similarity a b = a <* present b
  
  
  -- | Performs a [@NATURAL ANTI JOIN@](https://en.wikipedia.org/wiki/Relational_algebra#Antijoin_%28%E2%96%B7%29)
  -- based on the common key columns.
  --
  -- The result is a subset of the left tabulation where only entries which do
  -- not have a corresponding entry in the right tabulation are kept.
  --
  -- Note that you can achieve a similar effect with 'absent' and the
  -- 'Applicative' instance of 'Tabulation', i.e., this is just
  -- @\\left right -> left <* absent right@. You can also use
  -- @do@-notation.
  difference :: EqTable k => Tabulation k a -> Tabulation k b -> Tabulation k a
  difference a b = a <* absent b
  
  
  -- | 'Q.materialize' for 'Tabulation's.
  materialize :: (Table Expr k, Table Expr a)
    => Tabulation k a -> (Tabulation k a -> Query b) -> Query b
  materialize tabulation f = case peek tabulation of
    Tabulation query -> do
      (_, equery) <- query mempty
      case equery of
        Left as -> Q.materialize as (f . liftQuery)
        Right kas -> Q.materialize kas (f . fromQuery)
  
  
  -- | 'Tabulation's can be produced with either 'fromQuery' or 'liftQuery', and
  -- in some cases we might want to treat these differently. 'peek' uses
  -- 'unsafePeekQuery' to determine which type of 'Tabulation' we have.
  peek :: Tabulation k a -> Tabulation k (Either (Query a) (Query (k, a)))
  peek (Tabulation f) = Tabulation $ \p ->
    pure $ (empty,) $ case unsafePeekQuery (f p) of
      (Nothing, _) -> Left $ fmap snd (f p)
      (Just _, _) -> Right $ fmap (first fromJust) (f p)
  