module Lens.Family.Identical where

import Control.Applicative.Backwards (Backwards(..))
import Data.Functor.Identity (Identity(..))
import Data.Functor.Compose (Compose(..))

-- It would really be much better if comonads was in tranformers
class (Traversable f, Applicative f) => Identical f where
  extract :: f a -> a

instance Identical Identity where
  extract :: Identity a -> a
extract (Identity a
x) = a
x

instance Identical f => Identical (Backwards f) where
  extract :: Backwards f a -> a
extract (Backwards f a
x) = f a -> a
forall (f :: * -> *) a. Identical f => f a -> a
extract f a
x

instance (Identical f, Identical g) => Identical (Compose f g) where
  extract :: Compose f g a -> a
extract (Compose f (g a)
x) = g a -> a
forall (f :: * -> *) a. Identical f => f a -> a
extract (f (g a) -> g a
forall (f :: * -> *) a. Identical f => f a -> a
extract f (g a)
x)