Finish refactoring code into Build/ directory, make some names more consistent and remove unneeded dependencies
This commit is contained in:
parent
6cb3b30062
commit
dac51abc88
10 changed files with 240 additions and 191 deletions
16
Elm.cabal
16
Elm.cabal
|
@ -53,7 +53,6 @@ Library
|
||||||
Transform.Substitute,
|
Transform.Substitute,
|
||||||
Transform.Optimize,
|
Transform.Optimize,
|
||||||
Metadata.Prelude,
|
Metadata.Prelude,
|
||||||
Initialize,
|
|
||||||
InterfaceSerialization,
|
InterfaceSerialization,
|
||||||
Parse.Binop,
|
Parse.Binop,
|
||||||
Parse.Declaration,
|
Parse.Declaration,
|
||||||
|
@ -78,6 +77,13 @@ Library
|
||||||
Type.State,
|
Type.State,
|
||||||
Type.Type,
|
Type.Type,
|
||||||
Type.Unify,
|
Type.Unify,
|
||||||
|
Build.Dependencies,
|
||||||
|
Build.File,
|
||||||
|
Build.Flags,
|
||||||
|
Build.Info,
|
||||||
|
Build.Print,
|
||||||
|
Build.Source,
|
||||||
|
Build.Utils,
|
||||||
Paths_Elm
|
Paths_Elm
|
||||||
|
|
||||||
Build-depends: base >=4.2 && <5,
|
Build-depends: base >=4.2 && <5,
|
||||||
|
@ -124,7 +130,6 @@ Executable elm
|
||||||
Transform.Substitute,
|
Transform.Substitute,
|
||||||
Transform.Optimize,
|
Transform.Optimize,
|
||||||
Metadata.Prelude,
|
Metadata.Prelude,
|
||||||
Initialize,
|
|
||||||
InterfaceSerialization,
|
InterfaceSerialization,
|
||||||
Parse.Binop,
|
Parse.Binop,
|
||||||
Parse.Declaration,
|
Parse.Declaration,
|
||||||
|
@ -149,6 +154,13 @@ Executable elm
|
||||||
Type.State,
|
Type.State,
|
||||||
Type.Type,
|
Type.Type,
|
||||||
Type.Unify,
|
Type.Unify,
|
||||||
|
Build.Dependencies,
|
||||||
|
Build.File,
|
||||||
|
Build.Flags,
|
||||||
|
Build.Info,
|
||||||
|
Build.Print,
|
||||||
|
Build.Source,
|
||||||
|
Build.Utils,
|
||||||
Paths_Elm
|
Paths_Elm
|
||||||
|
|
||||||
Build-depends: base >=4.2 && <5,
|
Build-depends: base >=4.2 && <5,
|
||||||
|
|
|
@ -1,158 +0,0 @@
|
||||||
module Build.Build (build) where
|
|
||||||
|
|
||||||
import Control.Monad (when, forM_, foldM)
|
|
||||||
import qualified Data.Map as Map
|
|
||||||
import qualified Data.List as List
|
|
||||||
import qualified Data.Binary as Binary
|
|
||||||
import System.Directory
|
|
||||||
import System.Exit
|
|
||||||
import System.FilePath
|
|
||||||
import System.IO
|
|
||||||
|
|
||||||
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
|
|
||||||
import qualified Data.ByteString.Lazy.Char8 as BS
|
|
||||||
import qualified Data.ByteString.Lazy as L
|
|
||||||
|
|
||||||
import qualified Metadata.Prelude as Prelude
|
|
||||||
import qualified Transform.Canonicalize as Canonical
|
|
||||||
import SourceSyntax.Module
|
|
||||||
import Parse.Module (getModuleName)
|
|
||||||
import qualified Build.FromSource as FromSource
|
|
||||||
import Build.Dependencies (getSortedDependencies)
|
|
||||||
import Generate.JavaScript (jsModule)
|
|
||||||
import Generate.Html (createHtml, JSSource(..))
|
|
||||||
import qualified InterfaceSerialization as IS
|
|
||||||
|
|
||||||
import SourceSyntax.PrettyPrint (pretty, variable)
|
|
||||||
import Text.PrettyPrint as P
|
|
||||||
import qualified Type.Alias as Alias
|
|
||||||
|
|
||||||
import qualified Build.Utils as Utils
|
|
||||||
import qualified Build.Info as Info
|
|
||||||
import qualified Build.Flags as Flag
|
|
||||||
|
|
||||||
buildFile :: Flag.Flags -> Int -> Int -> Interfaces -> FilePath -> IO (String, ModuleInterface)
|
|
||||||
buildFile flags moduleNum numModules interfaces filePath = do
|
|
||||||
compiled <- alreadyCompiled
|
|
||||||
if not compiled then compile else do
|
|
||||||
bytes <- IS.loadInterface (Utils.elmi flags filePath)
|
|
||||||
let binary = IS.interfaceDecode (Utils.elmi flags filePath) =<< bytes
|
|
||||||
case IS.validVersion filePath =<< binary of
|
|
||||||
Left err -> do
|
|
||||||
hPutStrLn stderr err
|
|
||||||
exitFailure
|
|
||||||
|
|
||||||
Right (name, interface) -> do
|
|
||||||
when (Flag.print_types flags) $
|
|
||||||
printTypes interfaces
|
|
||||||
(iTypes interface)
|
|
||||||
(iAliases interface)
|
|
||||||
(iImports interface)
|
|
||||||
|
|
||||||
return (name, interface)
|
|
||||||
|
|
||||||
where
|
|
||||||
alreadyCompiled :: IO Bool
|
|
||||||
alreadyCompiled = do
|
|
||||||
existsi <- doesFileExist (Utils.elmi flags filePath)
|
|
||||||
existso <- doesFileExist (Utils.elmo flags filePath)
|
|
||||||
if not existsi || not existso
|
|
||||||
then return False
|
|
||||||
else do tsrc <- getModificationTime filePath
|
|
||||||
tint <- getModificationTime (Utils.elmo flags filePath)
|
|
||||||
return (tsrc <= tint)
|
|
||||||
|
|
||||||
number :: String
|
|
||||||
number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
|
|
||||||
|
|
||||||
compile :: IO (String,ModuleInterface)
|
|
||||||
compile = do
|
|
||||||
source <- readFile filePath
|
|
||||||
let name = case getModuleName source of
|
|
||||||
Just n -> n
|
|
||||||
Nothing -> "Main"
|
|
||||||
putStrLn $ concat [ number, " Compiling ", name
|
|
||||||
, replicate (max 1 (20 - length name)) ' '
|
|
||||||
, "( " ++ filePath ++ " )" ]
|
|
||||||
|
|
||||||
createDirectoryIfMissing True (Flag.cache_dir flags)
|
|
||||||
createDirectoryIfMissing True (Flag.build_dir flags)
|
|
||||||
|
|
||||||
metaModule <-
|
|
||||||
case FromSource.build (Flag.no_prelude flags) interfaces source of
|
|
||||||
Left errors -> do
|
|
||||||
mapM print (List.intersperse (P.text " ") errors)
|
|
||||||
exitFailure
|
|
||||||
Right modul -> return modul
|
|
||||||
|
|
||||||
when (Flag.print_types flags)
|
|
||||||
(printTypes interfaces
|
|
||||||
(types metaModule) (aliases metaModule) (imports metaModule))
|
|
||||||
|
|
||||||
let interface = Canonical.interface name $ ModuleInterface {
|
|
||||||
iVersion = Info.version,
|
|
||||||
iTypes = types metaModule,
|
|
||||||
iImports = imports metaModule,
|
|
||||||
iAdts = datatypes metaModule,
|
|
||||||
iAliases = aliases metaModule,
|
|
||||||
iFixities = fixities metaModule
|
|
||||||
}
|
|
||||||
|
|
||||||
createDirectoryIfMissing True . dropFileName $ Utils.elmi flags filePath
|
|
||||||
handle <- openBinaryFile (Utils.elmi flags filePath) WriteMode
|
|
||||||
L.hPut handle (Binary.encode (name,interface))
|
|
||||||
hClose handle
|
|
||||||
writeFile (Utils.elmo flags filePath) (jsModule metaModule)
|
|
||||||
return (name,interface)
|
|
||||||
|
|
||||||
printTypes interfaces moduleTypes moduleAliases moduleImports = do
|
|
||||||
putStrLn ""
|
|
||||||
let rules = Alias.rules interfaces moduleAliases moduleImports
|
|
||||||
forM_ (Map.toList moduleTypes) $ \(n,t) -> do
|
|
||||||
print $ variable n <+> P.text ":" <+> pretty (Alias.realias rules t)
|
|
||||||
putStrLn ""
|
|
||||||
|
|
||||||
build :: Flag.Flags -> FilePath -> IO ()
|
|
||||||
build flags rootFile = do
|
|
||||||
let noPrelude = Flag.no_prelude flags
|
|
||||||
builtIns <- if noPrelude then return Map.empty else Prelude.interfaces
|
|
||||||
|
|
||||||
files <- if Flag.make flags
|
|
||||||
then getSortedDependencies (Flag.src_dir flags) builtIns rootFile
|
|
||||||
else return [rootFile]
|
|
||||||
|
|
||||||
(moduleName, interfaces) <- buildFiles flags (length files) builtIns "" files
|
|
||||||
|
|
||||||
js <- foldM appendToOutput BS.empty files
|
|
||||||
|
|
||||||
(extension, code) <- case Flag.only_js flags of
|
|
||||||
True -> do
|
|
||||||
putStr "Generating JavaScript ... "
|
|
||||||
return ("js", js)
|
|
||||||
False -> do
|
|
||||||
putStr "Generating HTML ... "
|
|
||||||
rtsPath <- case Flag.runtime flags of
|
|
||||||
Just fp -> return fp
|
|
||||||
Nothing -> Info.runtime
|
|
||||||
return ("html", renderHtml $
|
|
||||||
createHtml rtsPath (takeBaseName rootFile) (sources js) moduleName "")
|
|
||||||
|
|
||||||
let targetFile = Utils.buildPath flags rootFile extension
|
|
||||||
createDirectoryIfMissing True (takeDirectory targetFile)
|
|
||||||
BS.writeFile targetFile code
|
|
||||||
putStrLn "Done"
|
|
||||||
|
|
||||||
where
|
|
||||||
appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString
|
|
||||||
appendToOutput js filePath =
|
|
||||||
do src <- BS.readFile (Utils.elmo flags filePath)
|
|
||||||
return (BS.append src js)
|
|
||||||
|
|
||||||
sources js = map Link (Flag.scripts flags) ++ [ Source js ]
|
|
||||||
|
|
||||||
buildFiles :: Flag.Flags -> Int -> Interfaces -> String -> [FilePath] -> IO (String, Interfaces)
|
|
||||||
buildFiles _ _ interfaces moduleName [] = return (moduleName, interfaces)
|
|
||||||
buildFiles flags numModules interfaces _ (filePath:rest) = do
|
|
||||||
(name,interface) <- buildFile flags (numModules - length rest) numModules interfaces filePath
|
|
||||||
let interfaces' = Map.insert name interface interfaces
|
|
||||||
buildFiles flags numModules interfaces' name rest
|
|
106
compiler/Build/File.hs
Normal file
106
compiler/Build/File.hs
Normal file
|
@ -0,0 +1,106 @@
|
||||||
|
module Build.File (build) where
|
||||||
|
|
||||||
|
import Control.Monad (when)
|
||||||
|
import qualified Data.Binary as Binary
|
||||||
|
import qualified Data.List as List
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
import System.Directory
|
||||||
|
import System.Exit
|
||||||
|
import System.FilePath
|
||||||
|
import System.IO
|
||||||
|
|
||||||
|
import qualified Transform.Canonicalize as Canonical
|
||||||
|
|
||||||
|
import qualified Data.ByteString.Lazy as L
|
||||||
|
|
||||||
|
import qualified Build.Utils as Utils
|
||||||
|
import qualified Build.Flags as Flag
|
||||||
|
import qualified Build.Source as Source
|
||||||
|
import qualified Build.Print as Print
|
||||||
|
import qualified Generate.JavaScript as JS
|
||||||
|
import qualified InterfaceSerialization as IS
|
||||||
|
import qualified Parse.Module as Parser
|
||||||
|
import qualified SourceSyntax.Module as M
|
||||||
|
|
||||||
|
build :: Flag.Flags -> Int -> M.Interfaces -> String -> [FilePath]
|
||||||
|
-> IO (String, M.Interfaces)
|
||||||
|
build _ _ interfaces moduleName [] =
|
||||||
|
return (moduleName, interfaces)
|
||||||
|
build flags numModules interfaces _ (filePath:rest) =
|
||||||
|
do (name,interface) <-
|
||||||
|
build1 flags (numModules - length rest) numModules interfaces filePath
|
||||||
|
let interfaces' = Map.insert name interface interfaces
|
||||||
|
build flags numModules interfaces' name rest
|
||||||
|
|
||||||
|
|
||||||
|
build1 :: Flag.Flags -> Int -> Int -> M.Interfaces -> FilePath
|
||||||
|
-> IO (String, M.ModuleInterface)
|
||||||
|
build1 flags moduleNum numModules interfaces filePath =
|
||||||
|
do compiled <- alreadyCompiled flags filePath
|
||||||
|
case compiled of
|
||||||
|
False -> compile flags number interfaces filePath
|
||||||
|
True -> retrieve flags interfaces filePath
|
||||||
|
where
|
||||||
|
number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
|
||||||
|
|
||||||
|
|
||||||
|
alreadyCompiled :: Flag.Flags -> FilePath -> IO Bool
|
||||||
|
alreadyCompiled flags filePath = do
|
||||||
|
existsi <- doesFileExist (Utils.elmi flags filePath)
|
||||||
|
existso <- doesFileExist (Utils.elmo flags filePath)
|
||||||
|
if not existsi || not existso
|
||||||
|
then return False
|
||||||
|
else do tsrc <- getModificationTime filePath
|
||||||
|
tint <- getModificationTime (Utils.elmo flags filePath)
|
||||||
|
return (tsrc <= tint)
|
||||||
|
|
||||||
|
retrieve :: Flag.Flags -> Map.Map String M.ModuleInterface -> FilePath
|
||||||
|
-> IO (String, M.ModuleInterface)
|
||||||
|
retrieve flags interfaces filePath = do
|
||||||
|
bytes <- IS.loadInterface (Utils.elmi flags filePath)
|
||||||
|
let binary = IS.interfaceDecode (Utils.elmi flags filePath) =<< bytes
|
||||||
|
case IS.validVersion filePath =<< binary of
|
||||||
|
Right (name, interface) ->
|
||||||
|
do when (Flag.print_types flags) (Print.interfaceTypes interfaces interface)
|
||||||
|
return (name, interface)
|
||||||
|
Left err ->
|
||||||
|
do hPutStrLn stderr err
|
||||||
|
exitFailure
|
||||||
|
|
||||||
|
compile :: Flag.Flags -> String -> M.Interfaces -> FilePath
|
||||||
|
-> IO (String, M.ModuleInterface)
|
||||||
|
compile flags number interfaces filePath =
|
||||||
|
do source <- readFile filePath
|
||||||
|
let name = getName source
|
||||||
|
printStatus name
|
||||||
|
|
||||||
|
createDirectoryIfMissing True (Flag.cache_dir flags)
|
||||||
|
createDirectoryIfMissing True (Flag.build_dir flags)
|
||||||
|
|
||||||
|
metaModule <-
|
||||||
|
case Source.build (Flag.no_prelude flags) interfaces source of
|
||||||
|
Right modul -> return modul
|
||||||
|
Left errors -> do Print.errors errors
|
||||||
|
exitFailure
|
||||||
|
|
||||||
|
when (Flag.print_types flags) $ Print.metaTypes interfaces metaModule
|
||||||
|
|
||||||
|
let intermediate = (name, Canonical.interface name $ M.metaToInterface metaModule)
|
||||||
|
generateCache intermediate metaModule
|
||||||
|
return intermediate
|
||||||
|
|
||||||
|
where
|
||||||
|
getName source = case Parser.getModuleName source of
|
||||||
|
Just n -> n
|
||||||
|
Nothing -> "Main"
|
||||||
|
|
||||||
|
printStatus name =
|
||||||
|
hPutStrLn stdout $ concat [ number, " Compiling ", name
|
||||||
|
, replicate (max 1 (20 - length name)) ' '
|
||||||
|
, "( " ++ filePath ++ " )" ]
|
||||||
|
|
||||||
|
generateCache intermediate metaModule = do
|
||||||
|
createDirectoryIfMissing True . dropFileName $ Utils.elmi flags filePath
|
||||||
|
writeFile (Utils.elmo flags filePath) (JS.generate metaModule)
|
||||||
|
withBinaryFile (Utils.elmi flags filePath) WriteMode $ \handle ->
|
||||||
|
L.hPut handle (Binary.encode intermediate)
|
32
compiler/Build/Print.hs
Normal file
32
compiler/Build/Print.hs
Normal file
|
@ -0,0 +1,32 @@
|
||||||
|
module Build.Print where
|
||||||
|
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
import qualified Data.List as List
|
||||||
|
import qualified SourceSyntax.Module as M
|
||||||
|
import qualified SourceSyntax.PrettyPrint as Pretty
|
||||||
|
import qualified Type.Alias as Alias
|
||||||
|
import qualified Text.PrettyPrint as P
|
||||||
|
|
||||||
|
metaTypes :: Map.Map String M.ModuleInterface -> M.MetadataModule () () -> IO ()
|
||||||
|
metaTypes interfaces meta =
|
||||||
|
types interfaces (M.types meta) (M.aliases meta) (M.imports meta)
|
||||||
|
|
||||||
|
interfaceTypes :: Map.Map String M.ModuleInterface -> M.ModuleInterface -> IO ()
|
||||||
|
interfaceTypes interfaces iface =
|
||||||
|
types interfaces (M.iTypes iface) (M.iAliases iface) (M.iImports iface)
|
||||||
|
|
||||||
|
types interfaces types' aliases imports =
|
||||||
|
do putStrLn ""
|
||||||
|
mapM_ printType (Map.toList types')
|
||||||
|
putStrLn ""
|
||||||
|
where
|
||||||
|
rules = Alias.rules interfaces aliases imports
|
||||||
|
|
||||||
|
printType (n,t) = do
|
||||||
|
print $ P.hsep [ Pretty.variable n
|
||||||
|
, P.text ":"
|
||||||
|
, Pretty.pretty (Alias.realias rules t) ]
|
||||||
|
|
||||||
|
errors :: [P.Doc] -> IO ()
|
||||||
|
errors errs =
|
||||||
|
mapM_ print (List.intersperse (P.text " ") errs)
|
|
@ -1,4 +1,4 @@
|
||||||
module Build.FromSource (build) where
|
module Build.Source (build) where
|
||||||
|
|
||||||
import Data.Data
|
import Data.Data
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
|
@ -1,16 +1,71 @@
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import System.Console.CmdArgs
|
import Control.Monad (foldM)
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
import qualified Text.Blaze.Html.Renderer.Utf8 as Blaze
|
||||||
|
import qualified Data.ByteString.Lazy.Char8 as BS
|
||||||
|
import qualified System.Console.CmdArgs as CmdArgs
|
||||||
|
import System.Directory
|
||||||
|
import System.FilePath
|
||||||
import GHC.Conc
|
import GHC.Conc
|
||||||
import Build.Flags
|
|
||||||
import Build.Build
|
import Build.Dependencies (getSortedDependencies)
|
||||||
|
import qualified Generate.Html as Html
|
||||||
|
import qualified Metadata.Prelude as Prelude
|
||||||
|
import qualified Build.Utils as Utils
|
||||||
|
import qualified Build.Info as Info
|
||||||
|
import qualified Build.Flags as Flag
|
||||||
|
import qualified Build.File as File
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do setNumCapabilities =<< getNumProcessors
|
main = do setNumCapabilities =<< getNumProcessors
|
||||||
compileArgs =<< cmdArgs flags
|
compileArgs =<< CmdArgs.cmdArgs Flag.flags
|
||||||
|
|
||||||
compileArgs :: Flags -> IO ()
|
compileArgs :: Flag.Flags -> IO ()
|
||||||
compileArgs flags =
|
compileArgs flags =
|
||||||
case files flags of
|
case Flag.files flags of
|
||||||
[] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
|
[] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
|
||||||
fs -> mapM_ (build flags) fs
|
fs -> mapM_ (build flags) fs
|
||||||
|
|
||||||
|
build :: Flag.Flags -> FilePath -> IO ()
|
||||||
|
build flags rootFile =
|
||||||
|
do let noPrelude = Flag.no_prelude flags
|
||||||
|
builtIns <- if noPrelude then return Map.empty else Prelude.interfaces
|
||||||
|
|
||||||
|
files <- if Flag.make flags
|
||||||
|
then getSortedDependencies (Flag.src_dir flags) builtIns rootFile
|
||||||
|
else return [rootFile]
|
||||||
|
|
||||||
|
(moduleName, interfaces) <-
|
||||||
|
File.build flags (length files) builtIns "" files
|
||||||
|
|
||||||
|
js <- foldM appendToOutput BS.empty files
|
||||||
|
|
||||||
|
(extension, code) <-
|
||||||
|
if Flag.only_js flags
|
||||||
|
then do putStr "Generating JavaScript ... "
|
||||||
|
return ("js", js)
|
||||||
|
else do putStr "Generating HTML ... "
|
||||||
|
makeHtml js moduleName
|
||||||
|
|
||||||
|
let targetFile = Utils.buildPath flags rootFile extension
|
||||||
|
createDirectoryIfMissing True (takeDirectory targetFile)
|
||||||
|
BS.writeFile targetFile code
|
||||||
|
putStrLn "Done"
|
||||||
|
|
||||||
|
where
|
||||||
|
appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString
|
||||||
|
appendToOutput js filePath = do
|
||||||
|
src <- BS.readFile (Utils.elmo flags filePath)
|
||||||
|
return (BS.append src js)
|
||||||
|
|
||||||
|
sources js = map Html.Link (Flag.scripts flags) ++ [ Html.Source js ]
|
||||||
|
|
||||||
|
makeHtml js moduleName = do
|
||||||
|
rtsPath <- case Flag.runtime flags of
|
||||||
|
Just fp -> return fp
|
||||||
|
Nothing -> Info.runtime
|
||||||
|
|
||||||
|
let html = Html.generate
|
||||||
|
rtsPath (takeBaseName rootFile) (sources js) moduleName ""
|
||||||
|
return ("html", Blaze.renderHtml html)
|
||||||
|
|
|
@ -1,8 +1,5 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module Generate.Html
|
module Generate.Html (generate, JSSource(..)) where
|
||||||
(createHtml,
|
|
||||||
JSSource (..)
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Text.Blaze (preEscapedToMarkup)
|
import Text.Blaze (preEscapedToMarkup)
|
||||||
import qualified Text.Blaze.Html5 as H
|
import qualified Text.Blaze.Html5 as H
|
||||||
|
@ -20,8 +17,8 @@ makeScript source =
|
||||||
H.script ! A.type_ "text/javascript" $
|
H.script ! A.type_ "text/javascript" $
|
||||||
preEscapedToMarkup $ BS.unpack src
|
preEscapedToMarkup $ BS.unpack src
|
||||||
|
|
||||||
createHtml :: FilePath -> String -> [JSSource] -> String -> String -> H.Html
|
generate :: FilePath -> String -> [JSSource] -> String -> String -> H.Html
|
||||||
createHtml libLoc title scripts moduleName noscript =
|
generate libLoc title scripts moduleName noscript =
|
||||||
H.docTypeHtml $ do
|
H.docTypeHtml $ do
|
||||||
H.head $ do
|
H.head $ do
|
||||||
H.meta ! A.charset "UTF-8"
|
H.meta ! A.charset "UTF-8"
|
||||||
|
|
|
@ -290,8 +290,8 @@ clause span variable (Case.Clause value vars mtch) =
|
||||||
is -> drop (last is + 1) name
|
is -> drop (last is + 1) name
|
||||||
|
|
||||||
|
|
||||||
jsModule :: MetadataModule () () -> String
|
generate :: MetadataModule () () -> String
|
||||||
jsModule modul =
|
generate modul =
|
||||||
show . prettyPrint $ setup (Just "Elm") (names modul ++ ["make"]) ++
|
show . prettyPrint $ setup (Just "Elm") (names modul ++ ["make"]) ++
|
||||||
[ assign ("Elm" : names modul ++ ["make"]) (function ["elm"] programStmts) ]
|
[ assign ("Elm" : names modul ++ ["make"]) (function ["elm"] programStmts) ]
|
||||||
where
|
where
|
||||||
|
|
|
@ -8,38 +8,35 @@
|
||||||
module Language.Elm (compile, moduleName, runtime, docs) where
|
module Language.Elm (compile, moduleName, runtime, docs) where
|
||||||
|
|
||||||
import qualified Data.List as List
|
import qualified Data.List as List
|
||||||
import qualified Data.Map as Map
|
import qualified Generate.JavaScript as JS
|
||||||
import Data.Version (showVersion)
|
import qualified Build.Source as Source
|
||||||
import Generate.JavaScript (jsModule)
|
import qualified Parse.Module as Parser
|
||||||
import Initialize (buildFromSource)
|
import qualified SourceSyntax.Module as M
|
||||||
import Parse.Module (getModuleName)
|
|
||||||
import SourceSyntax.Module
|
|
||||||
import Text.Blaze.Html (Html)
|
|
||||||
import qualified Text.PrettyPrint as P
|
import qualified Text.PrettyPrint as P
|
||||||
import qualified Metadata.Prelude as Prelude
|
import qualified Metadata.Prelude as Prelude
|
||||||
import Paths_Elm
|
import qualified Paths_Elm as This
|
||||||
import System.IO.Unsafe
|
import System.IO.Unsafe
|
||||||
|
|
||||||
-- |This function compiles Elm code to JavaScript. It will return either
|
-- |This function compiles Elm code to JavaScript. It will return either
|
||||||
-- an error message or the compiled JS code.
|
-- an error message or the compiled JS code.
|
||||||
compile :: String -> Either String String
|
compile :: String -> Either String String
|
||||||
compile source =
|
compile source =
|
||||||
case buildFromSource False interfaces source of
|
case Source.build False interfaces source of
|
||||||
Left docs -> Left . unlines . List.intersperse "" $ map P.render docs
|
Left docs -> Left . unlines . List.intersperse "" $ map P.render docs
|
||||||
Right modul -> Right $ jsModule (modul :: MetadataModule () ())
|
Right modul -> Right $ JS.generate modul
|
||||||
|
|
||||||
{-# NOINLINE interfaces #-}
|
{-# NOINLINE interfaces #-}
|
||||||
interfaces :: Interfaces
|
interfaces :: M.Interfaces
|
||||||
interfaces = unsafePerformIO $ Prelude.interfaces
|
interfaces = unsafePerformIO $ Prelude.interfaces
|
||||||
|
|
||||||
-- |This function extracts the module name of a given source program.
|
-- |This function extracts the module name of a given source program.
|
||||||
moduleName :: String -> Maybe String
|
moduleName :: String -> Maybe String
|
||||||
moduleName = getModuleName
|
moduleName = Parser.getModuleName
|
||||||
|
|
||||||
-- |The absolute path to Elm's runtime system.
|
-- |The absolute path to Elm's runtime system.
|
||||||
runtime :: IO FilePath
|
runtime :: IO FilePath
|
||||||
runtime = getDataFileName "elm-runtime.js"
|
runtime = This.getDataFileName "elm-runtime.js"
|
||||||
|
|
||||||
-- |The absolute path to Elm's core library documentation.
|
-- |The absolute path to Elm's core library documentation.
|
||||||
docs :: IO FilePath
|
docs :: IO FilePath
|
||||||
docs = getDataFileName "docs.json"
|
docs = This.getDataFileName "docs.json"
|
||||||
|
|
|
@ -14,8 +14,7 @@ import SourceSyntax.Type
|
||||||
import System.FilePath (joinPath)
|
import System.FilePath (joinPath)
|
||||||
import Control.Monad (liftM)
|
import Control.Monad (liftM)
|
||||||
|
|
||||||
import Paths_Elm (version)
|
import qualified Build.Info as Info
|
||||||
import Data.Version (showVersion)
|
|
||||||
|
|
||||||
data Module tipe var =
|
data Module tipe var =
|
||||||
Module [String] Exports Imports [Declaration tipe var]
|
Module [String] Exports Imports [Declaration tipe var]
|
||||||
|
@ -70,6 +69,15 @@ data ModuleInterface = ModuleInterface {
|
||||||
iFixities :: [(Assoc, Int, String)]
|
iFixities :: [(Assoc, Int, String)]
|
||||||
} deriving Show
|
} deriving Show
|
||||||
|
|
||||||
|
metaToInterface metaModule =
|
||||||
|
ModuleInterface
|
||||||
|
{ iVersion = Info.version
|
||||||
|
, iTypes = types metaModule
|
||||||
|
, iImports = imports metaModule
|
||||||
|
, iAdts = datatypes metaModule
|
||||||
|
, iAliases = aliases metaModule
|
||||||
|
, iFixities = fixities metaModule
|
||||||
|
}
|
||||||
|
|
||||||
instance Binary ModuleInterface where
|
instance Binary ModuleInterface where
|
||||||
get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get
|
get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get
|
||||||
|
|
Loading…
Reference in a new issue