git.iko.soy/elk
on d178521 help sign in
elk/elm/src/Compiler.hs
110 lines 4.5 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2module Main where
4import Data.Either (lefts, rights)
5import Data.List (intersect, intercalate)
6import Data.Maybe (fromMaybe)
7import Data.Version (showVersion)
8import System.Console.CmdArgs
9import Text.Blaze.Html.Renderer.String (renderHtml)
11import qualified Text.Jasmine as JS
12import qualified Data.ByteString.Lazy.Char8 as BS
14import Ast
15import Initialize
16import CompileToJS
17import GenerateHtml
18import Paths_Elm
21data ELM =
22 ELM { make :: Bool
23 , files :: [FilePath]
24 , runtime :: Maybe FilePath
25 , separate_js :: Bool
26 , only_js :: Bool
27 , import_js :: [FilePath]
28 , generate_noscript :: Bool
29 , minify :: Bool
30 }
31 deriving (Data,Typeable,Show,Eq)
33elm = ELM { make = False &= help "automatically compile dependencies."
34 , files = def &= args &= typ "FILES"
35 , runtime = Nothing &= typFile &=
36 help "Specify a custom location for Elm's runtime system."
37 , separate_js = False &= help "Compile to separate HTML and JS files."
38 , only_js = False &= help "Compile only to JavaScript."
39 , import_js = [] &= typFile &= help "Include a JavaScript file before the body of the Elm program. Can be used many times. Files will be included in the given order."
40 , generate_noscript = True &= help "Add generated <noscript> tag to HTML output."
41 , minify = False &= help "Minify generated JavaScript"
42 } &=
43 help "Compile Elm programs to HTML, CSS, and JavaScript." &=
44 summary ("The Elm Compiler " ++ showVersion version ++ ", (c) Evan Czaplicki")
46main = do
47 args <- cmdArgs elm
48 mini <- getDataFileName ("elm-runtime-" ++ showVersion version ++ ".js")
49 compileArgs mini args
51compileArgs mini (ELM _ [] _ _ _ _ _ _) =
52 putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
53compileArgs mini (ELM make files rtLoc split only js nscrpt isMini) =
54 mapM_ (fileTo isMini get what js nscrpt $ fromMaybe mini rtLoc) files
55 where get = if make then getModules [] else getModule
56 what = if only then JS else
57 if split then Split else HTML
59data What = JS | HTML | Split
61fileTo isMini get what jsFiles noscript rtLoc file = do
62 let jsStyle = if isMini then Minified else Readable
63 let formatJS = if isMini then BS.unpack . JS.minify . BS.pack else id
64 ems <- get file
65 jss <- concat `fmap` mapM readFile jsFiles
66 case ems of
67 Left err -> putStrLn $ "Error while compiling " ++ file ++ ":\n" ++ err
68 Right ms ->
69 let name = reverse . tail . dropWhile (/='.') $ reverse file
70 js = name ++ ".js"
71 html = name ++ ".html"
72 in case what of
73 JS -> writeFile js . formatJS $ jss ++ concatMap jsModule ms
74 HTML -> writeFile html . renderHtml $ modulesToHtml jsStyle "" rtLoc jss noscript ms
75 Split -> do
76 writeFile html . renderHtml $ linkedHtml rtLoc js ms
77 writeFile js . formatJS $ jss ++ concatMap jsModule ms
79getModules :: [String] -> FilePath -> IO (Either String [([String],Module)])
80getModules uses file = do
81 code <- readFile file
82 case initialize code of
83 Left err -> return . Left $ "Error in " ++ file ++ ":\n" ++ err
84 Right (escs, modul@(Module _ _ imports _)) ->
85 let imps = filter (`notElem` builtInModules) $ map fst imports in
86 case intersect uses imps of
87 x:_ -> return . Left $ "Error: Cyclic dependency. Module " ++
88 x ++ " depends on itself."
89 [] -> do
90 ems <- mapM (getModules (uses ++ imps) . toFilePath) imps
91 return $ case lefts ems of
92 [] -> Right $ concat (rights ems) ++ [(escs,modul)]
93 errs -> Left $ intercalate "\n" errs
95getModule :: FilePath -> IO (Either String [([String],Module)])
96getModule file = do
97 code <- readFile file
98 return . fmap (:[]) $ initialize code
100toFilePath :: String -> FilePath
101toFilePath modul = map (\c -> if c == '.' then '/' else c) modul ++ ".elm"
103builtInModules =
104 concat [ map ("Data."++) [ "List", "Char", "Maybe" ]
105 , map ("Signal."++) [ "Mouse", "Keyboard.Raw"
106 , "Window", "Time", "HTTP", "Input", "Random" ]
107 , map ("Graphics."++) [ "Element", "Text", "Color" ]
108 , map ("Foreign.JavaScript"++) [ "", "JSON", "Experimental" ]
109 , [ "Prelude" ]
110 ]