{-# 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    <- forall a. Int -> IO a -> IO (Maybe a)
timeout (Int
timeLimit forall a. Num a => a -> a -> a
* Int
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6) (Mode -> String -> String -> IO ()
runElsa Mode
m String
f String
s 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  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
z
    Maybe ()
Nothing -> String -> IO ()
putStrLn String
timeMsg forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
exitFailure

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

timeMsg :: String
timeMsg :: String
timeMsg = String
"Timed out after " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
timeLimit 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] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Mode
Json,    String
f)
    [String
"--server", String
f] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Mode
Server,  String
f)
    [String
f]             -> forall (m :: * -> *) a. Monad m => a -> m a
return (Mode
Cmdline, String
f)
    [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 = forall a.
Mode
-> (String -> IO ())
-> ([UserError] -> IO a)
-> [UserError]
-> IO a
esHandle Mode
mode (Mode -> String -> String -> IO ()
modeWriter Mode
mode String
f) 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
exitSuccess
resultExit [UserError]
_  = Mood -> IO ()
say Mood
Utils.Sad   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 (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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
writer 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 = forall a. Elsa a -> [Result a]
elsa (String -> String -> SElsa
parse String
f String
s)
  let es :: [UserError]
es = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. Located a => Result a -> Maybe UserError
resultError [Result SourceSpan]
rs
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UserError]
es Bool -> Bool -> Bool
&& Mode
mode forall a. Eq a => a -> a -> Bool
== Mode
Cmdline) (String -> IO ()
putStrLn (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 " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a. [Result a] -> [String]
successes [Result a]
rs) forall a. [a] -> [a] -> [a]
++ String
"."

--------------------------------------------------------------------------------
runElsaId :: FilePath -> Id -> IO (Maybe (Result ()))
--------------------------------------------------------------------------------
runElsaId :: String -> String -> IO (Maybe (Result ()))
runElsaId String
f String
x = ((forall a. Elsa a -> String -> Maybe (Result ())
`runElsa1` String
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO SElsa
parseFile String
f)
                  forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
                     (\([UserError]
_ :: [UserError]) -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. (String -> Bool) -> Elsa a -> [Result a]
elsaOn (forall a. Eq a => a -> a -> Bool
== String
x) Elsa a
p of
                 [Result a
r] -> forall a. a -> Maybe a
Just (forall (f :: * -> *) a. Functor f => f a -> f ()
void Result a
r)
                 [Result a]
_   -> forall a. Maybe a
Nothing