module Shaker.Conductor
(initThread, executeCommand)
where
import Control.Concurrent
import Control.Monad
import Control.Monad.Reader
import Data.Maybe
import qualified Control.Exception as C
import qualified Data.Map as M
import Shaker.Cli
import Shaker.Io
import Shaker.Listener
import Shaker.ModuleData
import Shaker.Type
initThread :: Shaker IO()
initThread = do
shIn <- ask
input_action <- getInput
lift ( forkIO ( forever input_action) ) >>= addThreadIdToQuitMVar
let main_loop = runReaderT mainThread shIn
lift ( forkIO (forever main_loop) ) >>= addThreadIdToQuitMVar
quit_token <- asks (threadDataQuitToken . shakerThreadData)
_ <- lift $ takeMVar quit_token
cleanAllThreads
mainThread :: Shaker IO()
mainThread = do
(InputState inputMv tokenMv) <- asks shakerInputState
_ <- lift $ tryPutMVar tokenMv 42
maybe_cmd <- lift $ takeMVar inputMv
executeCommand maybe_cmd
initializeConductorData :: Shaker IO () -> Shaker IO ConductorData
initializeConductorData fun = do
shIn <- ask
lstState <- initializeListener
mapM_ addThreadIdToListenMVar $ threadIds lstState
let theFun a = runReaderT fun shIn {shakerModifiedInfoFiles = a}
return $ ConductorData lstState theFun
cleanAllThreads :: Shaker IO ()
cleanAllThreads = do
asks ( threadDataListenList . shakerThreadData ) >>= cleanThreads
asks ( threadDataQuitList . shakerThreadData ) >>= cleanThreads
cleanThreads :: ThreadIdList -> Shaker IO()
cleanThreads thrdList = lift (readMVar thrdList) >>= lift . mapM_ killThread
threadExecutor :: ConductorData -> Shaker IO ()
threadExecutor conductorData = do
shIn <- ask
res <- lift $ handleContinuousInterrupt $ runReaderT (threadExecutor' conductorData) shIn
when res $ threadExecutor conductorData
asks ( threadDataListenList . shakerThreadData ) >>= cleanThreads
threadExecutor' :: ConductorData -> Shaker IO Bool
threadExecutor' (ConductorData listenState fun) = lift $ takeMVar (mvModifiedFiles listenState) >>= fun >> return True
executeCommand :: Maybe Command -> Shaker IO ()
executeCommand Nothing = executeAction [Action InvalidAction]
executeCommand (Just (Command OneShot act_list)) = executeAction act_list
executeCommand (Just (Command Continuous act)) = initializeConductorData ( executeAction act ) >>= threadExecutor
executeAction :: [Action] -> Shaker IO()
executeAction acts = do
shIn <- ask
let allActs = runReaderT (mapM_ executeAction' acts) shIn
lift $ handleActionInterrupt allActs
return ()
executeAction' :: Action -> Shaker IO()
executeAction' (ActionWithArg actKey args) =
local (\shIn -> shIn {shakerArgument = args} ) (executeAction' (Action actKey))
executeAction' (Action actKey) = do
plMap <- asks shakerPluginMap
mdatas <- parseAllModuleData
local (\shIn -> shIn {shakerModuleData = mdatas} ) (fromJust $ actKey `M.lookup` plMap)
handleContinuousInterrupt :: IO Bool -> IO Bool
handleContinuousInterrupt = C.handle catchAll
where catchAll :: C.SomeException -> IO Bool
catchAll e = putStrLn ("Shaker caught " ++ show e ) >> return False
addThreadIdToListenMVar :: ThreadId -> Shaker IO()
addThreadIdToListenMVar thrdId = asks (threadDataListenList . shakerThreadData) >>= flip addThreadIdToMVar thrdId
addThreadIdToQuitMVar :: ThreadId -> Shaker IO()
addThreadIdToQuitMVar thrdId = asks (threadDataQuitList . shakerThreadData) >>= flip addThreadIdToMVar thrdId
addThreadIdToMVar :: ThreadIdList -> ThreadId -> Shaker IO ()
addThreadIdToMVar thrdList thrId = lift $ modifyMVar_ thrdList (\b -> return $ thrId:b)