justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Allow for hard quitting

Browse Source
This commit is contained in:
justin
2022-11-01 16:48:55 +00:00
parent d982ac728a
commit 7d358fde29
4 changed files with 17 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Concurrent.hs
+3 -1
View File
@@ -12,6 +12,7 @@ conEffects :: Universe -> ConcurrentEffect Universe
conEffects u = case u ^? uvSideEffects . _head of
Just NewSideEffect{_ceSideEffect = eff} -> ConcurrentEffect (u & uvSideEffects . _head %~ g)
(dopop eff)
Just HardQuit -> ImmediateEffect (return Nothing)
_ -> NoConcurrentEffect
where
g seff = RunningSideEffect (_ceString seff)
@@ -26,7 +27,8 @@ addSideEffect :: IO (Universe -> Maybe Universe) -> String -> Universe -> Univer
addSideEffect f s = uvSideEffects %~ (|> NewSideEffect f s)
hardQuit :: Universe -> Universe
hardQuit = addSideEffect (return $ const Nothing) "QUITTING"
hardQuit = uvSideEffects %~ (HardQuit <|)
--hardQuit = addSideEffect (return $ const Nothing) "QUITTING"
--tryConcEffect :: Bool -> String -> IO (Universe -> Maybe Universe) -> Universe -> Universe
--tryConcEffect bl str eff u = case u ^. uvConcEffects of