module Data.Accessor.Private where

import qualified Control.Category as C


{- |
The access functions we propose, look very similar to those
needed for List.mapAccumL (but parameter order is swapped) and State monad.
They get the new value of the field and the record
and return the old value of the field and the record with the updated field.
-}
newtype T r a  =  Cons {decons :: a -> r -> (a, r)}

compose :: T a b -> T b c -> T a c
compose f g = Cons $ \ cNew aOld ->
   let (bOld, aNew) = decons f bNew aOld
       (cOld, bNew) = decons g cNew bOld
   in  (cOld, aNew)

self :: T r r
self = Cons $ \ai ri -> (ri, ai)


instance C.Category T where
   id = self
   (.) = flip compose