{-# LANGUAGE DeriveDataTypeable #-} module Main where import Control.Monad import qualified Data.Map as Map import qualified Data.List as List import Data.Version (showVersion) import System.Console.CmdArgs import System.Directory import System.Exit import System.FilePath import qualified Text.Blaze.Html.Renderer.Pretty as Pretty import qualified Text.Blaze.Html.Renderer.String as Normal import qualified Text.Jasmine as JS import qualified Data.ByteString.Lazy.Char8 as BS import SourceSyntax.Module import Initialize (buildFromSource, getSortedModuleNames) import Generate.JavaScript (jsModule) import Generate.Html (createHtml, JSStyle(..), JSSource(..)) import Paths_Elm import Text.PrettyPrint as P import qualified Type.Type as Type data Flags = Flags { make :: Bool , files :: [FilePath] , runtime :: Maybe FilePath , only_js :: Bool , scripts :: [FilePath] , no_prelude :: Bool , minify :: Bool , output_directory :: FilePath } deriving (Data,Typeable,Show,Eq) flags = Flags { make = False &= help "automatically compile dependencies." , files = def &= args &= typ "FILES" , runtime = Nothing &= typFile &= help "Specify a custom location for Elm's runtime system." , only_js = False &= help "Compile only to JavaScript." , scripts = [] &= typFile &= help "Load JavaScript files in generated HTML. Files will be included in the given order." , no_prelude = False &= help "Do not import Prelude by default, used only when compiling standard libraries." , minify = False &= help "Minify generated JavaScript and HTML" , output_directory = "ElmFiles" &= typFile &= help "Output files to directory specified. Defaults to ElmFiles/ directory." } &= help "Compile Elm programs to HTML, CSS, and JavaScript." &= summary ("The Elm Compiler " ++ showVersion version ++ ", (c) Evan Czaplicki") main :: IO () main = compileArgs =<< cmdArgs flags compileArgs :: Flags -> IO () compileArgs flags = case files flags of [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help" fs -> mapM_ (build flags) fs 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" elmi flags filePath = file flags filePath "elmi" buildFile :: Flags -> Int -> Int -> FilePath -> IO Interface buildFile flags moduleNum numModules filePath = do compiled <- alreadyCompiled if compiled then readFile (elmo flags filePath) else compile where alreadyCompiled :: IO Bool alreadyCompiled = do exists <- doesFileExist (elmo flags filePath) if not exists then return False else do tsrc <- getModificationTime filePath tint <- getModificationTime (elmo flags filePath) return (tsrc < tint) number :: String number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]" name :: String name = List.intercalate "." (splitDirectories (dropExtensions filePath)) compile :: IO Interface compile = do putStrLn (number ++ " Compiling " ++ name) source <- readFile filePath (js, maybeModule) <- if takeExtension filePath == ".js" then return (source, Nothing) else case buildFromSource (no_prelude flags) source of Left err -> mapM print err >> exitFailure Right modul -> return (jsModule modul, Just modul) createDirectoryIfMissing True (output_directory flags) writeFile (elmo flags filePath) js writeTypes maybeModule return js writeTypes :: Maybe (MetadataModule () ()) -> IO () writeTypes maybeModule = case maybeModule of Nothing -> return () Just metaModule -> do tipes <- forM (Map.toList (types metaModule)) $ \(n,t) -> do pt <- Type.extraPretty t return $ P.text n <+> P.text ":" <+> pt writeFile (elmi flags filePath) (P.render $ P.vcat tipes) getRuntime :: Flags -> IO FilePath getRuntime flags = case runtime flags of Just fp -> return fp Nothing -> getDataFileName "elm-runtime.js" build :: Flags -> FilePath -> IO () build flags rootFile = do files <- if make flags then getSortedModuleNames rootFile else return [rootFile] buildFiles flags (length files) Map.empty files js <- foldM appendToOutput "" files case only_js flags of True -> do putStr "Generating JavaScript ... " writeFile (file flags rootFile "js") (genJs js) putStrLn "Done" False -> do putStr "Generating HTML ... " runtime <- getRuntime flags let html = genHtml $ createHtml runtime rootFile (sources js) "" writeFile (file flags rootFile "html") html putStrLn "Done" where appendToOutput :: String -> FilePath -> IO String appendToOutput js filePath = do src <- readFile (elmo flags filePath) return (src ++ js) genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml genJs = if minify flags then BS.unpack . JS.minify . BS.pack else id sources js = map Link (scripts flags) ++ [ Source (if minify flags then Minified else Readable) js ] buildFiles :: Flags -> Int -> Map.Map String Interface -> [FilePath] -> IO () buildFiles _ _ _ [] = return () buildFiles flags numModules interfaces (filePath:rest) = do interface <- buildFile flags (numModules - length rest) numModules filePath let moduleName = List.intercalate "." (splitDirectories (dropExtensions filePath)) interfaces' = Map.insert moduleName interface interfaces buildFiles flags numModules interfaces' rest