nybble
/
factorial
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Use `om when` from Control.Monad.Extra instead of `whenM`.

This commit is contained in:
Jesse D. McDonald 2016-05-22 12:32:11 -05:00
parent ba095a30e1
commit cbec05610b
2 changed files with 7 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
factorial/factorial.cabal
View File

@ -18,8 +18,9 @@ executable factorial
-- other-extensions: -- other-extensions:
ghc-options: -threaded ghc-options: -threaded
build-depends: base >=4.6 && <4.9, build-depends: base >=4.6 && <4.9,
monad-extras >=0.5 && <0.6,
stm >=2.4 && <2.5, stm >=2.4 && <2.5,
hsqml >=0.3 && <0.4, text >=1.2 && <1.3,
text >=1.2 && <1.3 hsqml >=0.3 && <0.4
-- hs-source-dirs: -- hs-source-dirs:
default-language: Haskell2010 default-language: Haskell2010

8
factorial/factorial.hs
View File

@ -6,6 +6,7 @@ import Control.Concurrent (forkIO, killThread, myThreadId)
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Exception (evaluate, mask_) import Control.Exception (evaluate, mask_)
import Control.Monad import Control.Monad
import Control.Monad.Extra (om)
import Data.IORef import Data.IORef
import Data.Maybe import Data.Maybe
import Data.Text (Text) import Data.Text (Text)
@ -13,11 +14,6 @@ import Graphics.QML
import qualified Data.Text as T import qualified Data.Text as T
-- How are these not in Control.Monad?
whenM, unlessM :: Monad m => m Bool -> m () -> m ()
whenM mcond mtrue = mcond >>= flip when mtrue
unlessM mcond mfalse = mcond >>= flip unless mfalse
main :: IO () main :: IO ()
main = do main = do
state <- newIORef $ T.pack "" state <- newIORef $ T.pack ""
@ -38,7 +34,7 @@ main = do
evaluate out evaluate out
writeIORef state out writeIORef state out
mask_ $ fireSignal skey obj mask_ $ fireSignal skey obj
atomically $ whenM ((== Just tid) <$> readTMVar tidVar) $ atomically $ om when ((== Just tid) <$> readTMVar tidVar) $
void $ swapTMVar tidVar Nothing void $ swapTMVar tidVar Nothing
] ]