Skip to content
Snippets Groups Projects
FunPB.hs 736 B
Newer Older
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)