module Haste.Compiler (
module Haste.Compiler.Flags,
CompileResult (..), HasteOutput (..), HasteInput (..),
compile
) where
import Haste.Compiler.Flags
#ifndef __HASTE__
import Control.Shell
import Haste.Environment
import Data.List (intercalate)
#endif
data CompileResult = Success HasteOutput | Failure String deriving Show
data HasteOutput = OutFile FilePath | OutString String deriving Show
data HasteInput = InFile FilePath | InString String deriving Show
compile :: CompileFlags -> FilePath -> HasteInput -> IO CompileResult
#ifdef __HASTE__
compile _ _ _ = return $ Failure "Haste can only compile programs server-side."
#else
compile cf dir inp = do
eresult <- shell $ do
curdir <- pwd
inTempDirectory $ do
fil <- case inp of
InFile f -> return $ if isRelative f then incdir curdir </> f else f
InString s -> file "Main.hs" s >>= \() -> return "Main.hs"
(f,_,e) <- genericRun hasteBinary (fil : idir curdir : mkFlags cf) ""
if not f
then do
return $ Failure e
else do
case cfTarget cf of
TargetFile tgt -> do
return $ Success $ OutFile tgt
TargetString -> do
(Success . OutString) `fmap` file "haste.out"
case eresult of
Right result ->
return result
Left e ->
return $ Failure $ "Run-time failure during compilation: " ++ e
where
incdir cur = if isRelative dir then cur </> dir else dir
idir cur = "-i" ++ incdir cur
mkFlags :: CompileFlags -> [String]
mkFlags cf = concat [
case cfOptimize cf of
None -> ["-O0", "--ddisable-js-opts"]
Basic -> []
WholeProgram -> ["--opt-whole-program"],
case cfStart cf of
ASAP -> ["--onexec"]
OnLoad -> ["--onload"]
Custom s -> ["--start=" ++ s],
case cfTarget cf of
TargetFile fp -> ["--out=" ++ fp]
TargetString -> ["--out=haste.out"],
case cfMinify cf of
DontMinify -> []
Minify (Just p) fs -> ("--opt-minify="++p) : map appendMinifyFlag fs
Minify _ fs -> "--opt-minify" : map appendMinifyFlag fs,
when cfDebug "--debug",
when cfFullUnicode "--full-unicode",
when cfOwnNamespace "--separate-namespace",
when (not . null . cfJSFiles) ("--with-js=" ++ jsFileList),
when (not . cfUseStrict) "--no-use-strict"
]
where
appendMinifyFlag f = "--opt-minify-flag=" ++ f
jsFileList = intercalate "," $ cfJSFiles cf
when opt arg = if opt cf then [arg] else []
#endif