e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzDescription : An IO State Monad implementation
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzCopyright : (c) Ewaryst Schulz, DFKI Bremen 2010
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuLicense : GPLv2 or higher, see LICENSE.txt
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzMaintainer : Ewaryst.Schulz@dfki.de
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzStability : provisional
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzPortability : non-portable (various -fglasgow-exts extensions)
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzAn IO State Monad implementation taken from
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzhttp://www.infosun.fim.uni-passau.de/cl/lehre/funcprog05/folien/s07.pdf
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzAppearently the IOS type comes from John O'Donnell as you can see in
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzhttp://www.mail-archive.com/haskell@haskell.org/msg07405.html
2747c08c70e4819273caf474946ff8e31d422cd4Ewaryst Schulzmodule Common.IOS (IOS (..), runIOS, stmap) where
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzimport Control.Monad.Trans (MonadIO (..))
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzimport Control.Monad.State (MonadState (..))
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz-- * IO State Monad
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz-- | An IO State Monad
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzdata IOS s a = IOS { unIOS :: s -> IO (a, s) }
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzgetIOS :: IOS s s
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedergetIOS = IOS (\ s -> return (s, s))
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzsetIOS :: s -> IOS s ()
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedersetIOS s = IOS (\ _ -> return ((), s))
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzmodifyIOS :: (s->s) -> IOS s s
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzmodifyIOS f = IOS (\s -> return (s, f s))
905f3b47b556b438c9cc283743725cbbf85b4c7eEwaryst SchulzrunIOS :: s -> IOS s a -> IO (a, s)
905f3b47b556b438c9cc283743725cbbf85b4c7eEwaryst SchulzrunIOS s cmd = unIOS cmd s
2747c08c70e4819273caf474946ff8e31d422cd4Ewaryst Schulz-- | Like fmap but changes the state type, this needs map and unmap functions
2747c08c70e4819273caf474946ff8e31d422cd4Ewaryst Schulzstmap :: (s -> s') -> (s' -> s) -> IOS s a -> IOS s' a
2747c08c70e4819273caf474946ff8e31d422cd4Ewaryst Schulzstmap map' unmap ios = let f (a, b) = (a, map' b)
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder in IOS (fmap f . unIOS ios . unmap)
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzinstance Monad (IOS s) where
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder return x = IOS (\ s -> return (x, s))
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder m >>= f = IOS (\ s ->
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder do { (x, s1) <- unIOS m s
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz ; unIOS (f x) s1 } )
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzinstance MonadIO (IOS s) where
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder liftIO m = IOS (\ s -> do { a <- m; return (a, s) })
e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzinstance MonadState s (IOS s) where