@@ -10,12 +10,13 @@ import System.IO
1010import System.Process
1111
1212import Control.Monad
13+import qualified Data.Binary as Binary
1314
1415-- Part 1
1516-- ------
1617-- Add a build callout
17−-- We need to build elm-doc and run it because that generates the file "docs.json" needs by Libraries.hs
18−-- which is part of the elm library and executable
18+-- We need to build elm-doc and run it because that generates the file "docs.json"
19+-- needs by Libraries.hs which is part of the elm library and executable
1920-- Unfort. there seems to be no way to tell cabal that:
2021-- (a) elm-doc generates docs.json, and
2122-- (b) elm (library) depends on docs.json
@@ -29,19 +30,20 @@ import Control.Monad
2930
3031-- Assumptions
3132-- Elm.cabal expects the generated files to end up in dist/data
32−rtsDir lbi = buildDir lbi </> ".." </> "data" -- git won't look in dist + cabal will clean it
33−jsDir lbi = buildDir lbi </> ".." </> "js"
33+-- git won't look in dist + cabal will clean it
34+rtsDir :: LocalBuildInfo -> FilePath
35+rtsDir lbi = buildDir lbi </> ".." </> "data"
36+
37+tempDir :: LocalBuildInfo -> FilePath
38+tempDir lbi = buildDir lbi </> ".." </> "temp"
3439
3540-- The runtime is called:
41+rts :: LocalBuildInfo -> FilePath
3642rts lbi = rtsDir lbi </> "elm-runtime.js"
3743
38−-- The json file is called:
39−
40−-- The elm-docs executable is called:
41−elmDoc = "elm-doc"
42−elm_doc lbi = buildDir lbi </> elmDoc </> elmDoc
43−
44−types lbi = rtsDir lbi </> "docs.json"
44+-- The interfaces for the Standard Libraries live in:
45+interfaces :: LocalBuildInfo -> FilePath
46+interfaces lbi = rtsDir lbi </> "interfaces.data"
4547
4648-- buildDir with LocalBuildInfo points to "dist/build" (usually)
4749elm lbi = buildDir lbi </> "elm" </> "elm"
@@ -51,25 +53,11 @@ elm lbi = buildDir lbi </> "elm" </> "elm"
5153
5254
5355main :: IO ()
54−main = defaultMainWithHooks simpleUserHooks { {-- buildHook = myBuild, --} postBuild = myPostBuildWithTypes }
56+main = defaultMainWithHooks simpleUserHooks { postBuild = myPostBuild }
5557
5658
5759-- Build
5860
59−-- Not currently used. buildTypes is in 'myPostBuildWithTypes'
60−-- If using this again, change postBuild to 'myPostBuild'
61−-- Purpose is to make sure docs.json was built before elm exec was (as elm exec depended on it)
62−-- This is no longer true and the code below seems to affect cabal's build dependencies
63−myBuild :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
64−myBuild pd lbi uh bf = do
65− putStrLn $ "Custom build step started: compile " ++ elmDoc
66− withExe pd (\x -> putStrLn (exeName x))
67− buildHook simpleUserHooks (filterExe elmDoc pd) (filterLBI elmDoc lbi) uh bf
68− putStrLn "Custom build step started: build docs.json"
69− buildTypes lbi -- see note(1) below
70− putStrLn "Custom build step started: compile everything"
71− buildHook simpleUserHooks pd lbi uh bf
72−
7361-- note(1): We use to include docs.json directly into LoadLibraries at compile time
7462-- If docs.json is used in other (template) haskell files, they should be copied
7563-- and compiled in a separate directory (eg, dist/copiedSrc).
@@ -77,42 +65,81 @@ myBuild pd lbi uh bf = do
7765-- Copying is a better solution than 'touch'ing the source files
7866-- (touch is non-portable and confusing wrt RCS).
7967
80−-- In the PackageDescription, the list of stuff to build is held in library (in a Maybe)
81−-- and the executables list. We want a PackageDescription that only mentions the executable 'name'
68+-- In the PackageDescription, the list of stuff to build is held in library
69+-- (in a Maybe) and the executables list. We want a PackageDescription that
70+-- only mentions the executable 'name'
71+filterExe :: String -> PackageDescription -> PackageDescription
8272filterExe name pd = pd {
8373 library = Nothing,
8474 executables = filter (\x -> (exeName x == name)) (executables pd)
8575 }
8676
87−-- It's not enough to fix the PackageDescription, we also have to fix the LocalBuildInfo.
88−-- This includes the component build order (data ComponentName) which is horribly internal.
77+-- It's not enough to fix the PackageDescription, we also have to fix the
78+-- LocalBuildInfo. This includes the component build order (data ComponentName)
79+-- which is horribly internal.
80+filterLBI :: String -> LocalBuildInfo -> LocalBuildInfo
8981filterLBI name lbi = lbi {
9082 libraryConfig = Nothing,
9183 compBuildOrder = [CExeName name],
9284 executableConfigs = filter (\a -> (fst a == name)) (executableConfigs lbi)
9385 }
9486
95−buildTypes lbi = do
96− createDirectoryIfMissing False (rtsDir lbi) -- dist should already exist
97− files <- getFiles ".elm" "libraries"
98− system (elm_doc lbi ++ " " ++ unwords files ++ " > " ++ (types lbi))
99− putStrLn $ "Custom build step completed: " ++ elmDoc
100−
10187
10288-- Post Build
10389
104−myPostBuildWithTypes :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
105−myPostBuildWithTypes as bfs pd lbi = do
106− putStrLn "Custom build step started: build docs.json"
107− buildTypes lbi -- see note(1) below
108− myPostBuild as bfs pd lbi
109−
11090myPostBuild :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
11191myPostBuild as bfs pd lbi = do
112− putStrLn "Custom post build step started: build elm-runtime.js"
113− buildRuntime lbi
92+ putStrLn "Custom build step: compiling standard libraries"
93+ (elmos, elmis) <- compileLibraries lbi
94+ putStrLn "Custom build step: build interfaces.data"
95+ buildInterfaces lbi elmis
96+ putStrLn "Custom build step: build elm-runtime.js"
97+ buildRuntime lbi elmos
98+ removeDirectoryRecursive ("dist" </> "temp")
11499 postBuild simpleUserHooks as bfs pd lbi
115100
101+
102+compileLibraries lbi = do
103+ let temp = tempDir lbi -- dist/temp
104+ createDirectoryIfMissing True temp
105+ out_c <- canonicalizePath temp -- dist/temp (root folder)
106+ elm_c <- canonicalizePath (elm lbi) -- dist/build/elm/elm
107+ rtd_c <- canonicalizePath (rtsDir lbi) -- dist/data (for docs.json)
108+
109+ let make file = do
110+ -- replace 'system' call with 'runProcess' which handles args better
111+ -- and allows env variable "Elm_datadir" which is used by LoadLibraries
112+ -- to find docs.json
113+ let args = ["--only-js","--make","--no-prelude","--output-directory="++out_c,file]
114+ arg = Just [("Elm_datadir", rtd_c)]
115+ handle <- runProcess elm_c args Nothing arg Nothing Nothing Nothing
116+ exitCode <- waitForProcess handle
117+ return ( out_c </> replaceExtension file "elmo"
118+ , out_c </> replaceExtension file "elmi")
119+
120+ setCurrentDirectory "libraries"
121+ print =<< getCurrentDirectory
122+ files <- getFiles ".elm" "."
123+ files <- unzip `fmap` mapM make files
124+ setCurrentDirectory ".."
125+ return files
126+
127+buildInterfaces :: LocalBuildInfo -> [FilePath] -> IO ()
128+buildInterfaces lbi elmis = do
129+ createDirectoryIfMissing True (rtsDir lbi)
130+ let ifaces = interfaces lbi
131+ Binary.encodeFile ifaces (length elmis)
132+ mapM_ (\elmi -> readFile elmi >>= appendFile ifaces) elmis
133+
134+buildRuntime :: LocalBuildInfo -> [FilePath] -> IO ()
135+buildRuntime lbi elmos = do
136+ createDirectoryIfMissing True (rtsDir lbi)
137+ writeFile (rts lbi) "Elm = {}; Elm.Native = {}; Elm.Native.Graphics = {};\n\
138+ \Elm.Graphics = {}; ElmRuntime = {}; ElmRuntime.Render = {};\n"
139+ mapM_ (appendJS lbi) =<< getFiles ".js" "libraries"
140+ mapM_ (appendJS lbi) elmos
141+ mapM_ (appendJS lbi) =<< getFiles ".js" "runtime"
142+
116143getFiles ext dir = do
117144 contents <- map (dir </>) `fmap` getDirectoryContents dir
118145 let files = filter (\f -> takeExtension f == ext) contents
@@ -125,33 +152,3 @@ appendJS lbi file = do
125152 str <- readFile file
126153 length str `seq` return ()
127154 appendFile (rts lbi) str
128−
129−appendElm lbi file = do
130− jsFile <- runElm lbi file
131− appendJS lbi jsFile
132−
133−-- replace 'system' call with 'runProcess' which handles args better and allows env variable
134−-- "Elm_datadir" which is used by LoadLibraries to find docs.json
135−runElm :: LocalBuildInfo -> String -> IO FilePath
136−runElm lbi file = do
137− rts_c <- canonicalizePath (rts lbi) -- dist/data/elm-runtime.js
138− let js = jsDir lbi -- dist/js
139− let j = dropFileName (js </> file) -- dist/js/libraries/
140− createDirectoryIfMissing True j -- must do before any canonicalization
141− out_c <- canonicalizePath js -- dist/js (root folder)
142− elm_c <- canonicalizePath (elm lbi) -- dist/build/elm/elm
143− rtd_c <- canonicalizePath (rtsDir lbi) -- dist/data (for docs.json)
144− handle <- runProcess elm_c ["--only-js", "--no-prelude", "--output-directory="++out_c, file]
145− Nothing (Just [("Elm_datadir", rtd_c)]) Nothing Nothing Nothing
146− exitCode <- waitForProcess handle
147− return $ j </> replaceExtension (takeFileName file) ".js"
148−
149−
150−buildRuntime lbi = do
151− createDirectoryIfMissing False (rtsDir lbi) -- dist should already exist
152− writeFile (rts lbi) "Elm = {}; Elm.Native = {}; Elm.Native.Graphics = {};\n\
153− \Elm.Graphics = {}; ElmRuntime = {}; ElmRuntime.Render = {}\n"
154− removeDirectoryRecursive ("dist" </> "js")
155− mapM_ (appendJS lbi) =<< getFiles ".js" "libraries"
156− mapM_ (appendElm lbi) =<< getFiles ".elm" "libraries"
157− mapM_ (appendJS lbi) =<< getFiles ".js" "runtime"