IOS.hs revision 98890889ffb2e8f6f722b00e265a211f13b5a861
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny{- |
823a5b3f4375f12b6edae4dd5169ee01771baebeJan ZelenyModule : $Header$
823a5b3f4375f12b6edae4dd5169ee01771baebeJan ZelenyDescription : An IO State Monad implementation
823a5b3f4375f12b6edae4dd5169ee01771baebeJan ZelenyCopyright : (c) Ewaryst Schulz, DFKI Bremen 2010
823a5b3f4375f12b6edae4dd5169ee01771baebeJan ZelenyLicense : GPLv2 or higher, see LICENSE.txt
823a5b3f4375f12b6edae4dd5169ee01771baebeJan ZelenyMaintainer : Ewaryst.Schulz@dfki.de
823a5b3f4375f12b6edae4dd5169ee01771baebeJan ZelenyStability : provisional
823a5b3f4375f12b6edae4dd5169ee01771baebeJan ZelenyPortability : non-portable (various -fglasgow-exts extensions)
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny
823a5b3f4375f12b6edae4dd5169ee01771baebeJan ZelenyAn IO State Monad implementation taken from
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zelenyhttp://www.infosun.fim.uni-passau.de/cl/lehre/funcprog05/folien/s07.pdf
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny
823a5b3f4375f12b6edae4dd5169ee01771baebeJan ZelenyAppearently the IOS type comes from John O'Donnell as you can see in
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zelenyhttp://www.mail-archive.com/haskell@haskell.org/msg07405.html
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny-}
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zelenymodule Common.IOS (IOS (..), runIOS, stmap) where
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zelenyimport Control.Monad.Trans (MonadIO (..))
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zelenyimport Control.Monad.State (MonadState (..))
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny-- * IO State Monad
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny-- | An IO State Monad
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zelenydata IOS s a = IOS { unIOS :: s -> IO (a, s) }
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny
823a5b3f4375f12b6edae4dd5169ee01771baebeJan ZelenygetIOS :: IOS s s
823a5b3f4375f12b6edae4dd5169ee01771baebeJan ZelenygetIOS = IOS (\s -> return (s,s))
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny
823a5b3f4375f12b6edae4dd5169ee01771baebeJan ZelenysetIOS :: s -> IOS s ()
1a3e6221b38a7cae27d7e84a30bb8ea3c3900a47Jan ZelenysetIOS s = IOS (\_ -> return ((),s))
1a3e6221b38a7cae27d7e84a30bb8ea3c3900a47Jan Zeleny
1a3e6221b38a7cae27d7e84a30bb8ea3c3900a47Jan Zeleny{- not needed
1a3e6221b38a7cae27d7e84a30bb8ea3c3900a47Jan ZelenymodifyIOS :: (s->s) -> IOS s s
1a3e6221b38a7cae27d7e84a30bb8ea3c3900a47Jan ZelenymodifyIOS f = IOS (\s -> return (s, f s))
1a3e6221b38a7cae27d7e84a30bb8ea3c3900a47Jan Zeleny-}
1a3e6221b38a7cae27d7e84a30bb8ea3c3900a47Jan Zeleny
1a3e6221b38a7cae27d7e84a30bb8ea3c3900a47Jan ZelenyrunIOS :: s -> IOS s a -> IO (a, s)
823a5b3f4375f12b6edae4dd5169ee01771baebeJan ZelenyrunIOS s cmd = unIOS cmd s
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny
2ce00e0d3896bb42db169d1e79553a81ca837a22Simo Sorce-- | Like fmap but changes the state type, this needs map and unmap functions
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zelenystmap :: (s -> s') -> (s' -> s) -> IOS s a -> IOS s' a
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zelenystmap map' unmap ios = let f (a, b) = (a, map' b)
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny in IOS (\ s' -> fmap f $ unIOS ios $ unmap s')
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny
1a3e6221b38a7cae27d7e84a30bb8ea3c3900a47Jan Zelenyinstance Monad (IOS s) where
1a3e6221b38a7cae27d7e84a30bb8ea3c3900a47Jan Zeleny return x = IOS (\s -> return (x,s))
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny m >>= f = IOS (\s ->
b42bb7d9dbf9a4c44a03e7bf1bab471a8a85e858Michal Zidek do{ (x,s1) <- unIOS m s
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny ; unIOS (f x) s1 } )
823a5b3f4375f12b6edae4dd5169ee01771baebeJan Zeleny
instance MonadIO (IOS s) where
liftIO m = IOS (\s -> do{ a <- m; return (a,s) })
instance MonadState s (IOS s) where
get = getIOS
put = setIOS