module Data.Accessor.Private where

import qualified Control.Category as C


{- |
The accessor function we use,
has a record value as first argument
and returns the content of a specific record field
and a function that allows to overwrite that field with a new value.

In former version of a package
we used a function that resembled the state monad.
However this required to use an 'undefined'
in the implementation of the @get@ function.
-}
newtype T r a  =  Cons {forall r a. T r a -> r -> (a, a -> r)
decons :: r -> (a, a -> r)}

compose :: T a b -> T b c -> T a c
compose :: forall a b c. T a b -> T b c -> T a c
compose T a b
f T b c
g = forall r a. (r -> (a, a -> r)) -> T r a
Cons forall a b. (a -> b) -> a -> b
$ \ a
aOld ->
   let (b
bOld, b -> a
aSetB) = forall r a. T r a -> r -> (a, a -> r)
decons T a b
f a
aOld
       (c
cOld, c -> b
bSetC) = forall r a. T r a -> r -> (a, a -> r)
decons T b c
g b
bOld
   in  (c
cOld, b -> a
aSetB forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> b
bSetC)

self :: T r r
self :: forall r. T r r
self = forall r a. (r -> (a, a -> r)) -> T r a
Cons forall a b. (a -> b) -> a -> b
$ \r
r -> (r
r, forall a. a -> a
id)


instance C.Category T where
   id :: forall r. T r r
id = forall r. T r r
self
   . :: forall b c a. T b c -> T a b -> T a c
(.) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b c. T a b -> T b c -> T a c
compose