{-# OPTIONS -XMultiParamTypeClasses -XFunctionalDependencies  -XFlexibleInstances #-}

module Data.Function.Selector
where

import Prelude          hiding (id,(.))

import Control.Arrow
import Control.Category

infixr 3 .&&&.

-- ------------------------------------------------------------

-- | A Selector is a pair of an access function and a modifying function
-- for reading and updating parts of a composite type

data Selector s a       = S { getS :: s -> a
                            , setS :: a -> s -> s
                            }

chgS                    :: Selector s a -> (a -> a) -> (s -> s)
chgS sel f s            = setS sel x s
                          where
                          x = f . getS sel $ s

chgM                    :: (Monad m) => Selector s a -> (a -> m a) -> (s -> m s)
chgM sel f s            = do
                          y <- f x
                          return $ setS sel y s
                          where
                          x = getS sel $ s

-- | Alias for constructor S

mkSelector              :: (s -> a) -> (a -> s -> s) -> Selector s a
mkSelector              = S

-- (.), (>>>), (<<<)

instance Category Selector where
    id                          = S { getS = id
                                    , setS = const
                                    }
    (S g2 s2) . (S g1 s1)       = S { getS = g2 . g1
                                    , setS = \ x s ->
                                            let x1  = g1 s    in
                                            let x1' = s2 x x1 in
                                            s1 x1' s
                                    }

idS                             :: Selector s s
idS                             = id

(.&&&.)                         :: Selector s a -> Selector s b -> Selector s (a, b)
(.&&&.) (S g1 s1) (S g2 s2)     = S { getS = g1 &&& g2
                                    , setS = \ (x, y) -> s2 y . s1 x
                                    }

-- ------------------------------------------------------------

-- | Selectors for pairs and 3-tuples: comp1, comp2, comp3,
-- this can be extended to n-tuples

class Comp1 s a | s -> a where  comp1   :: Selector s a
class Comp2 s a | s -> a where  comp2   :: Selector s a
class Comp3 s a | s -> a where  comp3   :: Selector s a


instance Comp1 (a, b) a where           comp1   = S { getS = fst
                                                    , setS = \ x1 (_, x2) -> (x1, x2)
                                                    }

instance Comp2 (a, b) b where           comp2   = S { getS = snd
                                                    , setS = \ x2 (x1, _) -> (x1, x2)
                                                    }

instance Comp1 (a, b, c) a where        comp1   = S { getS = \ (x1, _, _) -> x1
                                                    , setS = \ x1 (_, x2, x3) -> (x1, x2, x3)
                                                    }

instance Comp2 (a, b, c) b where        comp2   = S { getS = \ (_, x2, _) -> x2
                                                    , setS = \ x2 (x1, _, x3) -> (x1, x2, x3)
                                                    }

instance Comp3 (a, b, c) c where        comp3   = S { getS = \ (_, _, x3) -> x3
                                                    , setS = \ x3 (x1, x2, _) -> (x1, x2, x3)
                                                    }

-- ------------------------------------------------------------