Skip to content

Instantly share code, notes, and snippets.

@arkeet
Created December 15, 2012 14:21
Show Gist options
  • Save arkeet/4295507 to your computer and use it in GitHub Desktop.
Save arkeet/4295507 to your computer and use it in GitHub Desktop.
Lens operators for monads. This is really awful.
import Control.Lens
import Control.Lens.Classes
import Control.Lens.Internal
import Control.Monad.Reader
import Control.Monad.State
import Data.IORef
-- I'm not sure what "something" is supposed to be.
-- The second argument to x is a total hack.
mviews :: Monad m
=> ((a -> Accessor r b) -> (s -> Accessor r t))
-> (a -> r)
-> ((s -> Accessor r t) -> (something -> something) -> m (Accessor r u))
-> m r
mviews l f x = liftM runAccessor $ x (l (Accessor . f)) id
mview :: Monad m
=> ((a -> Accessor a b) -> (s -> Accessor a t))
-> ((s -> Accessor a t) -> (something -> something) -> m (Accessor a u))
-> m a
mview l x = mviews l id x
mover :: Monad m
=> ((a -> Mutator b) -> (s -> Mutator t))
-> (a -> b)
-> ((s -> Mutator t) -> (s -> t) -> m (Mutator u)) -> m u
mover l f x = liftM runMutator $
x (l (Mutator . f)) (runMutator . fmap (over l f) . Mutator)
infixr 4 >%~
(>%~) = mover
infixl 8 >^.
(>^.) = flip mview
returnL :: (Monad m, Functor f) => s -> (s -> f t) -> something -> m (f t)
returnL a k l = return (k a)
stateL :: (MonadState s m, Functor f) => (s -> f s) -> (s -> s) -> m (f ())
stateL k l = state $ \s -> (fmap (const ()) (k s), l s)
readerL :: (MonadReader s m, Gettable f) => (s -> f t) -> something -> m (f u)
readerL k l = reader $ \r -> coerce (k r)
iorefL :: (Functor f) => IORef s -> (s -> f s) -> (s -> s) -> IO (f ())
iorefL ref k l = atomicModifyIORef ref $ \s -> (l s, fmap (const ()) (k s))
testReturn = do
x <- returnL (0,'a') >^. _1
y <- returnL (0,'a') & _2 >%~ succ
return (x,y)
-- (0,(0,'b'))
testReader = flip runReader 0 $ do
x <- mview id readerL
return x
-- 0
testState = flip runState (0,0) $ do
x <- stateL >^. _1
y <- stateL >^. _2
stateL & _2 >%~ (+2)
z <- stateL >^. _2
return (x,y,z)
-- ((0,0,2),(0,2))
testIORef = do
ref <- newIORef 0
x <- iorefL ref >^. id
iorefL ref & id >%~ (+2)
y <- iorefL ref >^. id
return (x,y)
-- (0,2)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment