module Control.Reference.Operators where
import Control.Reference.Representation
import Control.Applicative
import Control.Monad.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.List
turn :: Reference w r w' r' s t a b -> Reference w' r' w r a b s t
turn (Reference refGet refSet refUpdate refGet' refSet' refUpdate')
= (Reference refGet' refSet' refUpdate' refGet refSet refUpdate)
review :: Reference MU MU Identity Identity s t a b -> a -> s
review r a = a ^. turn r
(^#) :: RefMonads w r => s -> Reference w r w' r' s t a b -> r a
a ^# l = refGet l return a
infixl 4 ^#
(^.) :: s -> Lens' s t a b -> a
a ^. l = runIdentity (a ^# l)
infixl 4 ^.
(^?) :: s -> Partial' s t a b -> Maybe a
a ^? l = a ^# l
infixl 4 ^?
(^*) :: s -> Traversal' s t a b -> [a]
a ^* l = a ^# l
infixl 4 ^*
(^!) :: s -> IOLens' s t a b -> IO a
a ^! l = a ^# l
infixl 4 ^!
(^?!) :: s -> IOPartial' s t a b -> IO (Maybe a)
a ^?! l = runMaybeT (a ^# l)
infixl 4 ^?!
(^*!) :: s -> IOTraversal' s t a b -> IO [a]
a ^*! l = runListT (a ^# l)
infixl 4 ^*!
(#=) :: Reference w r w' r' s t a b -> b -> s -> w t
l #= v = refSet l v
infixl 4 #=
(.=) :: Lens' s t a b -> b -> s -> t
l .= v = runIdentity . (l #= v)
infixl 4 .=
(?=) :: Partial' s t a b -> b -> s -> t
l ?= v = runIdentity . (l #= v)
infixl 4 ?=
(*=) :: Traversal' s t a b -> b -> s -> t
l *= v = runIdentity . (l #= v)
infixl 4 *=
(!=) :: IOLens' s t a b -> b -> s -> IO t
l != v = l #= v
infixl 4 !=
(?!=) :: IOPartial' s t a b -> b -> s -> IO t
l ?!= v = l #= v
infixl 4 ?!=
(*!=) :: IOTraversal' s t a b -> b -> s -> IO t
l *!= v = l #= v
infixl 4 *!=
(#~) :: Reference w r w' r' s t a b -> (a -> w b) -> s -> w t
l #~ trf = refUpdate l trf
infixl 4 #~
(.~) :: Lens' s t a b -> (a -> Identity b) -> s -> t
l .~ trf = runIdentity . (l #~ trf)
infixl 4 .~
(?~) :: Partial' s t a b -> (a -> Identity b) -> s -> t
l ?~ trf = runIdentity . (l #~ trf)
infixl 4 ?~
(*~) :: Traversal' s t a b -> (a -> Identity b) -> s -> t
l *~ trf = runIdentity . (l #~ trf)
infixl 4 *~
(!~) :: IOLens' s t a b -> (a -> IO b) -> s -> IO t
l !~ trf = l #~ trf
infixl 4 !~
(?!~) :: IOPartial' s t a b -> (a -> IO b) -> s -> IO t
l ?!~ trf = l #~ trf
infixl 4 ?!~
(*!~) :: IOTraversal' s t a b -> (a -> IO b) -> s -> IO t
l *!~ trf = l #~ trf
infixl 4 *!~
(#-) :: Monad w => Reference w r w' r' s t a b -> (a -> b) -> s -> w t
l #- trf = l #~ return . trf
infixl 4 #-
(.-) :: Lens' s t a b -> (a -> b) -> s -> t
l .- trf = l .~ return . trf
infixl 4 .-
(?-) :: Partial' s t a b -> (a -> b) -> s -> t
l ?- trf = l ?~ return . trf
infixl 4 ?-
(*-) :: Traversal' s t a b -> (a -> b) -> s -> t
l *- trf = l *~ return . trf
infixl 4 *-
(!-) :: IOLens' s t a b -> (a -> b) -> s -> IO t
l !- trf = l !~ return . trf
infixl 4 !-
(?!-) :: IOPartial' s t a b -> (a -> b) -> s -> IO t
l ?!- trf = l ?!~ return . trf
infixl 4 ?!-
(*!-) :: IOTraversal' s t a b -> (a -> b) -> s -> IO t
l *!- trf = l *!~ return . trf
infixl 4 *!-
(#|) :: Monad w => Reference w r w' r' s s a a -> (a -> w x) -> s -> w s
l #| act = l #~ (\v -> act v >> return v)
infixl 4 #|
(!|) :: IOLens' s s a a -> (a -> IO c) -> s -> IO s
l !| act = l #| act
infixl 4 !|
(?!|) :: IOPartial' s s a a -> (a -> IO c) -> s -> IO s
l ?!| act = l #| act
infixl 4 ?!|
(*!|) :: IOTraversal' s s a a -> (a -> IO c) -> s -> IO s
l *!| act = l #| act
infixl 4 *!|
(&) :: (Monad w, Monad r) => Reference w r w' r' s t c d -> Reference w r w' r' c d a b
-> Reference w r w' r' s t a b
(&) l1 l2 = Reference (refGet l1 . refGet l2)
(refUpdate l1 . refSet l2)
(refUpdate l1 . refUpdate l2)
(refGet' l2 . refGet' l1)
(refUpdate' l2 . refSet' l1)
(refUpdate' l2 . refUpdate' l1)
infixl 6 &
(&+&) :: (RefMonads w r, RefMonads w' r', MonadPlus r, MonadPlus r', MMorph [] r)
=> Reference w r w' r' s s a a -> Reference w r w' r' s s a a
-> Reference w r w' r' s s a a
l1 &+& l2 = Reference (\f a -> refGet l1 f a `mplus` refGet l2 f a)
(\v -> refSet l1 v >=> refSet l2 v )
(\trf -> refUpdate l1 trf
>=> refUpdate l2 trf )
(\f a -> refGet' l1 f a `mplus` refGet' l2 f a)
(\v -> refSet' l1 v >=> refSet' l2 v )
(\trf -> refUpdate' l1 trf
>=> refUpdate' l2 trf )
infixl 5 &+&
(&|&) :: (RefMonads m m')
=> Reference m m m' m' s t a b -> Reference m m m' m' s' t' a' b'
-> Reference m m m' m' (s, s') (t, t') (a, a') (b, b')
r1 &|& r2 = Reference (\f (s1,s2) -> ((,) <$> refGet r1 return s1 <*> refGet r2 return s2) >>= f)
(\(b1,b2) (s1,s2) -> (,) <$> refSet r1 b1 s1 <*> refSet r2 b2 s2)
(\f (s1,s2) -> do a1 <- refGet r1 return s1
a2 <- refGet r2 return s2
t1 <- refUpdate r1 (liftM fst . flip (curry f) a2) s1
t2 <- refUpdate r2 (liftM snd . curry f a1) s2
return (t1, t2) )
(\f (s1,s2) -> ((,) <$> refGet' r1 return s1 <*> refGet' r2 return s2) >>= f)
(\(b1,b2) (s1,s2) -> (,) <$> refSet' r1 b1 s1 <*> refSet' r2 b2 s2)
(\f (s1,s2) -> do a1 <- refGet' r1 return s1
a2 <- refGet' r2 return s2
t1 <- refUpdate' r1 (liftM fst . flip (curry f) a2) s1
t2 <- refUpdate' r2 (liftM snd . curry f a1) s2
return (t1, t2) )
infixl 5 &|&