```{-# OPTIONS -Wall #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE TupleSections             #-}

{-|
Module: Rel
Description: Cups and objects of the category of relations.
|-}

module Discokitty.Models.Rel
( Rel
, relation
, fromList
, toList
, relCup
, agrees
)
where

import           Data.Maybe
import qualified Data.Set             as S
import           Discokitty.Dimension
import           Discokitty.HasCups
import           Discokitty.Words

-- | A relation hom(1,a) is given by a subset of the universe with
-- elements in a. We model this using the Data.Set library.
data Rel u = Rel (S.Set [u])

relation :: (Ord u) => [[u]] -> Rel u
relation = Rel . S.fromList

fromList :: (Ord u) => [[u]] -> Rel u
fromList = relation

toList :: Rel u -> [[u]]
toList (Rel u) = S.toList u

instance (Show u) => Show (Rel u) where
show = show . toList

instance Dim (Rel u) where
dim = dimRel

dimRel :: Rel u -> Int
dimRel = dimList . toList
where
dimList []      = 0
dimList (l : _) = length l

relCup :: (Ord u) => Int -> Rel u -> Rel u -> Rel u
relCup n r s = relation \$ catMaybes \$ fmap (agrees n) \$ do
x <- toList r
y <- toList s
return (x,y)

relCunit :: (Ord u) => Rel u
relCunit = relation [[]]

agrees :: (Eq u) => Int -> ([u] , [u]) -> Maybe [u]
agrees n (x , y) =
if take n (reverse x) == take n y
then Just \$ reverse (drop n (reverse x)) ++ drop n y
else Nothing

instance (Ord u) => HasCups (Rel u) where
cup = relCup
cunit = relCunit

instance Dim (Words (Rel u)) where
dim = dim . meaning
```