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)