module Development.Bake.Core.Run(
runInit, runUpdate, runTest, runExtra
) where
import Development.Bake.Core.Type hiding (Client)
import Development.Bake.Core.Message
import Development.Shake.Command
import Control.Exception.Extra
import General.BigString
import General.Extra
import System.Time.Extra
import Control.DeepSeq
import Control.Concurrent.Extra
import System.IO.Unsafe
import Data.Tuple.Extra
import System.IO.Extra
import System.Environment.Extra
import System.FilePath
import Data.Maybe
import System.Exit
import Safe
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
running :: Var Int
running = unsafePerformIO $ newVar 0
state x = "--state=" ++ fromState x
patch x = "--patch=" ++ fromPatch x
test x = "--test=" ++ fromTest x
runInit :: IO (Maybe State, Answer)
runInit = runAll "init" [] [] toState
runUpdate :: State -> [Patch] -> IO (Maybe State, Answer)
runUpdate s ps = runAll "update" (state s : map patch ps) [] toState
runTest :: State -> [Patch] -> Maybe Test -> IO Answer
runTest s ps t = do
(ex, ans) <- runAll "test" (state s : map patch ps) (map test $ maybeToList t) (map toTest . readNote "runTest")
return $ maybe ans (\ex -> ans{aTests=ex}) (if t == Nothing then ex else Nothing)
runExtra :: State -> Maybe Patch -> IO (Maybe (T.Text, TL.Text), Answer)
runExtra s ps = runAll "extra" (state s : map patch (maybeToList ps)) [] ((T.pack *** TL.pack) . readNote "runExtra")
runAll :: NFData a => String -> [String] -> [String] -> (String -> a) -> IO (Maybe a, Answer)
runAll name args1 args2 parse = do
exe <- getExecutablePath
dir <- createDir ("bake-" ++ name) args1
(time, res) <- duration $ try_ $ do
exe <- getExecutablePath
(out, exit) <- bigStringFromFile $ \file -> do
res <- bracket_ (modifyVar_ running $ return . succ) (modifyVar_ running $ return . pred) $ do
v <- readVar running
print $ "RUNNING = " ++ show v
cmd [Cwd dir, FileStdout file, FileStderr file] exe ("run" ++ name) args1 args2
v <- readVar running
print $ "RUNNING = " ++ show v
return res
ex <- if exit /= ExitSuccess then return Nothing else do
ans <- fmap parse $ readFile' $ dir </> ".bake.result"
evaluate $ rnf ans
return $ Just ans
return (ex, Answer out (Just 0) [] (exit == ExitSuccess))
case res of
Left e -> do
e <- showException e
return (Nothing, Answer (bigStringFromString e) (Just time) [] False)
Right (ex,ans) -> return (ex, ans{aDuration=Just time})