module Generics.Pointless.Lenses.Combinators where
import Generics.Pointless.Lenses
import Generics.Pointless.Combinators
import Generics.Pointless.Functors
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
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
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)
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
fst_lns :: b -> Lens (a,b) a
fst_lns b = Lens get' put' create'
where get' = fst
put' = id >< snd
create' = id /\ (b!)
snd_lns :: a -> Lens (a,b) b
snd_lns a = Lens get' put' create'
where get' = snd
put' = swap . (id >< fst)
create' = (a!) /\ id
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
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
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
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
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
infix 0 !<
(!<) :: c -> Lens c One
(!<) c = Lens get' put' create'
where get' = bang
put' = snd
create' = (c!)
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
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
id_lns :: Lens c c
id_lns = Lens id fst id
distp :: ((c,d),(a,b)) -> ((c,a),(d,b))
distp = fst >< fst /\ snd >< snd
distp_lns :: Lens ((c,d),(a,b)) ((c,a),(d,b))
distp_lns = Lens distp (distp . fst) distp
dists :: (Either a b,Either c d) -> Either (Either (a,c) (a,d)) (Either (b,c) (b,d))
dists = (distr -|- distr) . distl
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
swap_lns :: Lens (a,b) (b,a)
swap_lns = Lens swap (swap . fst) swap
coswap_lns :: Lens (Either a b) (Either b a)
coswap_lns = Lens coswap (coswap . fst) coswap
distl_lns :: Lens (Either a b, c) (Either (a,c) (b,c))
distl_lns = Lens distl (undistl . fst) undistl
undistl_lns :: Lens (Either (a,c) (b,c)) (Either a b, c)
undistl_lns = Lens undistl (distl . fst) distl
distr_lns :: Lens (c, Either a b) (Either (c,a) (c,b))
distr_lns = Lens distr (undistr . fst) undistr
undistr_lns :: Lens (Either (c,a) (c,b)) (c, Either a b)
undistr_lns = Lens undistr (distr . fst) distr
assocl_lns :: Lens (a,(b,c)) ((a,b),c)
assocl_lns = Lens assocl (assocr . fst) assocr
assocr_lns :: Lens ((a,b),c) (a,(b,c))
assocr_lns = Lens assocr (assocl . fst) assocl
coassocl_lns :: Lens (Either a (Either b c)) (Either (Either a b) c)
coassocl_lns = Lens coassocl (coassocr . fst) coassocr
coassocr_lns :: Lens (Either (Either a b) c) (Either a (Either b c))
coassocr_lns = Lens coassocr (coassocl . fst) coassocl