diff --git a/src/Rel8/Tabulate.hs b/src/Rel8/Tabulate.hs index 28d438e..a74eaf7 100644 --- a/src/Rel8/Tabulate.hs +++ b/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)