Conductor.hs

-- | Conductor is responsible to control the command-line listener, 
-- the listener manager and the action to execute
module Shaker.Conductor(
 initThread
)
  where

import Shaker.Type
import Control.Monad
import Control.Concurrent
import Shaker.Listener
import Shaker.Cli
import qualified Data.Map as M
import Control.Monad.Reader
import Data.Maybe
 
-- | Initialize the master thread 
-- Once the master thread is finished, all input threads are killed
initThread :: InputState -> Shaker IO()
initThread inputState = do
  act <- asks $ runReaderT (getInput inputState) 
  procId <- lift $ forkIO $ forever act
  mainThread inputState 
  lift $ killThread procId
 
-- | The main thread. 
-- Loop until a Quit action is called
mainThread :: InputState -> Shaker IO()
mainThread st@(InputState inputMv tokenMv) = do
  _ <- lift $ tryPutMVar tokenMv 42
  cmd <- lift $ takeMVar inputMv
  executeCommand cmd  
  case cmd of
       Command _ [Quit] -> return ()
       _ ->  mainThread st

-- | Continuously execute the given action until a keyboard input is done
listenManager :: Shaker IO() -> Shaker IO()
listenManager fun = do
  shIn <- ask 
  lift $ action shIn 
  where action shIn = do
          -- Setup keyboard listener
          endToken <- newEmptyMVar 
          procCharListener <- forkIO $ getChar >>= putMVar endToken
          -- Setup source listener
          listenState <- initialize (listenerInput shIn)
          -- Run the action
          procId <-  forkIO $ forever $ threadExecutor listenState (runReaderT fun shIn)
          _ <- readMVar endToken 
          mapM_ killThread  $  [procId,procCharListener] ++ threadIds listenState
  
-- | Execute the given action when the modified MVar is filled
threadExecutor :: ListenState -> IO() -> IO ThreadId
threadExecutor listenState fun = takeMVar (modifiedFiles listenState) >> forkIO fun 

-- | Execute Given Command in a new thread
executeCommand :: Command -> Shaker IO()
executeCommand (Command OneShot act) = executeAction act 
executeCommand (Command Continuous act) = listenManager ( executeAction act ) >> return () 

-- | Execute given action
executeAction :: [Action] -> Shaker IO()
executeAction acts = do
   thePluginMap <- asks pluginMap
   sequence_ $ mapMaybe (`M.lookup` thePluginMap) acts