    {-# 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)
                                                        }

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