{-# 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 :: IO ()
topMain = do
  (Mode
m, String
f) <- IO (Mode, String)
getSrcFile
  String
s      <- String -> IO String
readFile String
f
  Maybe ()
res    <- Int -> IO () -> IO (Maybe ())
forall a. Int -> IO a -> IO (Maybe a)
timeout (Int
timeLimit Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6) (Mode -> String -> String -> IO ()
runElsa Mode
m String
f String
s IO () -> ([UserError] -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` Mode -> String -> [UserError] -> IO ()
exitErrors Mode
m String
f)
  case Maybe ()
res of
    Just ()
z  -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
z
    Maybe ()
Nothing -> String -> IO ()
putStrLn String
timeMsg IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitFailure

timeLimit :: Int
timeLimit :: Int
timeLimit = Int
10

timeMsg :: String
timeMsg :: String
timeMsg = String
"Timed out after " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
timeLimit String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" seconds."

getSrcFile :: IO (Mode, Text)
getSrcFile :: IO (Mode, String)
getSrcFile = do
  [String]
args <- IO [String]
getArgs
  case [String]
args of
    [String
"--json"  , String
f] -> (Mode, String) -> IO (Mode, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Mode
Json,    String
f)
    [String
"--server", String
f] -> (Mode, String) -> IO (Mode, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Mode
Server,  String
f)
    [String
f]             -> (Mode, String) -> IO (Mode, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Mode
Cmdline, String
f)
    [String]
_               -> String -> IO (Mode, String)
forall a. HasCallStack => String -> a
error String
"Please run with a single file as input"

exitErrors :: Mode -> FilePath -> [UserError] -> IO ()
exitErrors :: Mode -> String -> [UserError] -> IO ()
exitErrors Mode
mode String
f [UserError]
es = Mode
-> (String -> IO ())
-> ([UserError] -> IO ())
-> [UserError]
-> IO ()
forall a.
Mode
-> (String -> IO ())
-> ([UserError] -> IO a)
-> [UserError]
-> IO a
esHandle Mode
mode (Mode -> String -> String -> IO ()
modeWriter Mode
mode String
f) [UserError] -> IO ()
forall a. [UserError] -> IO a
resultExit [UserError]
es

resultExit :: [UserError] -> IO a
resultExit :: forall a. [UserError] -> IO a
resultExit [] = Mood -> IO ()
say Mood
Utils.Happy IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
forall a. IO a
exitSuccess
resultExit [UserError]
_  = Mood -> IO ()
say Mood
Utils.Sad   IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
forall a. IO a
exitFailure

say :: Utils.Mood -> IO () 
say :: Mood -> IO ()
say Mood
m = Mood -> String -> IO ()
Utils.colorStrLn Mood
m (String -> String
Utils.wrapStars (Mood -> String
forall {a}. IsString a => Mood -> a
msg Mood
m))
  where 
    msg :: Mood -> a
msg Mood
Utils.Happy = a
"OK"
    msg Mood
Utils.Sad   = a
"Errors found!"


esHandle :: Mode -> (Text -> IO ()) -> ([UserError] -> IO a) -> [UserError] -> IO a
esHandle :: forall a.
Mode
-> (String -> IO ())
-> ([UserError] -> IO a)
-> [UserError]
-> IO a
esHandle Mode
mode String -> IO ()
writer [UserError] -> IO a
exitF [UserError]
es = Mode -> [UserError] -> IO String
renderErrors Mode
mode [UserError]
es IO String -> (String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
writer IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [UserError] -> IO a
exitF [UserError]
es

modeWriter :: Mode -> FilePath -> Text -> IO ()
modeWriter :: Mode -> String -> String -> IO ()
modeWriter Mode
Cmdline String
_ String
s = Handle -> String -> IO ()
hPutStrLn Handle
stderr String
s 
modeWriter Mode
Json    String
_ String
s = Handle -> String -> IO ()
hPutStrLn Handle
stderr String
s
modeWriter Mode
Server  String
f String
s = do Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
jsonDir
                            String -> String -> IO ()
writeFile String
jsonFile String
s
                            Handle -> String -> IO ()
hPutStrLn Handle
stderr String
s
                         where
                            jsonDir :: String
jsonDir  = String -> String
takeDirectory String
f String -> String -> String
</> String
".elsa"
                            jsonFile :: String
jsonFile = String
jsonDir String -> String -> String
</> String -> String -> String
addExtension (String -> String
takeFileName String
f) String
".json"


---------------------------------------------------------------------------------------------------------
runElsa :: Mode -> FilePath -> Text -> IO ()
---------------------------------------------------------------------------------------------------------
runElsa :: Mode -> String -> String -> IO ()
runElsa Mode
mode String
f String
s = do
  let rs :: [Result SourceSpan]
rs = Elsa SourceSpan -> [Result SourceSpan]
forall a. Elsa a -> [Result a]
elsa (String -> String -> Elsa SourceSpan
parse String
f String
s)
  let es :: [UserError]
es = (Result SourceSpan -> Maybe UserError)
-> [Result SourceSpan] -> [UserError]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Result SourceSpan -> Maybe UserError
forall a. Located a => Result a -> Maybe UserError
resultError [Result SourceSpan]
rs
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([UserError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UserError]
es Bool -> Bool -> Bool
&& Mode
mode Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
Cmdline) (String -> IO ()
putStrLn ([Result SourceSpan] -> String
forall {a}. [Result a] -> String
okMessage [Result SourceSpan]
rs))
  Mode -> String -> [UserError] -> IO ()
exitErrors Mode
mode String
f [UserError]
es

okMessage :: [Result a] -> String
okMessage [Result a]
rs = String
"OK " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([Result a] -> [String]
forall a. [Result a] -> [String]
successes [Result a]
rs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."

--------------------------------------------------------------------------------
runElsaId :: FilePath -> Id -> IO (Maybe (Result ()))
--------------------------------------------------------------------------------
runElsaId :: String -> String -> IO (Maybe (Result ()))
runElsaId String
f String
x = ((Elsa SourceSpan -> String -> Maybe (Result ())
forall a. Elsa a -> String -> Maybe (Result ())
`runElsa1` String
x) (Elsa SourceSpan -> Maybe (Result ()))
-> IO (Elsa SourceSpan) -> IO (Maybe (Result ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Elsa SourceSpan)
parseFile String
f)
                  IO (Maybe (Result ()))
-> ([UserError] -> IO (Maybe (Result ())))
-> IO (Maybe (Result ()))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
                     (\([UserError]
_ :: [UserError]) -> Maybe (Result ()) -> IO (Maybe (Result ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Result ())
forall a. Maybe a
Nothing)

runElsa1 :: Elsa a -> Id -> Maybe (Result ())
runElsa1 :: forall a. Elsa a -> String -> Maybe (Result ())
runElsa1 Elsa a
p String
x = case (String -> Bool) -> Elsa a -> [Result a]
forall a. (String -> Bool) -> Elsa a -> [Result a]
elsaOn (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x) Elsa a
p of
                 [Result a
r] -> Result () -> Maybe (Result ())
forall a. a -> Maybe a
Just (Result a -> Result ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Result a
r)
                 [Result a]
_   -> Maybe (Result ())
forall a. Maybe a
Nothing