test

src/Rel8/Tabulate.hs

@@ -35,10 +35,8 @@ where
 -- base
 import Control.Applicative ( liftA2 )
 import Control.Monad ( join, liftM2 )
-import Data.Bifunctor ( bimap, first )
-import Data.Foldable ( traverse_ )
+import Data.Bifunctor ( bimap )
 import Data.Functor.Contravariant ( (>$<) )
-import Data.Maybe ( fromMaybe )
 import Prelude hiding ( filter, lookup, zip, zipWith )
 
 -- rel8
@@ -78,7 +76,7 @@ import Data.Semigroup.Traversable.Class ( bitraverse1 )
 -- \"Identity\" 'Tabulation's are created using 'tabulate'. 'Tabulation's can
 -- be composed with 'Query's with 'prebind' or 'postbind' to form new
 -- 'Tabulation's.
-newtype Tabulation k a = Tabulation (k -> Query (Maybe k, a))
+newtype Tabulation k a = Tabulation (k -> Query (k, a))
   deriving stock Functor
 
 
@@ -97,18 +95,12 @@ instance EqTable k => Bind (Tabulation k) where
 
 instance EqTable k => Monad (Tabulation k) where
   Tabulation as >>= f = Tabulation $ \i -> do
-    (mk, a) <- as i
-    case mk of
-      Nothing -> case f a of
-        Tabulation bs -> bs i
-      Just k -> case f a of
-        Tabulation bs -> do
-          (mk', b) <- bs k
-          case mk' of
-            Nothing -> pure (mk, b)
-            Just k' -> do
-              where_ $ k ==: k'
-              pure (mk', b)
+    (k, a) <- as i
+    case f a of
+      Tabulation bs -> do
+        (k', b) <- bs k
+        where_ $ k ==: k'
+        pure (k', b)
 
 
 instance EqTable k => AltTable (Tabulation k) where
@@ -133,7 +125,7 @@ instance (EqTable k, Table Expr a, Semigroup a) => Monoid (Tabulation k a)
 
 
 liftQuery :: Query a -> Tabulation k a
-liftQuery query = Tabulation $ const $ fmap (Nothing,) query
+liftQuery query = Tabulation $ \k -> fmap (k,) query
 
 
 -- | 'tabulate' creates an \"identity\" @'Tabulation' k a@ that allows @a@ be
@@ -172,12 +164,11 @@ tabulateA key a = fromQuery $ (,a) <$> key a
 
 -- | Analgous to 'Data.Map.Strict.fromList'.
 fromQuery :: Query (k, a) -> Tabulation k a
-fromQuery = Tabulation . const . fmap (first Just)
+fromQuery = Tabulation . const
 
 
 indexed :: Tabulation k a -> Tabulation k (k, a)
-indexed (Tabulation query) = Tabulation $ \i ->
-  (\(mk, a) -> (mk, (fromMaybe i mk, a))) <$> query i
+indexed (Tabulation query) = Tabulation $ fmap (\(k, a) -> (k, (k, a))) . query
 
 
 ifilter :: (k -> a -> Expr Bool) -> Tabulation k a -> Tabulation k a
@@ -209,8 +200,8 @@ infixr 1 `postbind`
 -- 'lookup' can and often does contain multiple results.
 lookup :: EqTable k => k -> Tabulation k a -> Query a
 lookup key (Tabulation query) = do
-  (mk, a) <- query key
-  traverse_ (where_ . (key ==:)) mk
+  (k, a) <- query key
+  where_ $ key ==: k
   pure a
 
 
@@ -355,7 +346,7 @@ optionalTabulation :: EqTable k
   => Tabulation k a -> Tabulation k (MaybeTable a)
 optionalTabulation as = Tabulation $ \k -> do
   ma <- optional $ lookup k as
-  pure (Just k, ma)
+  pure (k, ma)
 
 
 manyTabulation :: (EqTable k, Table Expr a)
@@ -373,5 +364,4 @@ someTabulation = aggregateTabulation . fmap nonEmptyAgg
 
 
 toQuery :: Tabulation k a -> Tabulation k (Query (k, a))
-toQuery (Tabulation as) = Tabulation $ \k ->
-  pure (Nothing, first (fromMaybe k) <$> as k)
+toQuery (Tabulation as) = Tabulation $ \k -> pure (k, as k)