[Haskell-cafe] Abstraction leak
Jon Cast
jcast at ou.edu
Fri Jun 29 16:28:17 EDT 2007
On Friday 29 June 2007, Andrew Coppin wrote:
> ...and again today I found myself trying to do something that would be
> very easy in an imperative language, but I cannot think of a single good
> way of doing it in Haskell. Hopfully somebody can give me some hints.
>
<snip long and helpful explanation>
Here's my solution (drawn from a library I'll be posting Real Soon Now):
import Control.Monad
import Control.Monad.Trans
data SPMT iota omicron m alpha
= ReturnSP alpha
| LiftSP (m (SPMT iota omicron m alpha))
| GetSP (iota -> SPMT iota omicron m alpha))
| PutSP omicron (SPMT iota omicron m alpha)
instance Monad m => Monad (SPMT iota omicron m) where
return x = ReturnSP x
ReturnSP x >>= f = f x
LiftSP a >>= f = LiftSP (liftM (>>= f) a)
GetSP a >>= f = GetSP (\ x -> a x >>= f)
PutSP x a >>= f = PutSP x (a >>= f)
instance MonadTrans (SPMT iota omicron) where
lift a = LiftSP (liftM ReturnSP a)
getSP :: SPMT iota omicron m iota
getSP = GetSP ReturnSP
putSP :: omicron -> SPMT iota omicron m ()
putSP x = PutSP x (ReturnSP ())
(^>^) :: Monad m => SPMT iota omicron m alpha -> SPMT omicron omicron' m beta
-> SPMT iota omicron' m beta
a ^>^ ReturnSP x = ReturnSP x
a ^>^ LiftSP b = LiftSP (liftM (a ^>^) b)
a ^>^ PutSP x b = PutSP x (a ^>^ b)
LiftSP a ^>^ GetSP b = LiftSP (liftM (^>^ GetSP b) a)
GetSP a ^>^ GetSP b = GetSP (\ x -> a x ^>^ GetSP b)
PutSP x a ^>^ GetSP b = a ^>^ b x
If the signature of SPMT suffices to write decodeRLE and decodeHeader, the
task of applying RLE decoding just to the header can be implemented by using
decodeRLE ^>^ decodeHeader in place of just decodeHeader. Extension to
situations left un-implemented above I leave for your ingenuity and/or
release of my library.
HTH.
Jonathan Cast
http://sourceforge.net/projects/fid-core
http://sourceforge.net/projects/fid-emacs
More information about the Haskell-Cafe
mailing list