module Data.MultiChange (
MultiChange,
singleton,
fromList,
map,
return,
join,
bind,
compose,
composeMap
) where
import Prelude hiding (id, (.), map, return)
import qualified Prelude
import Control.Category
import Control.Arrow (second)
import Control.Monad (liftM)
import Data.Monoid
import Data.Foldable as Foldable
import qualified Data.List as List
import Data.DList (DList)
import qualified Data.DList as DList
import Data.Incremental
newtype MultiChange p = MultiChange (Dual (DList p)) deriving Monoid
instance Show p => Show (MultiChange p) where
showsPrec prec xs = showParen (prec > 10) $
showString "fromList " . shows (toList xs)
instance Read p => Read (MultiChange p) where
readsPrec prec = readParen (prec > 10) $ \ str -> do
("fromList", rest) <- lex str
(list, rest') <- reads rest
Prelude.return (fromList list, rest')
instance Foldable MultiChange where
foldMap fun (MultiChange (Dual dList)) = foldMap fun dList
foldr next init (MultiChange (Dual dList)) = Foldable.foldr next init dList
instance Change p => Change (MultiChange p) where
type Value (MultiChange p) = Value p
change $$ val = List.foldl' (flip ($$)) val (toList change)
singleton :: p -> MultiChange p
singleton = MultiChange . Dual . DList.singleton
fromList :: [p] -> MultiChange p
fromList = MultiChange . Dual . DList.fromList
map :: Trans p q -> Trans (MultiChange p) (MultiChange q)
map trans = stTrans (\ val -> do
~(val', prop) <- toSTProc trans val
let multiProp change = do
atomics' <- mapM prop (toList change)
Prelude.return (fromList atomics')
Prelude.return (val', multiProp))
return :: Trans p (MultiChange p)
return = simpleTrans id singleton
join :: Trans (MultiChange (MultiChange p)) (MultiChange p)
join = compose
bind :: Trans p (MultiChange q) -> Trans (MultiChange p) (MultiChange q)
bind = composeMap
compose :: Monoid p => Trans (MultiChange p) p
compose = simpleTrans id (mconcat . reverse . toList)
composeMap :: Monoid q => Trans p q -> Trans (MultiChange p) q
composeMap trans = compose . map trans