Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Optics via fused-effects
{-# LANGUAGE RankNTypes #-}
module Optics where
import Control.Category ((>>>))
import qualified Control.Category as Cat
import Control.Effect.Empty
import Control.Effect.NonDet hiding (empty)
import Control.Monad ((<=<))
-- riffing off of @serras’s post https://gist.github.com/serras/5152ec18ec5223b676cc67cac0e99b70
-- we use fused-effects to describe varieties of optic & their relationships to one another via effect constraints
data Optic m s a = Optic { get :: s -> m a, set :: (a -> a) -> (s -> s) }
instance Monad m => Cat.Category (Optic m) where
id = Optic pure id
Optic get1 set1 . Optic get2 set2 = Optic (get1 <=< get2) (set2 . set1)
type Lens s a = forall m . Applicative m => Optic m s a
lens :: (s -> a) -> (s -> a -> s) -> Lens s a
lens from to = Optic (pure . from) (\ aa s -> to s (aa (from s)))
_1 :: Lens (a, b) a
_1 = lens fst (\ ~(_, b) a -> (a, b))
_2 :: Lens (a, b) b
_2 = lens snd (\ ~(a, _) b -> (a, b))
type Prism s a = forall sig m . Has Empty sig m => Optic m s a
prism :: (a -> s) -> (s -> Maybe a) -> Prism s a
-- it feels weird that set is partial; it feels weird that it even receives an s to begin with!
-- but, it appears to work?
prism to from = Optic (maybe empty pure . from) (\ aa s -> maybe s (to . aa) (from s))
_Left :: Prism (Either a b) a
_Left = prism Left (\case{ Left a -> pure a ; _ -> empty })
_Right :: Prism (Either a b) b
_Right = prism Right (\case{ Right a -> pure a ; _ -> empty })
type Traversal s a = forall sig m . Has NonDet sig m => Optic m s a -- is this right? who knows!
-- whether or not it’s exactly what we mean, it’s cool that composing a Traversal and a Prism gets you a Traversal
-- it’s a little weird that composing a lens and a prism gets you … a prism? this seems to be a consequence of the setter receiving the whole and projecting the partial value out of it before updating
x :: Prism (Either c b, a) c
x = _1 >>> _Left
y, z :: (Either Char (), Int)
y = (Left 'y', 0)
z = (Right (), 1)
test1 :: Maybe Char
test1 = y & get x
-- Just 'y'
test2 :: Maybe Char
test2 = z & get x
-- Nothing
test3 :: (Either Char (), Int)
test3 = y & set (x :: Optic Maybe (Either c b, a) c) (const '3') -- have to annotate the type here or the signature is ambiguous, because set doesn’t use m
-- ( Left '3'
-- , 0
-- )
test4 :: (Either Char (), Int)
test4 = z & set (x :: Optic Maybe (Either c b, a) c) (const '4') -- have to annotate the type here or the signature is ambiguous, because set doesn’t use m
-- ( Right ()
-- , 1
-- )
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment