-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Relation
-- Copyright   :  (c) 2011 University of Minho
-- License     :  BSD3
--
-- Maintainer  :  hpacheco@di.uminho.pt
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Pointless Lenses:
-- bidirectional lenses with point-free programming
-- 
-- This module defines relations as sets of pairs and provides some typical point-free combinators for their manipulation.
--
-----------------------------------------------------------------------------

module Data.Relation where

import qualified Data.Set as Set
import Data.Set (Set)

-----------------------------------------------------------------------------
-- * Representation

-- | Type of relations
type Rel a b = Set (a,b)
infixr 8 :<-:
type b :<-: a = Rel a b
infixr 8 :->:
type a :->: b = Rel a b

-- | Build a relation from a list of pairs.
mkRel :: (Ord a, Ord b) => [(a,b)] -> Rel a b
mkRel pairs = Set.fromList pairs

-- | Convert relation to a list of pairs.
pairs :: (Ord a, Ord b) => Rel a b -> [(a,b)]
pairs r = Set.elems r

-- | Obtain the domain of a relation
dom :: (Ord a, Ord b) => Rel a b -> Set a
dom xs = Set.map fst xs

-- | Obtain the range of a relation
rng :: (Ord a, Ord b) => Rel a b -> Set b
rng xs = Set.map snd xs

-- | domain for a specific range value
domOf :: (Eq b,Ord a) => b -> Rel a b -> Set a
domOf b r = Set.fromList [ x | (x,y) <- Set.elems r, y == b ]

-- | range for a specific doman value
rngOf :: (Eq a,Ord b) => a -> Rel a b -> Set b
rngOf a r = Set.fromList [ y | (x,y) <- Set.elems r, x == a]

-- * Relational combinators      

-- | Build an empty relation.              
emptyR :: Rel a b
emptyR = Set.empty

-- | Build identity relation, which contains an edge from each node to itself.
idR :: Ord a => Set a -> Rel a a
idR s = Set.map (\x -> (x,x)) s

-- | Build total relation, which contains an edge from each node to 
--   each other node and to itself.
total :: Ord a => Set a -> Rel a a
total s = Set.fromList [ (x,y) |  x <- l, y <- l ]
    where l = Set.elems s

-- | Take the inverse of a relation
inv :: (Ord a, Ord b) => Rel a b -> Rel b a
inv xs = Set.map (\(x,y) -> (y,x)) xs

-- | Union of two relations
unionR :: (Ord a,Ord b) => Rel a b -> Rel a b -> Rel a b
unionR r s = Set.union r s

-- | Intersection of two relations
intersectionR :: (Ord a,Ord b) => Rel a b -> Rel a b -> Rel a b
intersectionR r s = Set.intersection r s

-- | Compose two relations
infixr 8 .~
(.~) :: (Ord a, Eq b, Ord c) => Rel b c -> Rel a b -> Rel a c
(.~) r s = mkRel [ (x,z) | (x,y) <- Set.elems s , (y',z) <- Set.elems r , y==y' ]

funR :: (Ord a,Ord b) => (a -> b) -> Set a -> Rel a b
funR f sa = mkRel [ (x,f x) | x <- Set.elems sa ]

infixr 9 <.~
(<.~) :: (Ord a, Ord b, Ord b') => (b -> b') -> Rel a b -> Rel a b'
f <.~ r = Set.map (\(x,y) -> (x,f y)) r

infixr 9 ~.>
(~.>) :: (Ord a, Ord b, Ord a') => Rel a b -> (a -> a') -> Rel a' b
r ~.> f = Set.map (\(x,y) -> (f x,y)) r

inlR :: (Ord a,Ord b) => Set a -> Rel a (Either a b)
inlR s = mkRel [ (x,Left x) | x <- Set.elems s ]

inrR :: (Ord a,Ord b) => Set b -> Rel b (Either a b)
inrR s = mkRel [ (x,Right x) | x <- Set.elems s ]

-- | The infix either combinator.
infixr 4 \/~
(\/~) :: (Ord a,Ord b,Ord c) => Rel b a -> Rel c a -> Rel (Either b c) a
(\/~) r s = (r .~ inv (inlR (dom r))) `unionR` (s .~ inv (inrR (dom s)))

-- | The infix sum combinator.
infix 5 -|-~
(-|-~) :: (Ord a,Ord b,Ord c,Ord d) => Rel a b -> Rel c d -> Rel (Either a c) (Either b d)
f -|-~ g = inlR (rng f) .~ f \/~ inrR (rng g) .~ g

fstR :: (Ord a,Ord b) => Set (a,b) -> Rel (a,b) a
fstR s = mkRel [((x,y),x) | (x,y) <- Set.elems s ]

sndR :: (Ord a,Ord b) => Set (a,b) -> Rel (a,b) b
sndR s = mkRel [((x,y),y) | (x,y) <- Set.elems s ]

infix 6  /\~
(/\~) :: (Ord a,Ord b,Ord c) => Rel a b -> Rel a c -> Rel a (b,c)
r /\~ s = (inv (fstR bc) .~ r) `intersectionR` (inv (sndR bc) .~ s)
    where bc = Set.fromList [ (x,y) | x <- Set.elems (rng r) , y <- Set.elems (rng s) ]

infix 7 ><~
(><~) :: (Ord a,Ord b,Ord c,Ord d) => Rel a c -> Rel b d -> Rel (a,b) (c,d)
r ><~ s = r .~ fstR ab /\~ s .~ sndR ab
    where ab = Set.fromList [ (x,y) | x <- Set.elems (dom r) , y <- Set.elems (dom s) ]

-- | Kernel of a relation.
ker :: (Ord a, Ord b) => Rel a b -> Rel a a
ker r = inv r .~ r

-- | Image of a relation.
img :: (Ord a, Ord b) => Rel a b -> Rel b b
img r = r .~ inv r