Class.hs

{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
module Data.Module.Class where

import Data.Default
import Data.Maybe
import Data.Monoid

class (Default (V dX), Monoid dX) => Module dX where
	type V dX
	apply :: dX -> V dX -> Maybe (V dX)

applyDef :: Module dX => dX -> Maybe (V dX)
applyDef dx = apply dx def

applyTotal :: Module dX => dX -> V dX -> V dX
applyTotal dx x = fromJust (apply dx x)

applyDefTotal :: Module dX => dX -> V dX
applyDefTotal dx = applyTotal dx def

-- Morally, we have
-- foldMap :: Monoid b => (a -> State c b) -> ([a] -> State c b)
-- which does just what we want.  Unfortunately, this requires an
-- instance (Monad m, Monoid a) => Monoid (m a)
-- and an unhealthy amount of type munging to get in and out of State, curry
-- arguments, etc.  Since the instance above is most conveniently available
-- from the "reducers" package, which has a dependency redwood, and the
-- above-mentioned type-munging obfuscates the beautiful definition anyway, we
-- instead re-implement foldMap manually. It's not quite as beatiful
-- conceptually, but it makes for much easier reading.

foldState f ([]  , c) = (mempty, c)
foldState f (e:es, c) = (mappend e1 e2, c'') where
	(e2, c' ) = foldState f (es, c)
	(e1, c'') = f e c'