content: {-# 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
  import qualified Language.Elsa.Utils as Utils
  
  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 [] = say Utils.Happy >> exitSuccess
  resultExit _  = say Utils.Sad   >> exitFailure
  
  say :: Utils.Mood -> IO () 
  say m = Utils.colorStrLn m (Utils.wrapStars (msg m))
    where 
      msg Utils.Happy = "OK"
      msg Utils.Sad   = "Errors found!"
  
  
  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
  