    {-# 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 { Selector s a -> s -> a
    getS :: s -> a
                                , Selector s a -> a -> s -> s
    setS :: a -> s -> s
                                }

    chgS                    :: Selector s a -> (a -> a) -> (s -> s)
    chgS :: Selector s a -> (a -> a) -> s -> s
    chgS sel :: Selector s a
    sel f :: a -> a
    f s :: s
    s            = Selector s a -> a -> s -> s
    forall s a. Selector s a -> a -> s -> s
    setS Selector s a
    sel a
    x s
    s
                              where
                              x :: a
    x = a -> a
    f (a -> a) -> (s -> a) -> s -> a
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Selector s a -> s -> a
    forall s a. Selector s a -> s -> a
    getS Selector s a
    sel (s -> a) -> s -> a
    forall a b. (a -> b) -> a -> b
    $ s
    s

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

    -- | Alias for constructor S

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

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

    instance Category Selector where
        id :: Selector a a
    id                          = S :: forall s a. (s -> a) -> (a -> s -> s) -> Selector s a
    S { getS :: a -> a
    getS = a -> a
    forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id
                                        , setS :: a -> a -> a
    setS = a -> a -> a
    forall a b. a -> b -> a
    const
                                        }
        (S g2 :: b -> c
    g2 s2 :: c -> b -> b
    s2) . :: Selector b c -> Selector a b -> Selector a c
    . (S g1 :: a -> b
    g1 s1 :: b -> a -> a
    s1)       = S :: forall s a. (s -> a) -> (a -> s -> s) -> Selector s a
    S { getS :: a -> c
    getS = b -> c
    g2 (b -> c) -> (a -> b) -> a -> c
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . a -> b
    g1
                                        , setS :: c -> a -> a
    setS = \ x :: c
    x s :: a
    s ->
                                                let x1 :: b
    x1  = a -> b
    g1 a
    s    in
                                                let x1' :: b
    x1' = c -> b -> b
    s2 c
    x b
    x1 in
                                                b -> a -> a
    s1 b
    x1' a
    s
                                        }

    idS                             :: Selector s s
    idS :: Selector s s
    idS                             = Selector s s
    forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id

    (.&&&.)                         :: Selector s a -> Selector s b -> Selector s (a, b)
    .&&&. :: Selector s a -> Selector s b -> Selector s (a, b)
    (.&&&.) (S g1 :: s -> a
    g1 s1 :: a -> s -> s
    s1) (S g2 :: s -> b
    g2 s2 :: b -> s -> s
    s2)     = S :: forall s a. (s -> a) -> (a -> s -> s) -> Selector s a
    S { getS :: s -> (a, b)
    getS = s -> a
    g1 (s -> a) -> (s -> b) -> s -> (a, b)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& s -> b
    g2
                                        , setS :: (a, b) -> s -> s
    setS = \ (x :: a
    x, y :: b
    y) -> b -> s -> s
    s2 b
    y (s -> s) -> (s -> s) -> s -> s
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . a -> s -> s
    s1 a
    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 :: Selector (a, b) a
    comp1   = S :: forall s a. (s -> a) -> (a -> s -> s) -> Selector s a
    S { getS :: (a, b) -> a
    getS = (a, b) -> a
    forall a b. (a, b) -> a
    fst
                                                        , setS :: a -> (a, b) -> (a, b)
    setS = \ x1 :: a
    x1 (_, x2 :: b
    x2) -> (a
    x1, b
    x2)
                                                        }

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

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

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

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

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