module Control.Effect.Writer(Writer(..), Symbol, put, Mapping(..),
IsMap, Map(..), union, Var(..),
Union, Unionable) where
import Control.Effect
import Data.Type.Map
import Data.Monoid
import GHC.TypeLits
import Prelude hiding (Monad(..))
data Writer (w :: [Mapping Symbol *]) a = Writer { runWriter :: (a, Map w) }
instance Effect Writer where
type Inv Writer s t = (IsMap s, IsMap t, Unionable s t)
type Unit Writer = '[]
type Plus Writer s t = Union s t
return x = Writer (x, Empty)
(Writer (a, w)) >>= k = let Writer (b, w') = k a
in Writer (b, w `union` w')
put :: Var v -> a -> Writer '[v :-> a] ()
put v a = Writer ((), Ext v a Empty)
type instance Combine v v = v
instance (Monoid u, Nubable ((k :-> u) ': s)) => Nubable ((k :-> u) ': (k :-> u) ': s) where
nub (Ext _ u (Ext k v s)) = nub (Ext k (u `mappend` v) s)
instance Supermap s t => Subeffect Writer s t where
sub (Writer (a, w)) = Writer (a, (supermap w)::(Map t))
class Supermap s t where
supermap :: Map s -> Map t
instance Supermap '[] '[] where
supermap Empty = Empty
instance (Monoid x, Supermap '[] s) => Supermap '[] ((k :-> x) ': s) where
supermap Empty = Ext Var mempty (supermap Empty)
instance Supermap s t => Supermap ((k :-> v) ': s) ((k :-> v) ': t) where
supermap (Ext k x xs) = Ext k x (supermap xs)