module Proton.Achromatic where

import Data.Profunctor
import Data.Profunctor.Strong
import Proton.Lens

achrom :: forall s t a b
       . (s -> Maybe (b -> t))
       -> (s -> a)
       -> (b -> t)
       -> Lens s t a b
achrom :: (s -> Maybe (b -> t)) -> (s -> a) -> (b -> t) -> Lens s t a b
achrom try :: s -> Maybe (b -> t)
try proj :: s -> a
proj rev :: b -> t
rev p :: p a b
p = (s -> b -> t) -> p s b -> p s t
forall (p :: * -> * -> *) a b c.
Strong p =>
(a -> b -> c) -> p a b -> p a c
strong s -> b -> t
go (p s b -> p s t) -> p s b -> p s t
forall a b. (a -> b) -> a -> b
$ (s -> a) -> p a b -> p s b
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap s -> a
proj p a b
p
  where
    go :: s -> b -> t
    go :: s -> b -> t
go s :: s
s b :: b
b = case s -> Maybe (b -> t)
try s
s of
        Nothing -> b -> t
rev b
b
        Just f :: b -> t
f -> b -> t
f b
b