    {- | Lenses that allow polymorphic updates. -}

    {-# LANGUAGE
        FlexibleInstances
      , GADTs
      , MultiParamTypeClasses
      , TypeOperators #-}

    module Data.Label.Poly
    (

    -- * The polymorphic Lens type.
      Lens
    , lens
    , point
    , get
    , modify
    , set
    , iso
    , (>-)
    , for
    )
    where

    import Control.Category
    import Control.Arrow
    import Prelude ()
    import Data.Label.Point (Point (Point), Iso(..), identity, compose)

    import qualified Data.Label.Point as Point

    {-# INLINE lens   #-}
    {-# INLINE get    #-}
    {-# INLINE modify #-}
    {-# INLINE set    #-}
    {-# INLINE (>-)   #-}
    {-# INLINE point  #-}
    {-# INLINE unpack #-}

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

    -- | Abstract polymorphic lens datatype. The getter and setter functions work
    -- in some category. Categories allow for effectful lenses, for example, lenses
    -- that might fail or use state.

    data Lens cat f o where
      Lens :: !(Point cat g i f o) -> Lens cat (f -> g) (o -> i)
      Id   :: ArrowApply cat => Lens cat f f

    -- | Create a lens out of a getter and setter.

    lens :: cat f o             -- ^ Getter.
         -> cat (cat o i, f) g  -- ^ Modifier.
         -> Lens cat (f -> g) (o -> i)
    lens :: cat f o -> cat (cat o i, f) g -> Lens cat (f -> g) (o -> i)
    lens g :: cat f o
    g m :: cat (cat o i, f) g
    m = Point cat g i f o -> Lens cat (f -> g) (o -> i)
    forall (cat :: * -> * -> *) g i f o.
    Point cat g i f o -> Lens cat (f -> g) (o -> i)
    Lens (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 f o
    g cat (cat o i, f) g
    m)

    -- | Create lens from a `Point`.

    point :: Point cat g i f o -> Lens cat (f -> g) (o -> i)
    point :: Point cat g i f o -> Lens cat (f -> g) (o -> i)
    point = Point cat g i f o -> Lens cat (f -> g) (o -> i)
    forall (cat :: * -> * -> *) g i f o.
    Point cat g i f o -> Lens cat (f -> g) (o -> i)
    Lens

    -- | Get the getter arrow from a lens.

    get :: Lens cat (f -> g) (o -> i) -> cat f o
    get :: Lens cat (f -> g) (o -> i) -> cat f o
    get = Point cat g i f o -> cat f o
    forall (cat :: * -> * -> *) g i f o. Point cat g i f o -> cat f o
    Point.get (Point cat g i f o -> cat f o)
    -> (Lens cat (f -> g) (o -> i) -> Point cat g i f o)
    -> Lens cat (f -> g) (o -> i)
    -> 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
    . Lens cat (f -> g) (o -> i) -> Point cat g i f o
    forall (cat :: * -> * -> *) f g o i.
    Lens cat (f -> g) (o -> i) -> Point cat g i f o
    unpack

    -- | Get the modifier arrow from a lens.

    modify :: Lens cat (f -> g) (o -> i) -> cat (cat o i, f) g
    modify :: Lens cat (f -> g) (o -> i) -> cat (cat o i, f) g
    modify = Point cat g i f o -> cat (cat o i, f) g
    forall (cat :: * -> * -> *) g i f o.
    Point cat g i f o -> cat (cat o i, f) g
    Point.modify (Point cat g i f o -> cat (cat o i, f) g)
    -> (Lens cat (f -> g) (o -> i) -> Point cat g i f o)
    -> Lens cat (f -> g) (o -> i)
    -> cat (cat o 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
    . Lens cat (f -> g) (o -> i) -> Point cat g i f o
    forall (cat :: * -> * -> *) f g o i.
    Lens cat (f -> g) (o -> i) -> Point cat g i f o
    unpack

    -- | Get the setter arrow from a lens.

    set :: Arrow arr => Lens arr (f -> g) (o -> i) -> arr (i, f) g
    set :: Lens arr (f -> g) (o -> i) -> arr (i, f) g
    set = Point arr g i f o -> arr (i, f) g
    forall (arr :: * -> * -> *) g i f o.
    Arrow arr =>
    Point arr g i f o -> arr (i, f) g
    Point.set (Point arr g i f o -> arr (i, f) g)
    -> (Lens arr (f -> g) (o -> i) -> Point arr g i f o)
    -> Lens arr (f -> g) (o -> i)
    -> 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
    . Lens arr (f -> g) (o -> i) -> Point arr g i f o
    forall (cat :: * -> * -> *) f g o i.
    Lens cat (f -> g) (o -> i) -> Point cat g i f o
    unpack

    -- | Lift a polymorphic isomorphism into a `Lens`.
    --
    -- The isomorphism needs to be passed in twice to properly unify.

    iso :: ArrowApply cat => Iso cat f o -> Iso cat g i -> Lens cat (f -> g) (o -> i)
    iso :: Iso cat f o -> Iso cat g i -> Lens cat (f -> g) (o -> i)
    iso (Iso f :: cat f o
    f _) (Iso _ y :: cat i g
    y) = cat f o -> cat (cat o i, f) g -> Lens cat (f -> g) (o -> i)
    forall (cat :: * -> * -> *) f o i g.
    cat f o -> cat (cat o i, f) g -> Lens cat (f -> g) (o -> i)
    lens cat f o
    f (cat (cat f g, f) g
    forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
    app cat (cat f g, f) g
    -> cat (cat o i, f) (cat f g, f) -> cat (cat o 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
    . ((cat o i, f) -> (cat f g, f)) -> cat (cat o i, f) (cat f g, f)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (\(m :: cat o i
    m, v :: f
    v) -> (cat i g
    y cat i g -> cat f 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 o i
    m cat o i -> cat f o -> cat f i
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . cat f o
    f, f
    v)))

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

    -- | Category instance for monomorphic lenses.

    instance ArrowApply arr => Category (Lens arr) where
      id :: Lens arr a a
    id              = Lens arr a a
    forall (cat :: * -> * -> *) f. ArrowApply cat => Lens cat f f
    Id
      Lens f :: Point arr g i f o
    f . :: Lens arr b c -> Lens arr a b -> Lens arr a c
    . Lens g :: Point arr g i f o
    g = Point arr g i f o -> Lens arr (f -> g) (o -> i)
    forall (cat :: * -> * -> *) g i f o.
    Point cat g i f o -> Lens cat (f -> g) (o -> i)
    Lens (Point arr g i f o -> Point arr g g f f -> Point arr g i f o
    forall (cat :: * -> * -> *) t i b o g f.
    ArrowApply cat =>
    Point cat t i b o -> Point cat g t f b -> Point cat g i f o
    compose Point arr g i f o
    f Point arr g g f f
    Point arr g i f o
    g)
      Id     . u :: Lens arr a b
    u      = Lens arr a b
    Lens arr a c
    u
      u :: Lens arr b c
    u      . Id     = Lens arr b c
    Lens arr a c
    u
      {-# INLINE id  #-}
      {-# INLINE (.) #-}

    -- | Make a Lens output diverge by changing the input of the modifier. The
    -- operator can be read as /points-to/.

    infix 7 >-

    (>-) :: Arrow arr => Lens arr (j -> a) (i -> b) -> Lens arr (f -> g) (o -> i) -> Point arr g j f o
    >- :: Lens arr (j -> a) (i -> b)
    -> Lens arr (f -> g) (o -> i) -> Point arr g j f o
    (>-) (Lens (Point f :: arr f o
    f _)) (Lens l :: Point arr g i f o
    l) = arr f o -> arr (arr o f, f) g -> Point arr g f f o
    forall (cat :: * -> * -> *) g i f o.
    cat f o -> cat (cat o i, f) g -> Point cat g i f o
    Point (Point arr g i f o -> arr f o
    forall (cat :: * -> * -> *) g i f o. Point cat g i f o -> cat f o
    Point.get Point arr g i f o
    l) (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
    Point.modify Point arr g i f o
    l arr (arr o i, f) g
    -> arr (arr o f, f) (arr o i, f) -> arr (arr o f, 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 (arr o f) (arr o o) -> arr (arr o f, f) (arr o o, f)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((arr o f -> arr o o) -> arr (arr o f) (arr o o)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (arr f o
    f arr f o -> arr o f -> arr o o
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    .)))
    (>-) (Lens (Point f :: arr f o
    f _)) Id       = arr f f -> arr (arr f f, f) o -> Point arr o f f f
    forall (cat :: * -> * -> *) g i f o.
    cat f o -> cat (cat o i, f) g -> Point cat g i f o
    Point arr f f
    forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
    id (arr (arr f o, f) o
    forall (a :: * -> * -> *) b c. ArrowApply a => a (a b c, b) c
    app arr (arr f o, f) o
    -> arr (arr f f, f) (arr f o, f) -> arr (arr f f, f) o
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . arr (arr f f) (arr f o) -> arr (arr f f, f) (arr f o, f)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((arr f f -> arr f o) -> arr (arr f f) (arr f o)
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (arr f o
    f arr f o -> arr f f -> arr f o
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    .)))
    (>-) Id                 l :: Lens arr (f -> g) (o -> i)
    l        = Lens arr (f -> g) (o -> i) -> Point arr g i f o
    forall (cat :: * -> * -> *) f g o i.
    Lens cat (f -> g) (o -> i) -> Point cat g i f o
    unpack Lens arr (f -> g) (o -> i)
    l

    -- | Non-operator version of `>-`, since it clashes with an operator
    -- when the Arrows language extension is used.

    infix 7 `for`

    for :: Arrow arr => Lens arr (j -> a) (i -> b) -> Lens arr (f -> g) (o -> i) -> Point arr g j f o
    for :: Lens arr (j -> a) (i -> b)
    -> Lens arr (f -> g) (o -> i) -> Point arr g j f o
    for = Lens arr (j -> a) (i -> b)
    -> Lens arr (f -> g) (o -> i) -> Point arr g j f o
    forall (arr :: * -> * -> *) j a i b f g o.
    Arrow arr =>
    Lens arr (j -> a) (i -> b)
    -> Lens arr (f -> g) (o -> i) -> Point arr g j f o
    (>-)

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

    -- | Convert a polymorphic lens back to point.

    unpack :: Lens cat (f -> g) (o -> i) -> Point cat g i f o
    unpack :: Lens cat (f -> g) (o -> i) -> Point cat g i f o
    unpack Id       = Point cat g i f o
    forall (arr :: * -> * -> *) f o.
    ArrowApply arr =>
    Point arr f f o o
    identity
    unpack (Lens p :: Point cat g i f o
    p) = Point cat g i f o
    Point cat g i f o
    p