module Control.Monad.MultiPass.Instrument.Counter
( Counter
, peek, addk, incr, preIncr, postIncr
)
where
import Control.Monad ( void )
import Control.Monad.MultiPass
import Control.Monad.MultiPass.ThreadContext.CounterTC
data Counter i r w (p1 :: * -> *) p2 tc
= Counter
{ peekInternal :: !(MultiPass r w tc (p2 i))
, addkInternal :: !(p1 i -> MultiPass r w tc ())
}
peek
:: (Num i, Monad p1, Monad p2)
=> Counter i r w p1 p2 tc
-> MultiPass r w tc (p2 i)
peek =
peekInternal
addk
:: (Num i, Monad p1, Monad p2)
=> Counter i r w p1 p2 tc
-> p1 i
-> MultiPass r w tc ()
addk =
addkInternal
incr
:: (Num i, Monad p1, Monad p2)
=> Counter i r w p1 p2 tc
-> MultiPass r w tc ()
incr c = addk c (return 1)
preIncr
:: (Num i, Monad p1, Monad p2)
=> Counter i r w p1 p2 tc
-> MultiPass r w tc (p2 i)
preIncr c =
do incr c
peek c
postIncr
:: (Num i, Monad p1, Monad p2)
=> Counter i r w p1 p2 tc
-> MultiPass r w tc (p2 i)
postIncr c =
do v <- peek c
incr c
return v
instance Instrument tc () () (Counter i r w Off Off tc) where
createInstrument _ _ () =
wrapInstrument $ Counter
{ peekInternal = return Off
, addkInternal = \Off -> return ()
}
instance Num i =>
Instrument tc (CounterTC1 i r) ()
(Counter i r w On Off tc) where
createInstrument _ updateCtx () =
wrapInstrument $ Counter
{ peekInternal = return Off
, addkInternal = \(On k) ->
void $ mkMultiPass $ updateCtx $ addkCounterTC1 k
}
instance Num i =>
Instrument tc (CounterTC2 i r) ()
(Counter i r w On On tc) where
createInstrument _ updateCtx () =
wrapInstrument $ Counter
{ peekInternal =
mkMultiPass $
do counter <- updateCtx id
return (On (counterVal2 counter))
, addkInternal = \(On k) ->
void $ mkMultiPass $ updateCtx $ addkCounterTC2 k
}