{-# LANGUAGE ScopedTypeVariables #-}
module Language.Elsa.Runner
( topMain
, runElsa
, runElsaId
) where
import Data.List (intercalate)
import Data.Maybe (mapMaybe)
import Control.Monad (when, void)
import Control.Exception
import System.IO
import System.Exit
import System.Environment (getArgs)
import System.FilePath
import System.Directory
import System.Timeout
import Language.Elsa.Parser
import Language.Elsa.Types
import Language.Elsa.UX
import Language.Elsa.Eval
topMain:: IO ()
topMain = do
(m, f) <- getSrcFile
s <- readFile f
res <- timeout (timeLimit * 10 ^ 6) (runElsa m f s `catch` exitErrors m f)
case res of
Just z -> return z
Nothing -> putStrLn timeMsg >> exitFailure
timeLimit :: Int
timeLimit = 10
timeMsg :: String
timeMsg = "Timed out after " ++ show timeLimit ++ " seconds."
getSrcFile :: IO (Mode, Text)
getSrcFile = do
args <- getArgs
case args of
["--json" , f] -> return (Json, f)
["--server", f] -> return (Server, f)
[f] -> return (Cmdline, f)
_ -> error "Please run with a single file as input"
exitErrors :: Mode -> FilePath -> [UserError] -> IO ()
exitErrors mode f es = esHandle mode (modeWriter mode f) resultExit es
resultExit :: [UserError] -> IO a
resultExit [] = exitSuccess
resultExit _ = exitFailure
esHandle :: Mode -> (Text -> IO ()) -> ([UserError] -> IO a) -> [UserError] -> IO a
esHandle mode writer exitF es = renderErrors mode es >>= writer >> exitF es
modeWriter :: Mode -> FilePath -> Text -> IO ()
modeWriter Cmdline _ s = hPutStrLn stderr s
modeWriter Json _ s = hPutStrLn stderr s
modeWriter Server f s = do createDirectoryIfMissing True jsonDir
writeFile jsonFile s
hPutStrLn stderr s
where
jsonDir = takeDirectory f </> ".elsa"
jsonFile = jsonDir </> addExtension (takeFileName f) ".json"
runElsa :: Mode -> FilePath -> Text -> IO ()
runElsa mode f s = do
let rs = elsa (parse f s)
let es = mapMaybe resultError rs
when (null es && mode == Cmdline) (putStrLn (okMessage rs))
exitErrors mode f es
okMessage rs = "OK " ++ intercalate ", " (successes rs) ++ "."
runElsaId :: FilePath -> Id -> IO (Maybe (Result ()))
runElsaId f x = ((`runElsa1` x) <$> parseFile f)
`catch`
(\(_ :: [UserError]) -> return Nothing)
runElsa1 :: Elsa a -> Id -> Maybe (Result ())
runElsa1 p x = case elsaOn (== x) p of
[r] -> Just (void r)
_ -> Nothing