module Devel.Build
( build
) where
import IdeSession
import qualified Data.ByteString.Char8 as S8
import Data.Text (unpack)
import GHC.Conc (newTVarIO)
import Control.Concurrent (forkIO, killThread, ThreadId)
import Control.Monad (unless)
# if __GLASGOW_HASKELL__ < 710
import Data.Monoid (mempty)
#endif
import Devel.Compile
import Devel.ReverseProxy (startReverseProxy)
import Devel.Watch
build :: FilePath -> String -> Bool -> SessionConfig -> (Int, Int) -> Maybe IdeSession -> Bool -> IO ()
build buildFile runFunction isReverseProxy sessionConfig (fromProxyPort, toProxyPort) mSession isRebuild = do
(initialSession, extensionList, includeTargets) <- initCompile sessionConfig mSession
unless isRebuild $
if isReverseProxy then
do _ <- forkIO $ startReverseProxy (fromProxyPort, toProxyPort)
putStrLn $ "Starting devel application at http://localhost:" ++
show fromProxyPort
else
putStrLn $ "Starting app without reverse proxying at http://localhost:" ++
show fromProxyPort
(updatedSession, update) <-
if isRebuild
then return (initialSession, mempty)
else compile initialSession buildFile extensionList includeTargets
eitherSession <- finishCompile (updatedSession, update)
case eitherSession of
Left _ -> do
isDirty <- newTVarIO False
_ <- forkIO $ watch isDirty includeTargets
_ <- checkForChange isDirty
putStrLn "\n\nRebuilding...\n\n"
_ <- shutdownSession updatedSession
build buildFile runFunction False sessionConfig (fromProxyPort, toProxyPort) Nothing False
Right session -> do
(runActionsRunResult, threadId) <- run session buildFile runFunction
isDirty <- newTVarIO False
watchId <- forkIO $ watch isDirty includeTargets
_ <- checkForChange isDirty
killThread watchId
_ <- stopApp runActionsRunResult threadId
putStrLn "\n\nRebuilding...\n\n"
build buildFile runFunction isReverseProxy sessionConfig (fromProxyPort, toProxyPort) (Just session) True
run :: IdeSession -> FilePath -> String -> IO (RunActions RunResult, ThreadId)
run session buildFile runFunction = do
mapFunction <- getFileMap session
buildModule <- case mapFunction buildFile of
Nothing -> fail $ "The file's module name for: " ++ show buildFile ++" couldn't be found"
Just moduleId -> return $ unpack $ moduleName moduleId
runActionsRunResult <- runStmt session buildModule runFunction
threadId <- forkIO $ loop runActionsRunResult
return (runActionsRunResult, threadId)
stopApp :: RunActions RunResult -> ThreadId -> IO ()
stopApp runResult threadId = do
interrupt runResult
killThread threadId
loop :: RunActions RunResult -> IO ()
loop res = do
runAction <- runWait res
case runAction of
Left bs -> S8.putStr bs >> loop res
Right result -> putStrLn $ "Run result: " ++ show result