Fix broken build.

This commit is contained in:
evancz 2013-06-09 23:36:59 -07:00
parent 776ef7c3f9
commit 569541e72a

View file

@ -67,24 +67,25 @@ compileArgs flags =
type Interface = String type Interface = String
file :: Flags -> FilePath -> String -> FilePath
file flags filePath ext = output_directory flags </> replaceExtension filePath ext
elmo :: Flags -> FilePath -> FilePath
elmo flags filePath = file flags filePath "elmo"
buildFile :: Flags -> Int -> Int -> FilePath -> IO Interface buildFile :: Flags -> Int -> Int -> FilePath -> IO Interface
buildFile flags moduleNum numModules filePath = buildFile flags moduleNum numModules filePath =
do compiled <- alreadyCompiled do compiled <- alreadyCompiled
if compiled then getInterface else compile if compiled then readFile (elmo flags filePath) else compile
where where
file :: String -> FilePath
file ext = output_directory flags </> replaceExtension filePath ext
interface :: FilePath
interface = file "elmi"
alreadyCompiled :: IO Bool alreadyCompiled :: IO Bool
alreadyCompiled = do alreadyCompiled = do
exists <- doesFileExist interface exists <- doesFileExist (elmo flags filePath)
if not exists then return False if not exists then return False
else do tsrc <- getModificationTime filePath else do tsrc <- getModificationTime filePath
tint <- getModificationTime interface tint <- getModificationTime (elmo flags filePath)
return (tsrc < tint) return (tsrc < tint)
number :: String number :: String
@ -97,19 +98,16 @@ buildFile flags moduleNum numModules filePath =
compile = do compile = do
putStrLn (number ++ " Compiling " ++ name) putStrLn (number ++ " Compiling " ++ name)
source <- readFile filePath source <- readFile filePath
(inter,obj) <- (interface,obj) <-
if takeExtension filePath == ".js" then return ("",source) else if takeExtension filePath == ".js" then return ("",source) else
case buildFromSource (no_prelude flags) source of case buildFromSource (no_prelude flags) source of
Left err -> putStrLn err >> exitFailure Left err -> putStrLn err >> exitFailure
Right modul -> return (show modul, jsModule modul) Right modul -> do exs <- exportInfo modul
return (exs, jsModule modul)
createDirectoryIfMissing True (output_directory flags) createDirectoryIfMissing True (output_directory flags)
writeFile interface inter writeFile (elmo flags filePath) obj
writeFile (file "elmo") obj return obj
return inter
getInterface :: IO Interface
getInterface = do
readFile interface
getRuntime :: Flags -> IO FilePath getRuntime :: Flags -> IO FilePath
getRuntime flags = getRuntime flags =
@ -125,19 +123,19 @@ build flags rootFile = do
case only_js flags of case only_js flags of
True -> do True -> do
putStr "Generating JavaScript ... " putStr "Generating JavaScript ... "
writeFile (replaceExtension rootFile "js") (genJs js) writeFile (file flags rootFile "js") (genJs js)
putStrLn "Done" putStrLn "Done"
False -> do False -> do
putStr "Generating HTML ... " putStr "Generating HTML ... "
runtime <- getRuntime flags runtime <- getRuntime flags
let html = genHtml $ createHtml runtime rootFile (sources js) "" let html = genHtml $ createHtml runtime rootFile (sources js) ""
writeFile (replaceExtension rootFile "html") html writeFile (file flags rootFile "html") html
putStrLn "Done" putStrLn "Done"
where where
appendToOutput :: String -> FilePath -> IO String appendToOutput :: String -> FilePath -> IO String
appendToOutput js filePath = appendToOutput js filePath =
do src <- readFile (output_directory flags </> replaceExtension filePath "elmo") do src <- readFile (elmo flags filePath)
return (src ++ js) return (src ++ js)
genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml
@ -153,3 +151,9 @@ buildFiles flags numModules interfaces (filePath:rest) = do
let moduleName = intercalate "." (splitDirectories (dropExtensions filePath)) let moduleName = intercalate "." (splitDirectories (dropExtensions filePath))
interfaces' = Map.insert moduleName interface interfaces interfaces' = Map.insert moduleName interface interfaces
buildFiles flags numModules interfaces' rest buildFiles flags numModules interfaces' rest
exportInfo :: Module -> IO String
exportInfo (Module names exs ims stmts) =
do print exs
return (show exs)