-----------------------------------------------------------------------------
-- |
-- 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
import Generics.Pointless.Functors

-- * Point-free lens combinators

-- | Function application is a lens.
ap_lns :: Eq a => a -> Lens ((a -> b),a) b
ap_lns a = Lens get' put' create'
    where get' = app
          put' (b,(f,a)) = (\x -> if x==a then b else f x,a)
          create' = const /\ const a

-- | Predicate application is a lens.
infix 0 ?<
(?<) :: Eq a => Lens (a -> Bool,a) (Either a a)
(?<) = Lens get' put' create'
    where get' = (snd -|- snd) . distl . (out . app /\ snd)
          put' = ((orf \/ andf) . distl . (eqneq >< fst)) /\ ((id \/ id) . fst)
          create' = (curry eq /\ id) \/ (const (inn . inr . bang) /\ id)
          eqneq = curry eq -|- curry neq

-- | 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.
-- The additional argument of type @c@ is the default value when the view matches the constant of type @a@.
infix 4 !\/<
(!\/<) :: Eq a => a -> Lens b a -> c -> Lens (Either c b) a
(!\/<) a f c = Lens get' put' create'
    where get' = (a!) \/ get f
          put' = (id \/ inr) . ((snd -|- create f . fst) -|- id) . ((((==a) . fst)?) -|- put f) . distr
          create' = ((c!) -|- create f) . ((==a)?)
          
-- | The @f \/ (a!)@ point-free expression, where @a@ is a constant and @f@ a function.
-- The additional argument of type @b@ is the default value when the view matches the constant of type @a@.
infix 4 \/!<
(\/!<) :: Eq a => a -> Lens c a -> b -> Lens (Either c b) a
(\/!<) a f b = Lens get' put' create'
    where get' = get f \/ (a!)
          put' = (inl \/ coswap) . (id -|- (snd -|- create f . fst)) . (put f -|- (((==a) . fst)?)) . distr
          create' =  (create f -|- (b!)). ((==a)?)

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

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

-- * Point-free isomorphism combinators

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

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

-- | 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