2012-04-19 06:32:10 +00:00
|
|
|
import Distribution.Simple
|
2013-03-14 14:28:49 +00:00
|
|
|
import Distribution.Simple.LocalBuildInfo
|
|
|
|
import Distribution.Simple.Setup
|
|
|
|
import Distribution.PackageDescription
|
|
|
|
|
|
|
|
import System.Cmd
|
|
|
|
import System.Directory
|
|
|
|
import System.FilePath
|
|
|
|
import System.IO
|
2013-03-22 15:52:40 +00:00
|
|
|
import System.Process
|
2013-03-14 14:28:49 +00:00
|
|
|
|
2013-03-21 13:31:55 +00:00
|
|
|
import Control.Monad
|
2013-07-28 00:24:17 +00:00
|
|
|
import qualified Data.Binary as Binary
|
2013-08-06 07:36:07 +00:00
|
|
|
import qualified Data.ByteString.Lazy as BS
|
2013-03-21 13:31:55 +00:00
|
|
|
|
|
|
|
-- Part 1
|
|
|
|
-- ------
|
|
|
|
-- Add a build callout
|
2013-07-28 00:24:17 +00:00
|
|
|
-- We need to build elm-doc and run it because that generates the file "docs.json"
|
|
|
|
-- needs by Libraries.hs which is part of the elm library and executable
|
2013-03-21 13:31:55 +00:00
|
|
|
-- Unfort. there seems to be no way to tell cabal that:
|
|
|
|
-- (a) elm-doc generates docs.json, and
|
|
|
|
-- (b) elm (library) depends on docs.json
|
|
|
|
-- Therefore, we either use make instead (or a script), or hack around in cabal
|
|
|
|
|
|
|
|
-- Part 2
|
|
|
|
-- ------
|
2013-03-14 14:28:49 +00:00
|
|
|
-- Add a post-build callout.
|
2013-03-21 13:31:55 +00:00
|
|
|
-- We need to build the runtime.js after we've built elm (because we use elm to generate some of the JavaScript),
|
2013-03-14 14:28:49 +00:00
|
|
|
-- but before cabal does the install file copy step
|
|
|
|
|
2013-03-21 13:31:55 +00:00
|
|
|
-- Assumptions
|
|
|
|
-- Elm.cabal expects the generated files to end up in dist/data
|
2013-07-28 00:24:17 +00:00
|
|
|
-- git won't look in dist + cabal will clean it
|
|
|
|
rtsDir :: LocalBuildInfo -> FilePath
|
2013-08-10 06:20:22 +00:00
|
|
|
rtsDir lbi = "data"
|
2013-07-28 00:24:17 +00:00
|
|
|
|
|
|
|
tempDir :: LocalBuildInfo -> FilePath
|
2013-08-10 06:20:22 +00:00
|
|
|
tempDir lbi = "temp"
|
2013-03-21 13:31:55 +00:00
|
|
|
|
|
|
|
-- The runtime is called:
|
2013-07-28 00:24:17 +00:00
|
|
|
rts :: LocalBuildInfo -> FilePath
|
2013-06-24 04:14:08 +00:00
|
|
|
rts lbi = rtsDir lbi </> "elm-runtime.js"
|
2013-03-21 13:31:55 +00:00
|
|
|
|
2013-07-28 00:24:17 +00:00
|
|
|
-- The interfaces for the Standard Libraries live in:
|
|
|
|
interfaces :: LocalBuildInfo -> FilePath
|
|
|
|
interfaces lbi = rtsDir lbi </> "interfaces.data"
|
2013-03-21 13:31:55 +00:00
|
|
|
|
|
|
|
-- buildDir with LocalBuildInfo points to "dist/build" (usually)
|
2013-06-24 04:14:08 +00:00
|
|
|
elm lbi = buildDir lbi </> "elm" </> "elm"
|
2013-03-21 13:31:55 +00:00
|
|
|
|
2013-03-14 14:28:49 +00:00
|
|
|
-- Care! This appears to be based on an unstable API
|
|
|
|
-- See: http://www.haskell.org/cabal/release/cabal-latest/doc/API/Cabal/Distribution-Simple.html#2
|
|
|
|
|
2013-03-21 13:31:55 +00:00
|
|
|
|
|
|
|
main :: IO ()
|
2013-07-28 00:24:17 +00:00
|
|
|
main = defaultMainWithHooks simpleUserHooks { postBuild = myPostBuild }
|
2013-03-21 13:31:55 +00:00
|
|
|
|
|
|
|
|
|
|
|
-- Build
|
|
|
|
|
2013-03-22 15:52:40 +00:00
|
|
|
-- note(1): We use to include docs.json directly into LoadLibraries at compile time
|
|
|
|
-- If docs.json is used in other (template) haskell files, they should be copied
|
|
|
|
-- and compiled in a separate directory (eg, dist/copiedSrc).
|
|
|
|
-- This is to make sure they are re-compiled on docs.json changes.
|
|
|
|
-- Copying is a better solution than 'touch'ing the source files
|
|
|
|
-- (touch is non-portable and confusing wrt RCS).
|
|
|
|
|
2013-07-28 00:24:17 +00:00
|
|
|
-- In the PackageDescription, the list of stuff to build is held in library
|
|
|
|
-- (in a Maybe) and the executables list. We want a PackageDescription that
|
|
|
|
-- only mentions the executable 'name'
|
|
|
|
filterExe :: String -> PackageDescription -> PackageDescription
|
2013-03-21 13:31:55 +00:00
|
|
|
filterExe name pd = pd {
|
|
|
|
library = Nothing,
|
|
|
|
executables = filter (\x -> (exeName x == name)) (executables pd)
|
|
|
|
}
|
2013-03-14 14:28:49 +00:00
|
|
|
|
2013-07-28 00:24:17 +00:00
|
|
|
-- It's not enough to fix the PackageDescription, we also have to fix the
|
|
|
|
-- LocalBuildInfo. This includes the component build order (data ComponentName)
|
|
|
|
-- which is horribly internal.
|
|
|
|
filterLBI :: String -> LocalBuildInfo -> LocalBuildInfo
|
2013-03-21 13:31:55 +00:00
|
|
|
filterLBI name lbi = lbi {
|
|
|
|
libraryConfig = Nothing,
|
|
|
|
compBuildOrder = [CExeName name],
|
|
|
|
executableConfigs = filter (\a -> (fst a == name)) (executableConfigs lbi)
|
|
|
|
}
|
|
|
|
|
2013-03-14 14:28:49 +00:00
|
|
|
|
2013-03-21 13:31:55 +00:00
|
|
|
-- Post Build
|
|
|
|
|
|
|
|
myPostBuild :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
|
|
|
|
myPostBuild as bfs pd lbi = do
|
2013-07-28 00:24:17 +00:00
|
|
|
putStrLn "Custom build step: compiling standard libraries"
|
|
|
|
(elmos, elmis) <- compileLibraries lbi
|
|
|
|
putStrLn "Custom build step: build interfaces.data"
|
|
|
|
buildInterfaces lbi elmis
|
|
|
|
putStrLn "Custom build step: build elm-runtime.js"
|
|
|
|
buildRuntime lbi elmos
|
2013-08-10 06:20:22 +00:00
|
|
|
removeDirectoryRecursive (tempDir lbi)
|
2013-03-21 13:31:55 +00:00
|
|
|
postBuild simpleUserHooks as bfs pd lbi
|
2013-03-14 14:28:49 +00:00
|
|
|
|
2013-07-28 00:24:17 +00:00
|
|
|
|
|
|
|
compileLibraries lbi = do
|
2013-08-10 06:20:22 +00:00
|
|
|
let temp = tempDir lbi -- temp
|
|
|
|
rts = rtsDir lbi -- data
|
2013-07-28 00:24:17 +00:00
|
|
|
createDirectoryIfMissing True temp
|
2013-07-29 17:27:57 +00:00
|
|
|
createDirectoryIfMissing True rts
|
2013-08-10 06:20:22 +00:00
|
|
|
out_c <- canonicalizePath temp -- temp (root folder)
|
2013-07-28 00:24:17 +00:00
|
|
|
elm_c <- canonicalizePath (elm lbi) -- dist/build/elm/elm
|
2013-08-10 06:20:22 +00:00
|
|
|
rtd_c <- canonicalizePath rts -- data
|
2013-07-28 00:24:17 +00:00
|
|
|
|
|
|
|
let make file = do
|
|
|
|
-- replace 'system' call with 'runProcess' which handles args better
|
|
|
|
-- and allows env variable "Elm_datadir" which is used by LoadLibraries
|
|
|
|
-- to find docs.json
|
2013-08-07 01:34:23 +00:00
|
|
|
let args = [ "--only-js", "--make", "--no-prelude"
|
|
|
|
, "--cache-dir="++out_c, "--build-dir="++out_c, file ]
|
2013-07-28 00:24:17 +00:00
|
|
|
arg = Just [("Elm_datadir", rtd_c)]
|
|
|
|
handle <- runProcess elm_c args Nothing arg Nothing Nothing Nothing
|
|
|
|
exitCode <- waitForProcess handle
|
|
|
|
return ( out_c </> replaceExtension file "elmo"
|
|
|
|
, out_c </> replaceExtension file "elmi")
|
|
|
|
|
|
|
|
setCurrentDirectory "libraries"
|
|
|
|
print =<< getCurrentDirectory
|
|
|
|
files <- getFiles ".elm" "."
|
|
|
|
files <- unzip `fmap` mapM make files
|
|
|
|
setCurrentDirectory ".."
|
|
|
|
return files
|
|
|
|
|
|
|
|
buildInterfaces :: LocalBuildInfo -> [FilePath] -> IO ()
|
|
|
|
buildInterfaces lbi elmis = do
|
|
|
|
createDirectoryIfMissing True (rtsDir lbi)
|
|
|
|
let ifaces = interfaces lbi
|
2013-08-06 07:36:07 +00:00
|
|
|
ifaceHandle <- openBinaryFile ifaces WriteMode
|
|
|
|
BS.hPut ifaceHandle (Binary.encode (length elmis))
|
|
|
|
let append file = do
|
|
|
|
handle <- openBinaryFile file ReadMode
|
|
|
|
bits <- hGetContents handle
|
|
|
|
length bits `seq` hPutStr ifaceHandle bits
|
|
|
|
hClose handle
|
|
|
|
mapM_ append elmis
|
|
|
|
hClose ifaceHandle
|
2013-07-28 00:24:17 +00:00
|
|
|
|
|
|
|
buildRuntime :: LocalBuildInfo -> [FilePath] -> IO ()
|
|
|
|
buildRuntime lbi elmos = do
|
|
|
|
createDirectoryIfMissing True (rtsDir lbi)
|
2013-08-31 20:14:06 +00:00
|
|
|
writeFile (rts lbi) "var Elm = {}; Elm.Native = {}; Elm.Native.Graphics = {};\n\
|
|
|
|
\var ElmRuntime = {}; ElmRuntime.Render = {};\n"
|
2013-07-28 00:24:17 +00:00
|
|
|
mapM_ (appendJS lbi) =<< getFiles ".js" "libraries"
|
|
|
|
mapM_ (appendJS lbi) elmos
|
|
|
|
mapM_ (appendJS lbi) =<< getFiles ".js" "runtime"
|
|
|
|
|
2013-03-14 14:28:49 +00:00
|
|
|
getFiles ext dir = do
|
|
|
|
contents <- map (dir </>) `fmap` getDirectoryContents dir
|
|
|
|
let files = filter (\f -> takeExtension f == ext) contents
|
|
|
|
dirs = filter (not . hasExtension) contents
|
|
|
|
filess <- mapM (getFiles ext) dirs
|
|
|
|
return (files ++ concat filess)
|
|
|
|
|
2013-03-21 13:31:55 +00:00
|
|
|
appendJS lbi file = do
|
2013-03-14 14:28:49 +00:00
|
|
|
putStrLn (dropExtension file)
|
|
|
|
str <- readFile file
|
|
|
|
length str `seq` return ()
|
2013-03-21 13:31:55 +00:00
|
|
|
appendFile (rts lbi) str
|