Lens.hs

{-# LANGUAGE RankNTypes #-}

import Control.Lens hiding (lens)
import qualified Control.Lens as L (lens)
import Data.Bifunctor
import Data.Functor.Alt


------------------------------------------------------------------------------
split
    :: APrism s t a b
    -> APrism s t a' b'
    -> Prism s t (Either a a') (Either b b')
split p p' = withPrism p $ \build parse -> withPrism p' $ \build' parse' ->
    prism
        (either build build')
        (\a -> Left <$> parse a <!> Right <$> parse' a)


------------------------------------------------------------------------------
join
    :: ALens s t a b
    -> ALens s' t' a b
    -> Lens (Either s s') (Either t t') a b
join l l' = withLens l $ \get put -> withLens l' $ \get' put' ->
    lens (either get get') (bimap <$> put <*> put')


------------------------------------------------------------------------------
withLens :: ALens s t a b -> ((s -> a) -> (b -> s -> t) -> r) -> r
withLens l f = f (flip (^#) l) (storing l)
{-# INLINE withLens #-}


------------------------------------------------------------------------------
lens :: (s -> a) -> (b -> s -> t) -> Lens s t a b
lens get set = L.lens get (flip set)
{-# INLINE lens #-}