-----------------------------------------------------------------------------
-- |
-- Module      :  Generics.Pointless.Lenses.Combinators
-- Copyright   :  (c) 2009 University of Minho
-- License     :  BSD3
--
-- Maintainer  :  hpacheco@di.uminho.pt
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Pointless Lenses:
-- bidirectional lenses with point-free programming
-- 
-- This module lifts a standard set of point-free combinators into bidirectional lenses.
--
-----------------------------------------------------------------------------

module Generics.Pointless.Lenses.Combinators where

import Generics.Pointless.Lenses
import Generics.Pointless.Combinators

-- * Point-free lens combinators

-- | The right exponentiation combinator as a lens.
-- Applies a lens to the domain of a function.
rexp_lns :: Lens b c -> Lens (a -> b) (a -> c)
rexp_lns l = Lens get' put' create'
    where get' = curry (get l . app)
          put' = curry ((put l) . app . (split >< id))
          create' = curry (create l . app)

-- | The lens composition operator.
infixr 9 .<
(.<) :: Lens b a -> Lens c b -> Lens c a
(.<) f g = Lens get' put' create'
    where get' = get f . get g
          put' = put g . (put f . (id >< get g) /\ snd)
          create' = create g . create f

-- | The @fst@ point-free combinator.
fst_lns :: b -> Lens (a,b) a
fst_lns b = Lens get' put' create'
    where get' = fst
          put' = id >< snd
          create' = id /\ (b!)

-- | The @snd@ point-free combinator.
snd_lns :: a -> Lens (a,b) b
snd_lns a = Lens get' put' create'
    where get' = snd
          put' = swap . (id >< fst)
          create' = (a!) /\ id

-- | The @><@ point-free combinator.
infix 7 ><<
(><<) :: Lens c a -> Lens d b -> Lens (c,d) (a,b)
(><<) f g = Lens get' put' create'
    where get' = get f >< get g
          put' = (put f >< put g) . distp
          create' = create f >< create g

-- | The left-biased @\/@ point-free combinator.
-- It chooses left values over right values in the @create@ direction.
infix 4 .\/<
(.\/<) :: Lens a c -> Lens b c -> Lens (Either a b) c
(.\/<) f g = Lens get' put' create'
    where get' = get f \/ get g
          put' = (put f -|- put g) . distr
          create' = inl . create f

-- | The right-biased @\/@ point-free combinator.
-- It chooses right values over left values in the @create@ direction.
infix 4 \/.<
(\/.<) :: Lens a c -> Lens b c -> Lens (Either a b) c
(\/.<) f g = Lens get' put' create'
    where get' = get f \/ get g
          put' = (put f -|- put g) . distr
          create' = inr . create g

-- | The @-|-@ point-free combinator.
infix 5 -|-<
(-|-<) :: Lens c a -> Lens d b -> Lens (Either c d) (Either a b)
(-|-<) f g = Lens get' put' create'
    where get' = get f -|- get g
          put' = ((put f \/ create f . fst) -|- (create g . fst \/ put g)) . dists
          create' = create f -|- create g

-- | The @-|-@ point-free combinator with user-defined backward behavior.
sum_lns :: ((a,d) -> c) -> ((b,c) -> d) -> Lens c a -> Lens d b -> Lens (Either c d) (Either a b)
sum_lns h i f g = Lens get' put' create'
    where get' = get f -|- get g
          put' = (put f -|- put g) . ((id \/ (fst /\ h)) -|- ((fst /\ i) \/ id)) . dists
          create' = create f -|- create g

-- | The @pnt@ point-free combinator.
infix 0 !<
(!<) :: c -> Lens c One
(!<) c = Lens get' put' create'
    where get' = bang
          put' = snd
          create' = (c!)

-- | The @(a!) \/ f@ point-free expression, where @a@ is a constant and @f@ a function.
infix 4 !\/<
(!\/<) :: Eq a => a -> Lens c a -> Lens (Either c b) a
(!\/<) a f = Lens get' put' create'
    where get' = get f \/ (a!)
          put' = (inl \/ coswap) . (id -|- (snd -|- create f . fst)) . (put f -|- (((==a) . fst)?)) . distr
          create' = inl . create f

-- | The @f \/ (a!)@ point-free expression, where @a@ is a constant and @f@ a function.
infix 4 \/!<
(\/!<) :: Eq a => a -> Lens b a -> Lens (Either c b) a
(\/!<) a f = Lens get' put' create'
    where get' = (a!) \/ get f
          put' = (id \/ inr) . ((snd -|- create f . fst) -|- id) . ((((==a) . fst)?) -|- put f) . distr
          create' = inr . create f

-- * Point-free isomorphism combinators

-- | The lens identity combinator.
id_lns :: Lens c c
id_lns = Lens id fst id

-- | The product distribution combinator
distp :: ((c,d),(a,b)) -> ((c,a),(d,b))
distp = fst >< fst /\ snd >< snd

-- | The @distp@ point-free combinator.
distp_lns :: Lens ((c,d),(a,b)) ((c,a),(d,b))
distp_lns = Lens distp (distp . fst) distp

-- | The sum distribution combinator.
dists :: (Either a b,Either c d) -> Either (Either (a,c) (a,d)) (Either (b,c) (b,d))
dists = (distr -|- distr) . distl

-- | The @dists@ point-free combinator.
dists_lns :: Lens (Either a b,Either c d) (Either (Either (a,c) (a,d)) (Either (b,c) (b,d)))
dists_lns = (distr_lns -|-< distr_lns) .< distl_lns

-- | The @swap@ point-free combinator.
swap_lns :: Lens (a,b) (b,a)
swap_lns = Lens swap (swap . fst) swap

-- | The @coswap@ point-free combinator
coswap_lns :: Lens (Either a b) (Either b a)
coswap_lns = Lens coswap (coswap . fst) coswap

-- | The @distl@ point-free combinator.
distl_lns :: Lens (Either a b, c) (Either (a,c) (b,c))
distl_lns = Lens distl (undistl . fst) undistl

-- | The @undistl@ point-free combinator.
undistl_lns :: Lens (Either (a,c) (b,c)) (Either a b, c)
undistl_lns = Lens undistl (distl . fst) distl

-- | The @distr@ point-free combinator.
distr_lns :: Lens (c, Either a b) (Either (c,a) (c,b))
distr_lns = Lens distr (undistr . fst) undistr

-- | The @undistr@ point-free combinator.
undistr_lns :: Lens (Either (c,a) (c,b)) (c, Either a b)
undistr_lns = Lens undistr (distr . fst) distr

-- | The @assocl@ point-free combinator.
assocl_lns :: Lens (a,(b,c)) ((a,b),c)
assocl_lns = Lens assocl (assocr . fst) assocr

-- | The @assocr@ point-free combinator.
assocr_lns :: Lens ((a,b),c) (a,(b,c))
assocr_lns = Lens assocr (assocl . fst) assocl

-- | The @coassocl@ point-free combinator.
coassocl_lns :: Lens (Either a (Either b c)) (Either (Either a b) c)
coassocl_lns = Lens coassocl (coassocr . fst) coassocr

-- | The @coassocr@ point-free combinator.
coassocr_lns :: Lens (Either (Either a b) c) (Either a (Either b c))
coassocr_lns = Lens coassocr (coassocl . fst) coassocl