content: {- | 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 g m = Lens (Point g m)
  
  -- | Create lens from a `Point`.
  
  point :: Point cat g i f o -> Lens cat (f -> g) (o -> i)
  point = Lens
  
  -- | Get the getter arrow from a lens.
  
  get :: Lens cat (f -> g) (o -> i) -> cat f o
  get = Point.get . unpack
  
  -- | Get the modifier arrow from a lens.
  
  modify :: Lens cat (f -> g) (o -> i) -> cat (cat o i, f) g
  modify = Point.modify . unpack
  
  -- | Get the setter arrow from a lens.
  
  set :: Arrow arr => Lens arr (f -> g) (o -> i) -> arr (i, f) g
  set = Point.set . 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 f _) (Iso _ y) = lens f (app . arr (\(m, v) -> (y . m . f, v)))
  
  -------------------------------------------------------------------------------
  
  -- | Category instance for monomorphic lenses.
  
  instance ArrowApply arr => Category (Lens arr) where
    id              = Id
    Lens f . Lens g = Lens (compose f g)
    Id     . u      = u
    u      . Id     = 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 (Point f _)) (Lens l) = Point (Point.get l) (Point.modify l . first (arr (f .)))
  (>-) (Lens (Point f _)) Id       = Point id (app . first (arr (f .)))
  (>-) Id                 l        = unpack 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 = (>-)
  
  -------------------------------------------------------------------------------
  
  -- | Convert a polymorphic lens back to point.
  
  unpack :: Lens cat (f -> g) (o -> i) -> Point cat g i f o
  unpack Id       = identity
  unpack (Lens p) = p
  
  