Refactor concurrent side effects

src/Dodge/Concurrent.hs

@@ -3,25 +3,38 @@ module Dodge.Concurrent where
 --import qualified Data.Set as S
 import Control.Lens
 import Dodge.Data.Universe
+import Data.Sequence (Seq (..))
 
 --import Control.Concurrent
 --import SDL.Input.Keyboard.Codes
 
 conEffects :: Universe -> ConcurrentEffect Universe
-conEffects u = case u ^. uvConcEffects of
-    NewConcEffect{_ceFunction = eff} -> eff
+conEffects u = case u ^? uvSideEffects . _head of
+    Just NewSideEffect{_ceSideEffect = eff} -> ConcurrentEffect (u & uvSideEffects . _head %~ g) 
+        (dopop eff)
     _ -> NoConcurrentEffect
-
-tryConcEffect :: Bool -> String -> IO (Universe -> Maybe Universe) -> Universe -> Universe
-tryConcEffect bl str eff u = case u ^. uvConcEffects of
-    NoConcEffect -> u & uvConcEffects .~ NewConcEffect (ConcurrentEffect setstr (clearConcEff eff)) str bl
-    _ -> u
   where
-    setstr
-        | bl = uvConcEffects .~ BlockingConcEffect str
-        | otherwise = uvConcEffects .~ BackgroundConcEffect str
+    g seff = RunningSideEffect (_ceString seff)
+    dopop :: IO (Universe -> Maybe Universe) -> IO (Universe -> Maybe Universe)
+    dopop mf = do
+        f <- mf 
+        return $ f . (uvSideEffects %~ taker)
+    taker (_ :<| xs) = xs
+    taker _ = mempty
 
-clearConcEff :: IO (Universe -> Maybe Universe) -> IO (Universe -> Maybe Universe)
-clearConcEff eff = do
-    f <- eff
-    return (f . (uvConcEffects .~ NoConcEffect))
+addSideEffect :: IO (Universe -> Maybe Universe) -> String -> Universe -> Universe
+addSideEffect f s = uvSideEffects %~ (|> NewSideEffect f s)
+
+--tryConcEffect :: Bool -> String -> IO (Universe -> Maybe Universe) -> Universe -> Universe
+--tryConcEffect bl str eff u = case u ^. uvConcEffects of
+--    NoConcEffect -> u & uvConcEffects .~ NewConcEffect (ConcurrentEffect setstr (clearConcEff eff)) str bl
+--    _ -> u
+--  where
+--    setstr
+--        | bl = uvConcEffects .~ BlockingConcEffect str
+--        | otherwise = uvConcEffects .~ BackgroundConcEffect str
+
+--clearConcEff :: IO (Universe -> Maybe Universe) -> IO (Universe -> Maybe Universe)
+--clearConcEff eff = do
+--    f <- eff
+--    return (f . (uvConcEffects .~ NoConcEffect))