    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE RankNTypes #-}

    -- | Small replacement for <http://hackage.haskell.org/package/lens lens>.
    module Control.Lens
        ( (&)
        , Iso, Iso', iso
        , from
        , review, ( # )
        , Lens, Lens', lens
        , view, (^.)
        , set, assign, (.=)
        ) where

    import Control.Applicative
    import Control.Monad.Identity
    import Control.Monad.State.Class as State
    import Data.Profunctor
    import Data.Profunctor.Unsafe
    import Unsafe.Coerce

    (&) :: a -> (a -> b) -> b
    a :: a
    a & :: a -> (a -> b) -> b
    & f :: a -> b
    f = a -> b
    f a
    a
    {-# INLINE (&) #-}

    type Overloaded p f s t a b = p a (f b) -> p s (f t)

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

    type Iso s t a b = forall p f. (Profunctor p, Functor f) => Overloaded p f s t a b
    type Iso' s a = Iso s s a a

    iso :: (s -> a) -> (b -> t) -> Iso s t a b
    iso :: (s -> a) -> (b -> t) -> Iso s t a b
    iso sa :: s -> a
    sa bt :: b -> t
    bt = (s -> a) -> (f b -> f t) -> p a (f b) -> p s (f t)
    forall (p :: * -> * -> *) a b c d.
    Profunctor p =>
    (a -> b) -> (c -> d) -> p b c -> p a d
    dimap s -> a
    sa ((b -> t) -> f b -> f t
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap b -> t
    bt)
    {-# INLINE iso #-}

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

    data Exchange a b s t = Exchange (s -> a) (b -> t)

    instance Profunctor (Exchange a b) where
      dimap :: (a -> b) -> (c -> d) -> Exchange a b b c -> Exchange a b a d
    dimap f :: a -> b
    f g :: c -> d
    g (Exchange sa :: b -> a
    sa bt :: b -> c
    bt) = (a -> a) -> (b -> d) -> Exchange a b a d
    forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
    Exchange (b -> a
    sa (b -> a) -> (a -> b) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    f) (c -> d
    g (c -> d) -> (b -> c) -> b -> d
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> c
    bt)
      {-# INLINE dimap #-}
      lmap :: (a -> b) -> Exchange a b b c -> Exchange a b a c
    lmap f :: a -> b
    f (Exchange sa :: b -> a
    sa bt :: b -> c
    bt) = (a -> a) -> (b -> c) -> Exchange a b a c
    forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
    Exchange (b -> a
    sa (b -> a) -> (a -> b) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    f) b -> c
    bt
      {-# INLINE lmap #-}
      rmap :: (b -> c) -> Exchange a b a b -> Exchange a b a c
    rmap f :: b -> c
    f (Exchange sa :: a -> a
    sa bt :: b -> b
    bt) = (a -> a) -> (b -> c) -> Exchange a b a c
    forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
    Exchange a -> a
    sa (b -> c
    f (b -> c) -> (b -> b) -> b -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> b
    bt)
      {-# INLINE rmap #-}
      ( #. ) _ = Exchange a b a b -> Exchange a b a c
    forall a b. a -> b
    unsafeCoerce
      {-# INLINE ( #. ) #-}
      ( .# ) p :: Exchange a b b c
    p _ = Exchange a b b c -> Exchange a b a c
    forall a b. a -> b
    unsafeCoerce Exchange a b b c
    p
      {-# INLINE ( .# ) #-}

    type AnIso s t a b = Overloaded (Exchange a b) Identity s t a b

    from :: AnIso s t a b -> Iso b a t s
    from :: AnIso s t a b -> Iso b a t s
    from l :: AnIso s t a b
    l = case AnIso s t a b
    l ((a -> a) -> (b -> Identity b) -> Exchange a b a (Identity b)
    forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
    Exchange a -> a
    forall a. a -> a
    id b -> Identity b
    forall a. a -> Identity a
    Identity) of
      Exchange sa :: s -> a
    sa bt :: b -> Identity t
    bt -> (b -> t) -> (s -> a) -> Iso b a t s
    forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
    iso (Identity t -> t
    forall a. Identity a -> a
    runIdentity (Identity t -> t) -> (b -> Identity t) -> b -> t
    forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
    (Profunctor p, Coercible c b) =>
    q b c -> p a b -> p a c
    #. b -> Identity t
    bt) s -> a
    sa
    {-# INLINE from #-}

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

    newtype Reviewed a b = Reviewed
        { Reviewed a b -> b
    runReviewed :: b
        } deriving (a -> Reviewed a b -> Reviewed a a
    (a -> b) -> Reviewed a a -> Reviewed a b
    (forall a b. (a -> b) -> Reviewed a a -> Reviewed a b)
    -> (forall a b. a -> Reviewed a b -> Reviewed a a)
    -> Functor (Reviewed a)
    forall a b. a -> Reviewed a b -> Reviewed a a
    forall a b. (a -> b) -> Reviewed a a -> Reviewed a b
    forall a a b. a -> Reviewed a b -> Reviewed a a
    forall a a b. (a -> b) -> Reviewed a a -> Reviewed a b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: a -> Reviewed a b -> Reviewed a a
    $c<$ :: forall a a b. a -> Reviewed a b -> Reviewed a a
    fmap :: (a -> b) -> Reviewed a a -> Reviewed a b
    $cfmap :: forall a a b. (a -> b) -> Reviewed a a -> Reviewed a b
    Functor)

    instance Profunctor Reviewed where
      dimap :: (a -> b) -> (c -> d) -> Reviewed b c -> Reviewed a d
    dimap _ f :: c -> d
    f (Reviewed c :: c
    c) = d -> Reviewed a d
    forall a b. b -> Reviewed a b
    Reviewed (c -> d
    f c
    c)
      {-# INLINE dimap #-}
      lmap :: (a -> b) -> Reviewed b c -> Reviewed a c
    lmap _ (Reviewed c :: c
    c) = c -> Reviewed a c
    forall a b. b -> Reviewed a b
    Reviewed c
    c
      {-# INLINE lmap #-}
      rmap :: (b -> c) -> Reviewed a b -> Reviewed a c
    rmap = (b -> c) -> Reviewed a b -> Reviewed a c
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap
      {-# INLINE rmap #-}
      Reviewed b :: c
    b .# :: Reviewed b c -> q a b -> Reviewed a c
    .# _ = c -> Reviewed a c
    forall a b. b -> Reviewed a b
    Reviewed c
    b
      {-# INLINE ( .# ) #-}
      ( #. ) _ = Reviewed a b -> Reviewed a c
    forall a b. a -> b
    unsafeCoerce
      {-# INLINE ( #. ) #-}

    type AReview s t a b = Overloaded Reviewed Identity s t a b

    review :: AReview s t a b -> b -> t
    review :: AReview s t a b -> b -> t
    review p :: AReview s t a b
    p = Identity t -> t
    forall a. Identity a -> a
    runIdentity (Identity t -> t)
    -> (Reviewed a (Identity b) -> Identity t)
    -> Reviewed a (Identity b)
    -> t
    forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
    (Profunctor p, Coercible c b) =>
    q b c -> p a b -> p a c
    #. Reviewed s (Identity t) -> Identity t
    forall a b. Reviewed a b -> b
    runReviewed (Reviewed s (Identity t) -> Identity t)
    -> AReview s t a b -> Reviewed a (Identity b) -> Identity t
    forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
    (Profunctor p, Coercible c b) =>
    q b c -> p a b -> p a c
    #. AReview s t a b
    p (Reviewed a (Identity b) -> t)
    -> (Identity b -> Reviewed a (Identity b)) -> Identity b -> t
    forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
    (Profunctor p, Coercible b a) =>
    p b c -> q a b -> p a c
    .# Identity b -> Reviewed a (Identity b)
    forall a b. b -> Reviewed a b
    Reviewed (Identity b -> t) -> (b -> Identity b) -> b -> t
    forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
    (Profunctor p, Coercible b a) =>
    p b c -> q a b -> p a c
    .# b -> Identity b
    forall a. a -> Identity a
    Identity
    {-# INLINE review #-}

    infixr 8 #
    ( # ) :: AReview s t a b -> b -> t
    ( # ) = AReview s t a b -> b -> t
    forall s t a b. AReview s t a b -> b -> t
    review
    {-# INLINE ( # ) #-}

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

    type Lens s t a b = forall f. Functor f => Overloaded (->) f s t a b
    type Lens' s a = Lens s s a a

    lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
    lens sa :: s -> a
    sa sbt :: s -> b -> t
    sbt afb :: a -> f b
    afb s :: s
    s = s -> b -> t
    sbt s
    s (b -> t) -> f b -> f t
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> f b
    afb (s -> a
    sa s
    s)
    {-# INLINE lens #-}

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

    type Getting r s a = Overloaded (->) (Const r) s s a a

    view :: Getting a s a -> s -> a
    view :: Getting a s a -> s -> a
    view l :: Getting a s a
    l s :: s
    s = Const a s -> a
    forall a k (b :: k). Const a b -> a
    getConst (Getting a s a
    l a -> Const a a
    forall k a (b :: k). a -> Const a b
    Const s
    s)
    {-# INLINE view #-}

    infixl 8 ^.
    (^.) :: s -> Getting a s a -> a
    ^. :: s -> Getting a s a -> a
    (^.) = (Getting a s a -> s -> a) -> s -> Getting a s a -> a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Getting a s a -> s -> a
    forall a s. Getting a s a -> s -> a
    view
    {-# INLINE (^.) #-}

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

    type Setter s t a b = Overloaded (->) Identity s t a b

    set :: Setter s t a b -> b -> s -> t
    set :: Setter s t a b -> b -> s -> t
    set l :: Setter s t a b
    l b :: b
    b = Identity t -> t
    forall a. Identity a -> a
    runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
    forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
    (Profunctor p, Coercible c b) =>
    q b c -> p a b -> p a c
    #. Setter s t a b
    l (\ _ -> b -> Identity b
    forall a. a -> Identity a
    Identity b
    b)
    {-# INLINE set #-}

    assign :: (MonadState s m) => Setter s s a b -> b -> m ()
    assign :: Setter s s a b -> b -> m ()
    assign l :: Setter s s a b
    l b :: b
    b = (s -> s) -> m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    State.modify (Setter s s a b -> b -> s -> s
    forall s t a b. Setter s t a b -> b -> s -> t
    set Setter s s a b
    l b
    b)
    {-# INLINE assign #-}

    infix 4 .=
    (.=) :: (MonadState s m) => Setter s s a b -> b -> m ()
    .= :: Setter s s a b -> b -> m ()
    (.=) = Setter s s a b -> b -> m ()
    forall s (m :: * -> *) a b.
    MonadState s m =>
    Setter s s a b -> b -> m ()
    assign
    {-# INLINE (.=) #-}