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