    {- | The Point data type which generalizes the different lenses and forms the
    basis for vertical composition using the `Applicative` type class.
    -}

    {-# LANGUAGE
        TypeOperators
      , Arrows
      , FlexibleInstances
      , MultiParamTypeClasses
      , TypeSynonymInstances #-}

    module Data.Label.Point
    (
    -- * The point data type that generalizes lens.
      Point (Point)
    , get
    , modify
    , set
    , identity
    , compose

    -- * Working with isomorphisms.
    , Iso (..)
    , inv

    -- * Specialized lens contexts.
    , Total
    , Partial
    , Failing

    -- * Arrow type class for failing with some error.
    , ArrowFail (..)
    )
    where

    import Control.Arrow
    import Control.Applicative
    import Control.Category
    import Data.Orphans ()
    import Prelude hiding ((.), id, const, curry, uncurry)

    {-# INLINE get      #-}
    {-# INLINE modify   #-}
    {-# INLINE set      #-}
    {-# INLINE identity #-}
    {-# INLINE compose  #-}
    {-# INLINE inv      #-}
    {-# INLINE const    #-}
    {-# INLINE curry    #-}

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

    -- | Abstract Point datatype. The getter and modifier operations work in some
    -- category. The type of the value pointed to might change, thereby changing
    -- the type of the outer structure.

    data Point cat g i f o = Point (cat f o) (cat (cat o i, f) g)

    -- | Get the getter category from a Point.

    get :: Point cat g i f o -> cat f o
    get :: Point cat g i f o -> cat f o
    get (Point g :: cat f o
    g _) = cat f o
    g

    -- | Get the modifier category from a Point.

    modify :: Point cat g i f o -> cat (cat o i, f) g
    modify :: Point cat g i f o -> cat (cat o i, f) g
    modify (Point _ m :: cat (cat o i, f) g
    m) = cat (cat o i, f) g
    m

    -- | Get the setter category from a Point.

    set :: Arrow arr => Point arr g i f o -> arr (i, f) g
    set :: Point arr g i f o -> arr (i, f) g
    set p :: Point arr g i f o
    p = Point arr g i f o -> arr (arr o i, f) g
    forall (cat :: * -> * -> *) g i f o.
    Point cat g i f o -> cat (cat o i, f) g
    modify Point arr g i f o
    p arr (arr o i, f) g -> arr (i, f) (arr o i, f) -> arr (i, f) g
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . arr i (arr o i) -> arr (i, f) (arr o i, f)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((i -> arr o i) -> arr i (arr o i)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr i -> arr o i
    forall (arr :: * -> * -> *) c b. Arrow arr => c -> arr b c
    const)

    -- | Identity Point. Cannot change the type.

    identity :: ArrowApply arr => Point arr f f o o
    identity :: Point arr f f o o
    identity = arr o o -> arr (arr o f, o) f -> Point arr f f o o
    forall (cat :: * -> * -> *) g i f o.
    cat f o -> cat (cat o i, f) g -> Point cat g i f o
    Point arr o o
    forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id arr (arr o f, o) f
    forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
    app

    -- | Point composition.

    compose :: ArrowApply cat
            => Point cat t i b o
            -> Point cat g t f b
            -> Point cat g i f o
    compose :: Point cat t i b o -> Point cat g t f b -> Point cat g i f o
    compose (Point f :: cat b o
    f m :: cat (cat o i, b) t
    m) (Point g :: cat f b
    g n :: cat (cat b t, f) g
    n)
      = cat f o -> cat (cat o i, f) g -> Point cat g i f o
    forall (cat :: * -> * -> *) g i f o.
    cat f o -> cat (cat o i, f) g -> Point cat g i f o
    Point (cat b o
    f cat b o -> cat f b -> cat f o
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . cat f b
    g) ((cat o i -> cat f g) -> cat (cat o i, f) g
    forall (cat :: * -> * -> *) a b c.
    ArrowApply cat =>
    (a -> cat b c) -> cat (a, b) c
    uncurry (cat (cat b t, f) g -> cat b t -> cat f g
    forall (cat :: * -> * -> *) a b c.
    Arrow cat =>
    cat (a, b) c -> a -> cat b c
    curry cat (cat b t, f) g
    n (cat b t -> cat f g) -> (cat o i -> cat b t) -> cat o i -> cat f g
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . cat (cat o i, b) t -> cat o i -> cat b t
    forall (cat :: * -> * -> *) a b c.
    Arrow cat =>
    cat (a, b) c -> a -> cat b c
    curry cat (cat o i, b) t
    m))

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

    instance Arrow arr => Functor (Point arr f i f) where
      fmap :: (a -> b) -> Point arr f i f a -> Point arr f i f b
    fmap f :: a -> b
    f x :: Point arr f i f a
    x = (a -> b) -> Point arr f i f (a -> b)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a -> b
    f Point arr f i f (a -> b) -> Point arr f i f a -> Point arr f i f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Point arr f i f a
    x
      {-# INLINE fmap #-}

    instance Arrow arr => Applicative (Point arr f i f) where
      pure :: a -> Point arr f i f a
    pure a :: a
    a  = arr f a -> arr (arr a i, f) f -> Point arr f i f a
    forall (cat :: * -> * -> *) g i f o.
    cat f o -> cat (cat o i, f) g -> Point cat g i f o
    Point (a -> arr f a
    forall (arr :: * -> * -> *) c b. Arrow arr => c -> arr b c
    const a
    a) (((arr a i, f) -> f) -> arr (arr a i, f) f
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (arr a i, f) -> f
    forall a b. (a, b) -> b
    snd)
      a :: Point arr f i f (a -> b)
    a <*> :: Point arr f i f (a -> b) -> Point arr f i f a -> Point arr f i f b
    <*> b :: Point arr f i f a
    b = arr f b -> arr (arr b i, f) f -> Point arr f i f b
    forall (cat :: * -> * -> *) g i f o.
    cat f o -> cat (cat o i, f) g -> Point cat g i f o
    Point (((a -> b, a) -> b) -> arr (a -> b, a) b
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (a -> b, a) -> b
    forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
    app arr (a -> b, a) b -> arr f (a -> b, a) -> arr f b
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (Point arr f i f (a -> b) -> arr f (a -> b)
    forall (cat :: * -> * -> *) g i f o. Point cat g i f o -> cat f o
    get Point arr f i f (a -> b)
    a arr f (a -> b) -> arr f a -> arr f (a -> b, a)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& Point arr f i f a -> arr f a
    forall (cat :: * -> * -> *) g i f o. Point cat g i f o -> cat f o
    get Point arr f i f a
    b)) (arr (arr b i, f) f -> Point arr f i f b)
    -> arr (arr b i, f) f -> Point arr f i f b
    forall a b. (a -> b) -> a -> b
    $
        proc (t :: arr b i
    t, p :: f
    p) -> do (f :: a -> b
    f, v :: a
    v) <- Point arr f i f (a -> b) -> arr f (a -> b)
    forall (cat :: * -> * -> *) g i f o. Point cat g i f o -> cat f o
    get Point arr f i f (a -> b)
    a arr f (a -> b) -> arr f a -> arr f (a -> b, a)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& Point arr f i f a -> arr f a
    forall (cat :: * -> * -> *) g i f o. Point cat g i f o -> cat f o
    get Point arr f i f a
    b -< f
    p
                          f
    q <- Point arr f i f (a -> b) -> arr (arr (a -> b) i, f) f
    forall (cat :: * -> * -> *) g i f o.
    Point cat g i f o -> cat (cat o i, f) g
    modify Point arr f i f (a -> b)
    a             -< (arr b i
    t arr b i -> arr (a -> b) b -> arr (a -> b) i
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . ((a -> b) -> b) -> arr (a -> b) b
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr ((a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    $ a
    v), f
    p)
                          Point arr f i f a -> arr (arr a i, f) f
    forall (cat :: * -> * -> *) g i f o.
    Point cat g i f o -> cat (cat o i, f) g
    modify Point arr f i f a
    b                  -< (arr b i
    t arr b i -> arr a b -> arr a i
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (a -> b) -> arr a b
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr a -> b
    f, f
    q)
      {-# INLINE pure  #-}
      {-# INLINE (<*>) #-}

    instance Alternative (Point Partial f view f) where
      empty :: Point Partial f view f a
    empty = Partial f a
    -> Partial (Partial a view, f) f -> Point Partial f view f a
    forall (cat :: * -> * -> *) g i f o.
    cat f o -> cat (cat o i, f) g -> Point cat g i f o
    Point Partial f a
    forall (a :: * -> * -> *) b c. ArrowZero a => a b c
    zeroArrow Partial (Partial a view, f) f
    forall (a :: * -> * -> *) b c. ArrowZero a => a b c
    zeroArrow
      Point a :: Partial f a
    a b :: Partial (Partial a view, f) f
    b <|> :: Point Partial f view f a
    -> Point Partial f view f a -> Point Partial f view f a
    <|> Point c :: Partial f a
    c d :: Partial (Partial a view, f) f
    d = Partial f a
    -> Partial (Partial a view, f) f -> Point Partial f view f a
    forall (cat :: * -> * -> *) g i f o.
    cat f o -> cat (cat o i, f) g -> Point cat g i f o
    Point (Partial f a
    a Partial f a -> Partial f a -> Partial f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Partial f a
    c) (Partial (Partial a view, f) f
    b Partial (Partial a view, f) f
    -> Partial (Partial a view, f) f -> Partial (Partial a view, f) f
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Partial (Partial a view, f) f
    d)

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

    infix 8 `Iso`

    -- | An isomorphism is like a `Category` that works in two directions.

    data Iso cat i o = Iso { Iso cat i o -> cat i o
    fw :: cat i o, Iso cat i o -> cat o i
    bw :: cat o i }

    -- | Isomorphisms are categories.

    instance Category cat => Category (Iso cat) where
      id :: Iso cat a a
    id = cat a a -> cat a a -> Iso cat a a
    forall (cat :: * -> * -> *) i o. cat i o -> cat o i -> Iso cat i o
    Iso cat a a
    forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id cat a a
    forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id
      Iso a :: cat b c
    a b :: cat c b
    b . :: Iso cat b c -> Iso cat a b -> Iso cat a c
    . Iso c :: cat a b
    c d :: cat b a
    d = cat a c -> cat c a -> Iso cat a c
    forall (cat :: * -> * -> *) i o. cat i o -> cat o i -> Iso cat i o
    Iso (cat b c
    a cat b c -> cat a b -> cat a c
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . cat a b
    c) (cat b a
    d cat b a -> cat c b -> cat c a
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . cat c b
    b)
      {-# INLINE id  #-}
      {-# INLINE (.) #-}

    -- | Flip an isomorphism.

    inv :: Iso cat i o -> Iso cat o i
    inv :: Iso cat i o -> Iso cat o i
    inv i :: Iso cat i o
    i = cat o i -> cat i o -> Iso cat o i
    forall (cat :: * -> * -> *) i o. cat i o -> cat o i -> Iso cat i o
    Iso (Iso cat i o -> cat o i
    forall (cat :: * -> * -> *) i o. Iso cat i o -> cat o i
    bw Iso cat i o
    i) (Iso cat i o -> cat i o
    forall (cat :: * -> * -> *) i o. Iso cat i o -> cat i o
    fw Iso cat i o
    i)

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

    -- | Context that represents computations that always produce an output.

    type Total = (->)

    -- | Context that represents computations that might silently fail.

    type Partial = Kleisli Maybe

    -- | Context that represents computations that might fail with some error.

    type Failing e = Kleisli (Either e)

    -- | The ArrowFail class is similar to `ArrowZero`, but additionally embeds
    -- some error value in the computation instead of throwing it away.

    class Arrow a => ArrowFail e a where
      failArrow :: a e c

    instance ArrowFail e Partial where
      failArrow :: Partial e c
    failArrow = (e -> Maybe c) -> Partial e c
    forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
    Kleisli (Maybe c -> e -> Maybe c
    forall (arr :: * -> * -> *) c b. Arrow arr => c -> arr b c
    const Maybe c
    forall a. Maybe a
    Nothing)
      {-# INLINE failArrow #-}

    instance ArrowFail e (Failing e) where
      failArrow :: Failing e e c
    failArrow = (e -> Either e c) -> Failing e e c
    forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
    Kleisli e -> Either e c
    forall a b. a -> Either a b
    Left
      {-# INLINE failArrow #-}

    -------------------------------------------------------------------------------
    -- Common operations experessed in a generalized form.

    const :: Arrow arr => c -> arr b c
    const :: c -> arr b c
    const a :: c
    a = (b -> c) -> arr b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (\_ -> c
    a)

    curry :: Arrow cat => cat (a, b) c -> (a -> cat b c)
    curry :: cat (a, b) c -> a -> cat b c
    curry m :: cat (a, b) c
    m i :: a
    i = cat (a, b) c
    m cat (a, b) c -> cat b (a, b) -> cat b c
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (a -> cat b a
    forall (arr :: * -> * -> *) c b. Arrow arr => c -> arr b c
    const a
    i cat b a -> cat b b -> cat b (a, b)
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& cat b b
    forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id)

    uncurry :: ArrowApply cat => (a -> cat b c) -> cat (a, b) c
    uncurry :: (a -> cat b c) -> cat (a, b) c
    uncurry a :: a -> cat b c
    a = cat (cat b c, b) c
    forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
    app cat (cat b c, b) c -> cat (a, b) (cat b c, b) -> cat (a, b) 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) -> (cat b c, b)) -> cat (a, b) (cat b c, b)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr ((a -> cat b c) -> (a, b) -> (cat b c, b)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first a -> cat b c
    a)