git.iko.soy/elk
on 96835bf help sign in
elk/Setup.hs
164 lines 6.1 kB history raw
1import Distribution.Simple
2import Distribution.Simple.LocalBuildInfo
3import Distribution.Simple.Setup
4import Distribution.PackageDescription
6import System.Cmd
7import System.Directory
8import System.FilePath
9import System.IO
10import System.Process
12import Control.Monad
13import qualified Data.Binary as Binary
14import qualified Data.ByteString.Lazy as BS
16-- Part 1
17-- ------
18-- Add a build callout
19-- We need to build elm-doc and run it because that generates the file "docs.json"
20-- needs by Libraries.hs which is part of the elm library and executable
21-- Unfort. there seems to be no way to tell cabal that:
22-- (a) elm-doc generates docs.json, and
23-- (b) elm (library) depends on docs.json
24-- Therefore, we either use make instead (or a script), or hack around in cabal
26-- Part 2
27-- ------
28-- Add a post-build callout.
29-- We need to build the runtime.js after we've built elm (because we use elm to generate some of the JavaScript),
30-- but before cabal does the install file copy step
32-- Assumptions
33-- Elm.cabal expects the generated files to end up in dist/data
34-- git won't look in dist + cabal will clean it
35rtsDir :: LocalBuildInfo -> FilePath
36rtsDir lbi = buildDir lbi </> ".." </> "data"
38tempDir :: LocalBuildInfo -> FilePath
39tempDir lbi = buildDir lbi </> ".." </> "temp"
41-- The runtime is called:
42rts :: LocalBuildInfo -> FilePath
43rts lbi = rtsDir lbi </> "elm-runtime.js"
45-- The interfaces for the Standard Libraries live in:
46interfaces :: LocalBuildInfo -> FilePath
47interfaces lbi = rtsDir lbi </> "interfaces.data"
49-- buildDir with LocalBuildInfo points to "dist/build" (usually)
50elm lbi = buildDir lbi </> "elm" </> "elm"
52-- Care! This appears to be based on an unstable API
53-- See: http://www.haskell.org/cabal/release/cabal-latest/doc/API/Cabal/Distribution-Simple.html#2
56main :: IO ()
57main = defaultMainWithHooks simpleUserHooks { postBuild = myPostBuild }
60-- Build
62-- note(1): We use to include docs.json directly into LoadLibraries at compile time
63-- If docs.json is used in other (template) haskell files, they should be copied
64-- and compiled in a separate directory (eg, dist/copiedSrc).
65-- This is to make sure they are re-compiled on docs.json changes.
66-- Copying is a better solution than 'touch'ing the source files
67-- (touch is non-portable and confusing wrt RCS).
69-- In the PackageDescription, the list of stuff to build is held in library
70-- (in a Maybe) and the executables list. We want a PackageDescription that
71-- only mentions the executable 'name'
72filterExe :: String -> PackageDescription -> PackageDescription
73filterExe name pd = pd {
74 library = Nothing,
75 executables = filter (\x -> (exeName x == name)) (executables pd)
76 }
78-- It's not enough to fix the PackageDescription, we also have to fix the
79-- LocalBuildInfo. This includes the component build order (data ComponentName)
80-- which is horribly internal.
81filterLBI :: String -> LocalBuildInfo -> LocalBuildInfo
82filterLBI name lbi = lbi {
83 libraryConfig = Nothing,
84 compBuildOrder = [CExeName name],
85 executableConfigs = filter (\a -> (fst a == name)) (executableConfigs lbi)
86 }
89-- Post Build
91myPostBuild :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
92myPostBuild as bfs pd lbi = do
93 putStrLn "Custom build step: compiling standard libraries"
94 (elmos, elmis) <- compileLibraries lbi
95 putStrLn "Custom build step: build interfaces.data"
96 buildInterfaces lbi elmis
97 putStrLn "Custom build step: build elm-runtime.js"
98 buildRuntime lbi elmos
99 removeDirectoryRecursive ("dist" </> "temp")
100 postBuild simpleUserHooks as bfs pd lbi
103compileLibraries lbi = do
104 let temp = tempDir lbi -- dist/temp
105 rts = rtsDir lbi -- dist/data
106 createDirectoryIfMissing True temp
107 createDirectoryIfMissing True rts
108 out_c <- canonicalizePath temp -- dist/temp (root folder)
109 elm_c <- canonicalizePath (elm lbi) -- dist/build/elm/elm
110 rtd_c <- canonicalizePath rts -- dist/data (for docs.json)
112 let make file = do
113 -- replace 'system' call with 'runProcess' which handles args better
114 -- and allows env variable "Elm_datadir" which is used by LoadLibraries
115 -- to find docs.json
116 let args = ["--only-js","--make","--no-prelude","--output-directory="++out_c,file]
117 arg = Just [("Elm_datadir", rtd_c)]
118 handle <- runProcess elm_c args Nothing arg Nothing Nothing Nothing
119 exitCode <- waitForProcess handle
120 return ( out_c </> replaceExtension file "elmo"
121 , out_c </> replaceExtension file "elmi")
123 setCurrentDirectory "libraries"
124 print =<< getCurrentDirectory
125 files <- getFiles ".elm" "."
126 files <- unzip `fmap` mapM make files
127 setCurrentDirectory ".."
128 return files
130buildInterfaces :: LocalBuildInfo -> [FilePath] -> IO ()
131buildInterfaces lbi elmis = do
132 createDirectoryIfMissing True (rtsDir lbi)
133 let ifaces = interfaces lbi
134 ifaceHandle <- openBinaryFile ifaces WriteMode
135 BS.hPut ifaceHandle (Binary.encode (length elmis))
136 let append file = do
137 handle <- openBinaryFile file ReadMode
138 bits <- hGetContents handle
139 length bits `seq` hPutStr ifaceHandle bits
140 hClose handle
141 mapM_ append elmis
142 hClose ifaceHandle
144buildRuntime :: LocalBuildInfo -> [FilePath] -> IO ()
145buildRuntime lbi elmos = do
146 createDirectoryIfMissing True (rtsDir lbi)
147 writeFile (rts lbi) "Elm = {}; Elm.Native = {}; Elm.Native.Graphics = {};\n\
148 \Elm.Graphics = {}; ElmRuntime = {}; ElmRuntime.Render = {};\n"
149 mapM_ (appendJS lbi) =<< getFiles ".js" "libraries"
150 mapM_ (appendJS lbi) elmos
151 mapM_ (appendJS lbi) =<< getFiles ".js" "runtime"
153getFiles ext dir = do
154 contents <- map (dir </>) `fmap` getDirectoryContents dir
155 let files = filter (\f -> takeExtension f == ext) contents
156 dirs = filter (not . hasExtension) contents
157 filess <- mapM (getFiles ext) dirs
158 return (files ++ concat filess)
160appendJS lbi file = do
161 putStrLn (dropExtension file)
162 str <- readFile file
163 length str `seq` return ()
164 appendFile (rts lbi) str