elm-repl-0.1: Evaluator.hs

{-# LANGUAGE OverloadedStrings #-}
module Evaluator where

import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString as BS
import qualified Language.Elm as Elm
import qualified Environment as Env

import System.IO.Error  (isDoesNotExistError)
import System.Directory (removeFile)
import System.Exit      (ExitCode(..))
import System.FilePath  ((</>), replaceExtension)
import System.Process
import Control.Exception
import Control.Monad (unless)

runRepl :: Env.Repl -> IO Bool
runRepl environment =
  do writeFile tempElm (Env.toElm environment)
     result <- run "elm" elmArgs $ \types -> do
       reformatJS tempJS
       run "node" nodeArgs $ \value' ->
           let value = BSC.init value'
               tipe = scrapeOutputType types
               isTooLong = BSC.isInfixOf "\n" value ||
                           BSC.isInfixOf "\n" tipe ||
                           BSC.length value + BSC.length tipe > 80   
               message = BS.concat [ if isTooLong then value' else value, tipe ]
           in  unless (BSC.null value') $ BSC.putStrLn message
     removeIfExists tempElm
     return result
  where
    tempElm = "repl-temp-000.elm"
    tempJS  = "build" </> replaceExtension tempElm "js"
    
    nodeArgs = [tempJS]
    elmArgs  = ["--make", "--only-js", "--print-types", tempElm]

    run name args nextComputation =
      let failure message = BSC.putStrLn message >> return False
          missingExe = unlines [ "Error: '" ++ name ++ "' command not found."
                               , "  Do you have it installed?"
                               , "  Can it be run from anywhere? I.e. is it on your PATH?" ]
      in
      do (_, stdout, _, handle') <- createProcess (proc name args) { std_out = CreatePipe }
         exitCode <- waitForProcess handle'
         case (exitCode, stdout) of
           (ExitFailure 127, _)      -> failure $ BSC.pack missingExe
           (_, Nothing)              -> failure "Unknown error!"
           (ExitFailure _, Just out) -> failure =<< BSC.hGetContents out
           (ExitSuccess  , Just out) ->
               do nextComputation =<< BS.hGetContents out
                  return True

reformatJS :: String -> IO ()
reformatJS tempJS =
  do rts <- BS.readFile =<< Elm.runtime
     src <- BS.readFile tempJS
     BS.length src `seq` BS.writeFile tempJS (BS.concat [rts,src,out])
  where
    out = BS.concat
          [ "var context = { inputs:[] };\n"
          , "var repl = Elm.Repl.make(context);\n"
          , "if ('", Env.output, "' in repl)\n"
          , "  console.log(context.Native.Show.values.show(repl.", Env.output, "));" ]

scrapeOutputType :: BS.ByteString -> BS.ByteString
scrapeOutputType types
    | name == Env.output = tipe
    | BS.null rest       = ""
    | otherwise          = scrapeOutputType rest
    where
      (next,rest) = freshLine types
      (name,tipe) = BSC.splitAt (BSC.length Env.output) next

      freshLine str
          | BSC.take 2 rest' == "\n " = (BS.append line line', rest'')
          | BS.null rest' = (line,"")
          | otherwise    = (line, BS.tail rest')
          where
            (line,rest') = BSC.break (=='\n') str
            (line',rest'') = freshLine rest'

removeIfExists :: FilePath -> IO ()
removeIfExists fileName = removeFile fileName `Control.Exception.catch` handleExists
  where handleExists e
          | isDoesNotExistError e = return ()
          | otherwise = throwIO e