22 lines
736 B
Haskell
22 lines
736 B
Haskell
|
module FunPB where
|
||
|
|
|
||
|
|
import Control.Monad
|
||
|
|
|
||
|
|
data FunPB a b = FunPB { runFunPB :: a -> (a,[b]) }
|
||
|
|
|
||
|
|
instance Monoid (FunPB a b) where
|
||
|
|
mempty = FunPB $ \k -> (k,mempty)
|
||
|
|
mappend pb1 pb2 = FunPB $ \n -> (,) n $ msum . (<$>) (uncurry (flip const).((flip runFunPB) n)) $ [pb1,pb2]
|
||
|
|
|
||
|
|
addAssoc :: Eq a => (a,b) -> FunPB a b -> FunPB a b
|
||
|
|
addAssoc (n,nr) pb = FunPB $ \n' -> if n' == n then ((:) nr) <$> runFunPB pb n' else runFunPB pb n'
|
||
|
|
|
||
|
|
delAssoc :: Eq a => a -> FunPB a b -> FunPB a b
|
||
|
|
delAssoc n pb = FunPB $ \n' -> if n == n' then runFunPB mempty n' else runFunPB pb n'
|
||
|
|
|
||
|
|
multiFind :: [FunPB a b] -> a -> (a,[b])
|
||
|
|
multiFind = runFunPB.mconcat
|
||
|
|
|
||
|
|
dataToFunPB :: Eq a => [(a,b)] -> FunPB a b
|
||
|
|
dataToFunPB = mconcat.fmap ((flip addAssoc) mempty)
|