module Focus where
import Focus.Prelude hiding (delete, insert, lookup)
data Focus element m result = Focus (m (result, Change element)) (element -> m (result, Change element))
deriving instance (Functor m) => Functor (Focus element m)
instance (Monad m) => Applicative (Focus element m) where
pure :: forall a. a -> Focus element m a
pure a
a = forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus (forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, forall a. Change a
Leave)) (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, forall a. Change a
Leave)))
<*> :: forall a b.
Focus element m (a -> b) -> Focus element m a -> Focus element m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance (Monad m) => Monad (Focus element m) where
return :: forall a. a -> Focus element m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
>>= :: forall a b.
Focus element m a -> (a -> Focus element m b) -> Focus element m b
(>>=) (Focus m (a, Change element)
lAbsent element -> m (a, Change element)
lPresent) a -> Focus element m b
rk =
forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus m (b, Change element)
absent element -> m (b, Change element)
present
where
absent :: m (b, Change element)
absent =
do
(a
lr, Change element
lChange) <- m (a, Change element)
lAbsent
let Focus m (b, Change element)
rAbsent element -> m (b, Change element)
rPresent = a -> Focus element m b
rk a
lr
case Change element
lChange of
Change element
Leave -> m (b, Change element)
rAbsent
Change element
Remove -> m (b, Change element)
rAbsent forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend Change element
lChange))
Set element
newElement -> element -> m (b, Change element)
rPresent element
newElement forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend Change element
lChange))
present :: element -> m (b, Change element)
present element
element =
do
(a
lr, Change element
lChange) <- element -> m (a, Change element)
lPresent element
element
let Focus m (b, Change element)
rAbsent element -> m (b, Change element)
rPresent = a -> Focus element m b
rk a
lr
case Change element
lChange of
Change element
Leave -> element -> m (b, Change element)
rPresent element
element
Change element
Remove -> m (b, Change element)
rAbsent forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend Change element
lChange))
Set element
newElement -> element -> m (b, Change element)
rPresent element
newElement forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => a -> a -> a
mappend Change element
lChange))
instance MonadTrans (Focus element) where
lift :: forall (m :: * -> *) a. Monad m => m a -> Focus element m a
lift m a
m = forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,forall a. Change a
Leave) m a
m) (forall a b. a -> b -> a
const (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,forall a. Change a
Leave) m a
m))
data Change a
=
Leave
|
Remove
|
Set a
deriving (forall a b. a -> Change b -> Change a
forall a b. (a -> b) -> Change a -> Change b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Change b -> Change a
$c<$ :: forall a b. a -> Change b -> Change a
fmap :: forall a b. (a -> b) -> Change a -> Change b
$cfmap :: forall a b. (a -> b) -> Change a -> Change b
Functor, Change a -> Change a -> Bool
forall a. Eq a => Change a -> Change a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Change a -> Change a -> Bool
$c/= :: forall a. Eq a => Change a -> Change a -> Bool
== :: Change a -> Change a -> Bool
$c== :: forall a. Eq a => Change a -> Change a -> Bool
Eq, Change a -> Change a -> Bool
Change a -> Change a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Change a)
forall a. Ord a => Change a -> Change a -> Bool
forall a. Ord a => Change a -> Change a -> Ordering
forall a. Ord a => Change a -> Change a -> Change a
min :: Change a -> Change a -> Change a
$cmin :: forall a. Ord a => Change a -> Change a -> Change a
max :: Change a -> Change a -> Change a
$cmax :: forall a. Ord a => Change a -> Change a -> Change a
>= :: Change a -> Change a -> Bool
$c>= :: forall a. Ord a => Change a -> Change a -> Bool
> :: Change a -> Change a -> Bool
$c> :: forall a. Ord a => Change a -> Change a -> Bool
<= :: Change a -> Change a -> Bool
$c<= :: forall a. Ord a => Change a -> Change a -> Bool
< :: Change a -> Change a -> Bool
$c< :: forall a. Ord a => Change a -> Change a -> Bool
compare :: Change a -> Change a -> Ordering
$ccompare :: forall a. Ord a => Change a -> Change a -> Ordering
Ord, Int -> Change a -> ShowS
forall a. Show a => Int -> Change a -> ShowS
forall a. Show a => [Change a] -> ShowS
forall a. Show a => Change a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Change a] -> ShowS
$cshowList :: forall a. Show a => [Change a] -> ShowS
show :: Change a -> String
$cshow :: forall a. Show a => Change a -> String
showsPrec :: Int -> Change a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Change a -> ShowS
Show)
instance Semigroup (Change a) where
<> :: Change a -> Change a -> Change a
(<>) Change a
l Change a
r =
case Change a
r of
Change a
Leave -> Change a
l
Change a
_ -> Change a
r
instance Monoid (Change a) where
mempty :: Change a
mempty = forall a. Change a
Leave
{-# INLINE member #-}
member :: (Monad m) => Focus a m Bool
member :: forall (m :: * -> *) a. Monad m => Focus a m Bool
member = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a b. a -> b -> a
const Bool
True)) forall (m :: * -> *) a. Monad m => Focus a m (Maybe a)
lookup
{-# INLINE [1] lookup #-}
lookup :: (Monad m) => Focus a m (Maybe a)
lookup :: forall (m :: * -> *) a. Monad m => Focus a m (Maybe a)
lookup = forall (m :: * -> *) b a.
Monad m =>
(b, Change a) -> (a -> (b, Change a)) -> Focus a m b
cases (forall a. Maybe a
Nothing, forall a. Change a
Leave) (\a
a -> (forall a. a -> Maybe a
Just a
a, forall a. Change a
Leave))
{-# INLINE [1] lookupWithDefault #-}
lookupWithDefault :: (Monad m) => a -> Focus a m a
lookupWithDefault :: forall (m :: * -> *) a. Monad m => a -> Focus a m a
lookupWithDefault a
a = forall (m :: * -> *) b a.
Monad m =>
(b, Change a) -> (a -> (b, Change a)) -> Focus a m b
cases (a
a, forall a. Change a
Leave) (\a
a -> (a
a, forall a. Change a
Leave))
{-# INLINE [1] delete #-}
delete :: (Monad m) => Focus a m ()
delete :: forall (m :: * -> *) a. Monad m => Focus a m ()
delete = forall (m :: * -> *) a.
Monad m =>
Change a -> (a -> Change a) -> Focus a m ()
unitCases forall a. Change a
Leave (forall a b. a -> b -> a
const forall a. Change a
Remove)
{-# RULES
"lookup <* delete" [~1] lookup <* delete = lookupAndDelete
#-}
{-# INLINE lookupAndDelete #-}
lookupAndDelete :: (Monad m) => Focus a m (Maybe a)
lookupAndDelete :: forall (m :: * -> *) a. Monad m => Focus a m (Maybe a)
lookupAndDelete = forall (m :: * -> *) b a.
Monad m =>
(b, Change a) -> (a -> (b, Change a)) -> Focus a m b
cases (forall a. Maybe a
Nothing, forall a. Change a
Leave) (\a
element -> (forall a. a -> Maybe a
Just a
element, forall a. Change a
Remove))
{-# INLINE insert #-}
insert :: (Monad m) => a -> Focus a m ()
insert :: forall (m :: * -> *) a. Monad m => a -> Focus a m ()
insert a
a = forall (m :: * -> *) a.
Monad m =>
Change a -> (a -> Change a) -> Focus a m ()
unitCases (forall a. a -> Change a
Set a
a) (forall a b. a -> b -> a
const (forall a. a -> Change a
Set a
a))
{-# INLINE insertOrMerge #-}
insertOrMerge :: (Monad m) => (a -> a -> a) -> a -> Focus a m ()
insertOrMerge :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> a -> Focus a m ()
insertOrMerge a -> a -> a
merge a
value = forall (m :: * -> *) a.
Monad m =>
Change a -> (a -> Change a) -> Focus a m ()
unitCases (forall a. a -> Change a
Set a
value) (forall a. a -> Change a
Set forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a -> a
merge a
value)
{-# INLINE alter #-}
alter :: (Monad m) => (Maybe a -> Maybe a) -> Focus a m ()
alter :: forall (m :: * -> *) a.
Monad m =>
(Maybe a -> Maybe a) -> Focus a m ()
alter Maybe a -> Maybe a
fn = forall (m :: * -> *) a.
Monad m =>
Change a -> (a -> Change a) -> Focus a m ()
unitCases (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Change a
Leave forall a. a -> Change a
Set (Maybe a -> Maybe a
fn forall a. Maybe a
Nothing)) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Change a
Remove forall a. a -> Change a
Set forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe a -> Maybe a
fn forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a
Just)
{-# INLINE adjust #-}
adjust :: (Monad m) => (a -> a) -> Focus a m ()
adjust :: forall (m :: * -> *) a. Monad m => (a -> a) -> Focus a m ()
adjust a -> a
fn = forall (m :: * -> *) a.
Monad m =>
Change a -> (a -> Change a) -> Focus a m ()
unitCases forall a. Change a
Leave (forall a. a -> Change a
Set forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> a
fn)
{-# INLINE update #-}
update :: (Monad m) => (a -> Maybe a) -> Focus a m ()
update :: forall (m :: * -> *) a. Monad m => (a -> Maybe a) -> Focus a m ()
update a -> Maybe a
fn = forall (m :: * -> *) a.
Monad m =>
Change a -> (a -> Change a) -> Focus a m ()
unitCases forall a. Change a
Leave (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Change a
Remove forall a. a -> Change a
Set forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Maybe a
fn)
accessAndAdjust :: (Monad m) => (s -> a) -> (s -> s) -> Focus s m (Maybe a)
accessAndAdjust :: forall (m :: * -> *) s a.
Monad m =>
(s -> a) -> (s -> s) -> Focus s m (Maybe a)
accessAndAdjust s -> a
f s -> s
g =
forall (m :: * -> *) s a.
Monad m =>
(s -> (a, s)) -> Focus s m (Maybe a)
liftStateFn (s -> a
f forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& s -> s
g)
liftState :: (Monad m) => State s a -> Focus s m (Maybe a)
liftState :: forall (m :: * -> *) s a.
Monad m =>
State s a -> Focus s m (Maybe a)
liftState (StateT s -> Identity (a, s)
fn) =
forall (m :: * -> *) s a.
Monad m =>
(s -> (a, s)) -> Focus s m (Maybe a)
liftStateFn (forall a. Identity a -> a
runIdentity forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. s -> Identity (a, s)
fn)
liftStateFn :: (Monad m) => (s -> (a, s)) -> Focus s m (Maybe a)
liftStateFn :: forall (m :: * -> *) s a.
Monad m =>
(s -> (a, s)) -> Focus s m (Maybe a)
liftStateFn s -> (a, s)
fn =
forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus
(forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall a. Change a
Leave))
(\s
s -> case s -> (a, s)
fn s
s of (a
a, s
s) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a, forall a. a -> Change a
Set s
s))
{-# INLINE cases #-}
cases :: (Monad m) => (b, Change a) -> (a -> (b, Change a)) -> Focus a m b
cases :: forall (m :: * -> *) b a.
Monad m =>
(b, Change a) -> (a -> (b, Change a)) -> Focus a m b
cases (b, Change a)
sendNone a -> (b, Change a)
sendSome = forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus (forall (m :: * -> *) a. Monad m => a -> m a
return (b, Change a)
sendNone) (forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> (b, Change a)
sendSome)
{-# INLINE unitCases #-}
unitCases :: (Monad m) => Change a -> (a -> Change a) -> Focus a m ()
unitCases :: forall (m :: * -> *) a.
Monad m =>
Change a -> (a -> Change a) -> Focus a m ()
unitCases Change a
sendNone a -> Change a
sendSome = forall (m :: * -> *) b a.
Monad m =>
(b, Change a) -> (a -> (b, Change a)) -> Focus a m b
cases ((), Change a
sendNone) (\a
a -> ((), a -> Change a
sendSome a
a))
{-# INLINE [1] lookupWithDefaultM #-}
lookupWithDefaultM :: (Monad m) => m a -> Focus a m a
lookupWithDefaultM :: forall (m :: * -> *) a. Monad m => m a -> Focus a m a
lookupWithDefaultM m a
aM = forall (m :: * -> *) b a.
m (b, Change a) -> (a -> m (b, Change a)) -> Focus a m b
casesM (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) m a
aM (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Change a
Leave)) (\a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, forall a. Change a
Leave))
{-# INLINE insertM #-}
insertM :: (Monad m) => m a -> Focus a m ()
insertM :: forall (m :: * -> *) a. Monad m => m a -> Focus a m ()
insertM m a
aM = forall (m :: * -> *) a.
Monad m =>
m (Change a) -> (a -> m (Change a)) -> Focus a m ()
unitCasesM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Change a
Set m a
aM) (forall a b. a -> b -> a
const (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Change a
Set m a
aM))
{-# INLINE insertOrMergeM #-}
insertOrMergeM :: (Monad m) => (a -> a -> m a) -> m a -> Focus a m ()
insertOrMergeM :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> m a -> Focus a m ()
insertOrMergeM a -> a -> m a
merge m a
aM = forall (m :: * -> *) a.
Monad m =>
m (Change a) -> (a -> m (Change a)) -> Focus a m ()
unitCasesM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Change a
Set m a
aM) (\a
a' -> m a
aM forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Change a
Set (a -> a -> m a
merge a
a a
a'))
{-# INLINE alterM #-}
alterM :: (Monad m) => (Maybe a -> m (Maybe a)) -> Focus a m ()
alterM :: forall (m :: * -> *) a.
Monad m =>
(Maybe a -> m (Maybe a)) -> Focus a m ()
alterM Maybe a -> m (Maybe a)
fn = forall (m :: * -> *) a.
Monad m =>
m (Change a) -> (a -> m (Change a)) -> Focus a m ()
unitCasesM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Change a
Leave forall a. a -> Change a
Set) (Maybe a -> m (Maybe a)
fn forall a. Maybe a
Nothing)) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Change a
Remove forall a. a -> Change a
Set) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe a -> m (Maybe a)
fn forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a
Just)
{-# INLINE adjustM #-}
adjustM :: (Monad m) => (a -> m a) -> Focus a m ()
adjustM :: forall (m :: * -> *) a. Monad m => (a -> m a) -> Focus a m ()
adjustM a -> m a
fn = forall (m :: * -> *) a.
Monad m =>
(a -> m (Maybe a)) -> Focus a m ()
updateM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> m a
fn)
{-# INLINE updateM #-}
updateM :: (Monad m) => (a -> m (Maybe a)) -> Focus a m ()
updateM :: forall (m :: * -> *) a.
Monad m =>
(a -> m (Maybe a)) -> Focus a m ()
updateM a -> m (Maybe a)
fn = forall (m :: * -> *) a.
Monad m =>
m (Change a) -> (a -> m (Change a)) -> Focus a m ()
unitCasesM (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Change a
Leave) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Change a
Remove forall a. a -> Change a
Set) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> m (Maybe a)
fn)
{-# INLINE casesM #-}
casesM :: m (b, Change a) -> (a -> m (b, Change a)) -> Focus a m b
casesM :: forall (m :: * -> *) b a.
m (b, Change a) -> (a -> m (b, Change a)) -> Focus a m b
casesM m (b, Change a)
sendNone a -> m (b, Change a)
sendSome = forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus m (b, Change a)
sendNone a -> m (b, Change a)
sendSome
{-# INLINE unitCasesM #-}
unitCasesM :: (Monad m) => m (Change a) -> (a -> m (Change a)) -> Focus a m ()
unitCasesM :: forall (m :: * -> *) a.
Monad m =>
m (Change a) -> (a -> m (Change a)) -> Focus a m ()
unitCasesM m (Change a)
sendNone a -> m (Change a)
sendSome = forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((),) m (Change a)
sendNone) (\a
a -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((),) (a -> m (Change a)
sendSome a
a))
{-# INLINE mappingInput #-}
mappingInput :: (Monad m) => (a -> b) -> (b -> a) -> Focus a m x -> Focus b m x
mappingInput :: forall (m :: * -> *) a b x.
Monad m =>
(a -> b) -> (b -> a) -> Focus a m x -> Focus b m x
mappingInput a -> b
aToB b -> a
bToA (Focus m (x, Change a)
consealA a -> m (x, Change a)
revealA) = forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus m (x, Change b)
consealB b -> m (x, Change b)
revealB
where
consealB :: m (x, Change b)
consealB = do
(x
x, Change a
aChange) <- m (x, Change a)
consealA
forall (m :: * -> *) a. Monad m => a -> m a
return (x
x, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
aToB Change a
aChange)
revealB :: b -> m (x, Change b)
revealB b
b = do
(x
x, Change a
aChange) <- a -> m (x, Change a)
revealA (b -> a
bToA b
b)
forall (m :: * -> *) a. Monad m => a -> m a
return (x
x, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
aToB Change a
aChange)
{-# INLINE extractingInput #-}
extractingInput :: (Monad m) => Focus a m b -> Focus a m (b, Maybe a)
(Focus m (b, Change a)
absent a -> m (b, Change a)
present) =
forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus m ((b, Maybe a), Change a)
newAbsent a -> m ((b, Maybe a), Change a)
newPresent
where
newAbsent :: m ((b, Maybe a), Change a)
newAbsent = do
(b
b, Change a
change) <- m (b, Change a)
absent
forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, forall a. Maybe a
Nothing), Change a
change)
newPresent :: a -> m ((b, Maybe a), Change a)
newPresent a
element = do
(b
b, Change a
change) <- a -> m (b, Change a)
present a
element
forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, forall a. a -> Maybe a
Just a
element), Change a
change)
{-# INLINE extractingChange #-}
extractingChange :: (Monad m) => Focus a m b -> Focus a m (b, Change a)
(Focus m (b, Change a)
absent a -> m (b, Change a)
present) =
forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus m ((b, Change a), Change a)
newAbsent a -> m ((b, Change a), Change a)
newPresent
where
newAbsent :: m ((b, Change a), Change a)
newAbsent = do
(b
b, Change a
change) <- m (b, Change a)
absent
forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, Change a
change), Change a
change)
newPresent :: a -> m ((b, Change a), Change a)
newPresent a
element = do
(b
b, Change a
change) <- a -> m (b, Change a)
present a
element
forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, Change a
change), Change a
change)
{-# INLINE projectingChange #-}
projectingChange :: (Monad m) => (Change a -> c) -> Focus a m b -> Focus a m (b, c)
projectingChange :: forall (m :: * -> *) a c b.
Monad m =>
(Change a -> c) -> Focus a m b -> Focus a m (b, c)
projectingChange Change a -> c
fn (Focus m (b, Change a)
absent a -> m (b, Change a)
present) =
forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus m ((b, c), Change a)
newAbsent a -> m ((b, c), Change a)
newPresent
where
newAbsent :: m ((b, c), Change a)
newAbsent = do
(b
b, Change a
change) <- m (b, Change a)
absent
forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, Change a -> c
fn Change a
change), Change a
change)
newPresent :: a -> m ((b, c), Change a)
newPresent a
element = do
(b
b, Change a
change) <- a -> m (b, Change a)
present a
element
forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, Change a -> c
fn Change a
change), Change a
change)
{-# INLINE testingIfModifies #-}
testingIfModifies :: (Monad m) => Focus a m b -> Focus a m (b, Bool)
testingIfModifies :: forall (m :: * -> *) a b.
Monad m =>
Focus a m b -> Focus a m (b, Bool)
testingIfModifies =
forall (m :: * -> *) a c b.
Monad m =>
(Change a -> c) -> Focus a m b -> Focus a m (b, c)
projectingChange forall a b. (a -> b) -> a -> b
$ \case
Change a
Leave -> Bool
False
Change a
_ -> Bool
True
{-# INLINE testingIfRemoves #-}
testingIfRemoves :: (Monad m) => Focus a m b -> Focus a m (b, Bool)
testingIfRemoves :: forall (m :: * -> *) a b.
Monad m =>
Focus a m b -> Focus a m (b, Bool)
testingIfRemoves =
forall (m :: * -> *) a c b.
Monad m =>
(Change a -> c) -> Focus a m b -> Focus a m (b, c)
projectingChange forall a b. (a -> b) -> a -> b
$ \case
Change a
Remove -> Bool
True
Change a
_ -> Bool
False
{-# INLINE testingIfInserts #-}
testingIfInserts :: (Monad m) => Focus a m b -> Focus a m (b, Bool)
testingIfInserts :: forall (m :: * -> *) a b.
Monad m =>
Focus a m b -> Focus a m (b, Bool)
testingIfInserts (Focus m (b, Change a)
absent a -> m (b, Change a)
present) =
forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus m ((b, Bool), Change a)
newAbsent a -> m ((b, Bool), Change a)
newPresent
where
newAbsent :: m ((b, Bool), Change a)
newAbsent = do
(b
output, Change a
change) <- m (b, Change a)
absent
let testResult :: Bool
testResult = case Change a
change of
Set a
_ -> Bool
True
Change a
_ -> Bool
False
in forall (m :: * -> *) a. Monad m => a -> m a
return ((b
output, Bool
testResult), Change a
change)
newPresent :: a -> m ((b, Bool), Change a)
newPresent a
element = do
(b
output, Change a
change) <- a -> m (b, Change a)
present a
element
forall (m :: * -> *) a. Monad m => a -> m a
return ((b
output, Bool
False), Change a
change)
{-# INLINE testingSizeChange #-}
testingSizeChange ::
(Monad m) =>
sizeChange ->
sizeChange ->
sizeChange ->
Focus a m b ->
Focus a m (b, sizeChange)
testingSizeChange :: forall (m :: * -> *) sizeChange a b.
Monad m =>
sizeChange
-> sizeChange
-> sizeChange
-> Focus a m b
-> Focus a m (b, sizeChange)
testingSizeChange sizeChange
dec sizeChange
none sizeChange
inc (Focus m (b, Change a)
absent a -> m (b, Change a)
present) =
forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus m ((b, sizeChange), Change a)
newAbsent a -> m ((b, sizeChange), Change a)
newPresent
where
newAbsent :: m ((b, sizeChange), Change a)
newAbsent = do
(b
output, Change a
change) <- m (b, Change a)
absent
let sizeChange :: sizeChange
sizeChange = case Change a
change of
Set a
_ -> sizeChange
inc
Change a
_ -> sizeChange
none
in forall (m :: * -> *) a. Monad m => a -> m a
return ((b
output, sizeChange
sizeChange), Change a
change)
newPresent :: a -> m ((b, sizeChange), Change a)
newPresent a
element = do
(b
output, Change a
change) <- a -> m (b, Change a)
present a
element
let sizeChange :: sizeChange
sizeChange = case Change a
change of
Change a
Remove -> sizeChange
dec
Change a
_ -> sizeChange
none
in forall (m :: * -> *) a. Monad m => a -> m a
return ((b
output, sizeChange
sizeChange), Change a
change)
{-# INLINE onTVarValue #-}
onTVarValue :: Focus a STM b -> Focus (TVar a) STM b
onTVarValue :: forall a b. Focus a STM b -> Focus (TVar a) STM b
onTVarValue (Focus STM (b, Change a)
concealA a -> STM (b, Change a)
presentA) = forall element (m :: * -> *) result.
m (result, Change element)
-> (element -> m (result, Change element))
-> Focus element m result
Focus STM (b, Change (TVar a))
concealTVar TVar a -> STM (b, Change (TVar a))
presentTVar
where
concealTVar :: STM (b, Change (TVar a))
concealTVar = STM (b, Change a)
concealA forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {a}. Change a -> STM (Change (TVar a))
interpretAChange
where
interpretAChange :: Change a -> STM (Change (TVar a))
interpretAChange = \case
Change a
Leave -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Change a
Leave
Set !a
a -> forall a. a -> Change a
Set forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> STM (TVar a)
newTVar a
a
Change a
Remove -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Change a
Leave
presentTVar :: TVar a -> STM (b, Change (TVar a))
presentTVar TVar a
var = forall a. TVar a -> STM a
readTVar TVar a
var forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> STM (b, Change a)
presentA forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Change a -> STM (Change (TVar a))
interpretAChange
where
interpretAChange :: Change a -> STM (Change (TVar a))
interpretAChange = \case
Change a
Leave -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Change a
Leave
Set !a
a -> forall a. TVar a -> a -> STM ()
writeTVar TVar a
var a
a forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Change a
Leave
Change a
Remove -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Change a
Remove