content: 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 fa ab = runSort fa ab
  
  instance Discriminating Group where
    disc = 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 m abc ad bd as bs = spanEither abc <$> disc m (((ad &&& Left) <$> as) ++ ((bd &&& Right) <$> 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 m abc ad bd as bs = catMaybes $ joining m go ad bd as bs where
    go ap bp
      | Prelude.null ap || Prelude.null bp = Nothing
      | otherwise = Just (liftA2 abc ap 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 m abc ac bc ad bd as bs = joining m go ad bd as bs where
    go ap bp
      | Prelude.null ap = bc <$> bp
      | Prelude.null bp = ac <$> ap
      | otherwise = liftA2 abc ap 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 m abc ac ad bd as bs = catMaybes $ joining m go ad bd as bs where
    go ap bp
      | Prelude.null ap = Nothing
      | Prelude.null bp = Just (ac <$> ap)
      | otherwise = Just (liftA2 abc ap 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 m abc bc ad bd as bs = catMaybes $ joining m go ad bd as bs where
    go ap bp
      | Prelude.null bp = Nothing
      | Prelude.null ap = Just (bc <$> bp)
      | otherwise = Just (liftA2 abc ap bp)
  