DBJoins.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module DBJoins where

import Data.Tuple (swap)
import Test.QuickCheck (quickCheck)

innerJoin :: [a] -> [b] -> (a -> b -> Bool) -> [(a, b)]
innerJoin xs ys p = [(x, y) | x <- xs, y <- ys, p x y]

leftOuterJoin :: [a] -> [b] -> (a -> b -> Bool) -> [(a, Maybe b)]
leftOuterJoin xs ys p = concatMap loop xs
  where
    loop x = case filter (p x) ys of
        [] -> [(x, Nothing)]
        ys' -> zip (repeat x) (map Just ys')

rightOuterJoin :: [a] -> [b] -> (a -> b -> Bool) -> [(Maybe a, b)]
rightOuterJoin xs ys p = map swap $ leftOuterJoin ys xs (flip p)

-- Tests

prop_leftOuterJoin_resultsMinimum = quickCheck $ \(xs :: [Int]) (ys :: [Int]) ->
    let results = leftOuterJoin xs ys (==)
    in length results >= length xs

prop_leftOuterJoin_alwaysTrue = quickCheck $ \(xs :: [Int]) (ys :: [Int]) ->
    let results = leftOuterJoin xs ys (\_ _ -> True)
    in length results == case ys of
        [] -> length results
        _ -> length xs * length ys

prop_leftOuterJoin_alwaysFalse = quickCheck $ \(xs :: [Int]) (ys :: [Int]) ->
    let results = leftOuterJoin xs ys (\_ _ -> False)
    in length results == length xs