module Data.Discrimination.Class ( Discriminating(..) -- * Joins , joining , inner , outer , leftOuter , rightOuter ) where import Control.Applicative import Control.Arrow import Data.Functor.Contravariant.Divisible import Data.Discrimination.Grouping import Data.Discrimination.Internal import Data.Discrimination.Sorting import Data.Maybe (catMaybes) class Decidable f => Discriminating f where disc :: f a -> [(a, b)] -> [[b]] instance Discriminating Sort where disc :: Sort a -> [(a, b)] -> [[b]] disc Sort a fa [(a, b)] ab = Sort a -> [(a, b)] -> [[b]] forall a. Sort a -> forall b. [(a, b)] -> [[b]] runSort Sort a fa [(a, b)] ab instance Discriminating Group where disc :: Group a -> [(a, b)] -> [[b]] disc = Group a -> [(a, b)] -> [[b]] forall a b. Group a -> [(a, b)] -> [[b]] runGroup -------------------------------------------------------------------------------- -- * Joins -------------------------------------------------------------------------------- -- | /O(n)/. Perform a full outer join while explicit merging of the two result tables a table at a time. -- -- The results are grouped by the discriminator. joining :: Discriminating f => f d -- ^ the discriminator to use -> ([a] -> [b] -> c) -- ^ how to join two tables -> (a -> d) -- ^ selector for the left table -> (b -> d) -- ^ selector for the right table -> [a] -- ^ left table -> [b] -- ^ right table -> [c] joining :: f d -> ([a] -> [b] -> c) -> (a -> d) -> (b -> d) -> [a] -> [b] -> [c] joining f d m [a] -> [b] -> c abc a -> d ad b -> d bd [a] as [b] bs = ([a] -> [b] -> c) -> [Either a b] -> c forall a b c. ([a] -> [b] -> c) -> [Either a b] -> c spanEither [a] -> [b] -> c abc ([Either a b] -> c) -> [[Either a b]] -> [c] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f d -> [(d, Either a b)] -> [[Either a b]] forall (f :: * -> *) a b. Discriminating f => f a -> [(a, b)] -> [[b]] disc f d m (((a -> d ad (a -> d) -> (a -> Either a b) -> a -> (d, Either a b) forall (a :: * -> * -> *) b c c'. Arrow a => a b c -> a b c' -> a b (c, c') &&& a -> Either a b forall a b. a -> Either a b Left) (a -> (d, Either a b)) -> [a] -> [(d, Either a b)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [a] as) [(d, Either a b)] -> [(d, Either a b)] -> [(d, Either a b)] forall a. [a] -> [a] -> [a] ++ ((b -> d bd (b -> d) -> (b -> Either a b) -> b -> (d, Either a b) forall (a :: * -> * -> *) b c c'. Arrow a => a b c -> a b c' -> a b (c, c') &&& b -> Either a b forall a b. b -> Either a b Right) (b -> (d, Either a b)) -> [b] -> [(d, Either a b)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [b] bs)) {-# INLINE joining #-} -- | /O(n)/. Perform an inner join, with operations defined one row at a time. -- -- The results are grouped by the discriminator. -- -- This takes operation time linear in both the input and result sets. inner :: Discriminating f => f d -- ^ the discriminator to use -> (a -> b -> c) -- ^ how to join two rows -> (a -> d) -- ^ selector for the left table -> (b -> d) -- ^ selector for the right table -> [a] -- ^ left table -> [b] -- ^ right table -> [[c]] inner :: f d -> (a -> b -> c) -> (a -> d) -> (b -> d) -> [a] -> [b] -> [[c]] inner f d m a -> b -> c abc a -> d ad b -> d bd [a] as [b] bs = [Maybe [c]] -> [[c]] forall a. [Maybe a] -> [a] catMaybes ([Maybe [c]] -> [[c]]) -> [Maybe [c]] -> [[c]] forall a b. (a -> b) -> a -> b $ f d -> ([a] -> [b] -> Maybe [c]) -> (a -> d) -> (b -> d) -> [a] -> [b] -> [Maybe [c]] forall (f :: * -> *) d a b c. Discriminating f => f d -> ([a] -> [b] -> c) -> (a -> d) -> (b -> d) -> [a] -> [b] -> [c] joining f d m [a] -> [b] -> Maybe [c] forall (f :: * -> *). (Foldable f, Applicative f) => f a -> f b -> Maybe (f c) go a -> d ad b -> d bd [a] as [b] bs where go :: f a -> f b -> Maybe (f c) go f a ap f b bp | f a -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool Prelude.null f a ap Bool -> Bool -> Bool || f b -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool Prelude.null f b bp = Maybe (f c) forall a. Maybe a Nothing | Bool otherwise = f c -> Maybe (f c) forall a. a -> Maybe a Just ((a -> b -> c) -> f a -> f b -> f c forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 a -> b -> c abc f a ap f b bp) -- | /O(n)/. Perform a full outer join with operations defined one row at a time. -- -- The results are grouped by the discriminator. -- -- This takes operation time linear in both the input and result sets. outer :: Discriminating f => f d -- ^ the discriminator to use -> (a -> b -> c) -- ^ how to join two rows -> (a -> c) -- ^ row present on the left, missing on the right -> (b -> c) -- ^ row present on the right, missing on the left -> (a -> d) -- ^ selector for the left table -> (b -> d) -- ^ selector for the right table -> [a] -- ^ left table -> [b] -- ^ right table -> [[c]] outer :: f d -> (a -> b -> c) -> (a -> c) -> (b -> c) -> (a -> d) -> (b -> d) -> [a] -> [b] -> [[c]] outer f d m a -> b -> c abc a -> c ac b -> c bc a -> d ad b -> d bd [a] as [b] bs = f d -> ([a] -> [b] -> [c]) -> (a -> d) -> (b -> d) -> [a] -> [b] -> [[c]] forall (f :: * -> *) d a b c. Discriminating f => f d -> ([a] -> [b] -> c) -> (a -> d) -> (b -> d) -> [a] -> [b] -> [c] joining f d m [a] -> [b] -> [c] forall (f :: * -> *). (Foldable f, Applicative f) => f a -> f b -> f c go a -> d ad b -> d bd [a] as [b] bs where go :: f a -> f b -> f c go f a ap f b bp | f a -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool Prelude.null f a ap = b -> c bc (b -> c) -> f b -> f c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f b bp | f b -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool Prelude.null f b bp = a -> c ac (a -> c) -> f a -> f c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f a ap | Bool otherwise = (a -> b -> c) -> f a -> f b -> f c forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 a -> b -> c abc f a ap f b bp -- | /O(n)/. Perform a left outer join with operations defined one row at a time. -- -- The results are grouped by the discriminator. -- -- This takes operation time linear in both the input and result sets. leftOuter :: Discriminating f => f d -- ^ the discriminator to use -> (a -> b -> c) -- ^ how to join two rows -> (a -> c) -- ^ row present on the left, missing on the right -> (a -> d) -- ^ selector for the left table -> (b -> d) -- ^ selector for the right table -> [a] -- ^ left table -> [b] -- ^ right table -> [[c]] leftOuter :: f d -> (a -> b -> c) -> (a -> c) -> (a -> d) -> (b -> d) -> [a] -> [b] -> [[c]] leftOuter f d m a -> b -> c abc a -> c ac a -> d ad b -> d bd [a] as [b] bs = [Maybe [c]] -> [[c]] forall a. [Maybe a] -> [a] catMaybes ([Maybe [c]] -> [[c]]) -> [Maybe [c]] -> [[c]] forall a b. (a -> b) -> a -> b $ f d -> ([a] -> [b] -> Maybe [c]) -> (a -> d) -> (b -> d) -> [a] -> [b] -> [Maybe [c]] forall (f :: * -> *) d a b c. Discriminating f => f d -> ([a] -> [b] -> c) -> (a -> d) -> (b -> d) -> [a] -> [b] -> [c] joining f d m [a] -> [b] -> Maybe [c] forall (f :: * -> *). (Foldable f, Applicative f) => f a -> f b -> Maybe (f c) go a -> d ad b -> d bd [a] as [b] bs where go :: f a -> f b -> Maybe (f c) go f a ap f b bp | f a -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool Prelude.null f a ap = Maybe (f c) forall a. Maybe a Nothing | f b -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool Prelude.null f b bp = f c -> Maybe (f c) forall a. a -> Maybe a Just (a -> c ac (a -> c) -> f a -> f c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f a ap) | Bool otherwise = f c -> Maybe (f c) forall a. a -> Maybe a Just ((a -> b -> c) -> f a -> f b -> f c forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 a -> b -> c abc f a ap f b bp) -- | /O(n)/. Perform a right outer join with operations defined one row at a time. -- -- The results are grouped by the discriminator. -- -- This takes operation time linear in both the input and result sets. rightOuter :: Discriminating f => f d -- ^ the discriminator to use -> (a -> b -> c) -- ^ how to join two rows -> (b -> c) -- ^ row present on the right, missing on the left -> (a -> d) -- ^ selector for the left table -> (b -> d) -- ^ selector for the right table -> [a] -- ^ left table -> [b] -- ^ right table -> [[c]] rightOuter :: f d -> (a -> b -> c) -> (b -> c) -> (a -> d) -> (b -> d) -> [a] -> [b] -> [[c]] rightOuter f d m a -> b -> c abc b -> c bc a -> d ad b -> d bd [a] as [b] bs = [Maybe [c]] -> [[c]] forall a. [Maybe a] -> [a] catMaybes ([Maybe [c]] -> [[c]]) -> [Maybe [c]] -> [[c]] forall a b. (a -> b) -> a -> b $ f d -> ([a] -> [b] -> Maybe [c]) -> (a -> d) -> (b -> d) -> [a] -> [b] -> [Maybe [c]] forall (f :: * -> *) d a b c. Discriminating f => f d -> ([a] -> [b] -> c) -> (a -> d) -> (b -> d) -> [a] -> [b] -> [c] joining f d m [a] -> [b] -> Maybe [c] forall (f :: * -> *). (Foldable f, Applicative f) => f a -> f b -> Maybe (f c) go a -> d ad b -> d bd [a] as [b] bs where go :: f a -> f b -> Maybe (f c) go f a ap f b bp | f b -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool Prelude.null f b bp = Maybe (f c) forall a. Maybe a Nothing | f a -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool Prelude.null f a ap = f c -> Maybe (f c) forall a. a -> Maybe a Just (b -> c bc (b -> c) -> f b -> f c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f b bp) | Bool otherwise = f c -> Maybe (f c) forall a. a -> Maybe a Just ((a -> b -> c) -> f a -> f b -> f c forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 a -> b -> c abc f a ap f b bp)