on 9cda2b2 help sign in
elk/src/Compiler.hs
77 lines 2.6 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Main where
4import GHC.Conc (getNumProcessors, setNumCapabilities)
7main :: IO ()
8main =
9 do setNumCapabilities =<< getNumProcessors
10 error "currently out of order"
12{--
13compileArgs :: Flag.Flags -> IO ()
14compileArgs flags =
15 do when (Flag.get_runtime flags) $ do
16 putStrLn Utils.runtime
17 exitSuccess
18 case Flag.files flags of
19 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
20 fs -> mapM_ (build flags) fs
22build :: Flag.Flags -> FilePath -> IO ()
23build flags rootFile =
24 do let noPrelude = Flag.no_prelude flags
25 builtIns <- Prelude.interfaces noPrelude
27 (Recipe elmFiles jsFiles) <-
28 if Flag.make flags
29 then Utils.run (getBuildRecipe (Flag.src_dir flags) builtIns rootFile)
30 else return (Recipe [rootFile] [])
32 moduleName <- File.build flags builtIns elmFiles
34 let elmos = map (Utils.elmo flags) elmFiles
35 js <- foldM appendToOutput BS.empty (elmos ++ jsFiles)
37 (extension, code) <-
38 if Flag.only_js flags
39 then do putStr "Generating JavaScript ... "
40 makeJs js
41 else do putStr "Generating HTML ... "
42 makeHtml js moduleName
44 let targetFile = Utils.buildPath flags rootFile extension
45 createDirectoryIfMissing True (takeDirectory targetFile)
46 BS.writeFile targetFile code
47 putStrLn "Done"
49 where
50 appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString
51 appendToOutput js filePath = do
52 src <- BS.readFile filePath
53 return (BS.append src js)
55 getRuntime :: IO Html.JSSource
56 getRuntime =
57 let runtimePath = Maybe.fromMaybe Utils.runtime (Flag.set_runtime flags) in
58 case Flag.bundle_runtime flags of
59 False -> return (Html.Link runtimePath)
60 True -> Html.Source `fmap` BS.readFile runtimePath
62 makeJs :: BS.ByteString -> IO (String, BS.ByteString)
63 makeJs js =
64 do runtime <- getRuntime
65 case runtime of
66 Html.Link _ -> return ("js", js)
67 Html.Source rts -> return ("js", BS.append rts js)
69 makeHtml :: BS.ByteString -> String -> IO (String, BS.ByteString)
70 makeHtml js moduleName =
71 do runtime <- getRuntime
72 return ("html", BS.pack $ renderHtml (html runtime))
73 where
74 sources js = map Html.Link (Flag.scripts flags) ++ [ Html.Source js ]
75 html runtime =
76 Html.generate runtime (takeBaseName rootFile) (sources js) moduleName ""
77--}