module Dodge.Concurrent 
    ( hardQuit
    , addSideEffect
    , conEffects
    , blockingLoad
    ) where

--import qualified Data.Set as S
import Dodge.Menu.Loading
import LensHelp
import Dodge.Data.Universe
import Data.Sequence (Seq (..))

--import Control.Concurrent
--import SDL.Input.Keyboard.Codes

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)
    dopop :: IO (Universe -> Maybe Universe) -> IO (Universe -> Maybe Universe)
    dopop mf = do
        f <- mf 
        return $ f . (uvSideEffects %~ taker)
    taker (_ :<| xs) = xs
    taker _ = mempty

addSideEffect :: IO (Universe -> Maybe Universe) -> String -> Universe -> Universe
addSideEffect f s = uvSideEffects %~ (|> NewSideEffect f s)

hardQuit :: Universe -> Universe
hardQuit = uvSideEffects %~ (HardQuit <|)

blockingLoad :: String -> IO (Universe -> Maybe Universe) -> Universe -> Universe
blockingLoad str f u = u & uvScreenLayers .:~ loadingScreen str
    & addSideEffect f str

--hardQuit = addSideEffect (return $ const Nothing) "QUITTING"

--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))