mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 09:17:43 +03:00
bfa019997a
* Initial rattle prototype * Build the IDE core * Ignore the Rattle directory * Clean up the dependencies * Require stack-1.10, since that does much better extra-dep caching * Streamline the ghc-lib dependencies * Compile more pieces * Add a build.bat * Make the Windows build use the correct stack.yaml to bootstrap * Fix up enough to build on Windows * Generate the dylib's on Mac * Remove accidental -v * Make the Haskell build driven by the Bazel metadata * Get proto3-suite building * Delete the unneeded haskell-dependencies * Allow generating the proto files and compiling them * Fix metadata to deal with """ syntax * Fix metadata to deal with a list of globs * More work in the direction of daml-ghc * Use correct daml_lf proto version * Tell GHC to use shared objects in TH * Specify needed packages * wip * wip * Switch to the fork of gRPC-haskell * Build executables with rattle * setup build.sbt in daml-lf * Build binaries with rattle * rattle-sbt, move scala build scripts out of daml-lf subdir, and into rattle subdir * convert scala-build.sh into MainScala.hs * Clean up rattle build * Pre-merge clean up * Switch to the newer version of ghc-lib-parser * remove dev ls from MainScala.hs * compile java generated from protos as separate projects * Add copyright headers * HLint fixes * Uscrewup an HLint fix * fix scala formatting of rattle/build.sbt
292 lines
11 KiB
Haskell
292 lines
11 KiB
Haskell
-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
|
|
-- SPDX-License-Identifier: Apache-2.0
|
|
|
|
{-# LANGUAGE ViewPatterns, RecordWildCards #-}
|
|
{-# OPTIONS_GHC -Wall #-}
|
|
{-# OPTIONS_GHC -Wno-name-shadowing #-}
|
|
{-# OPTIONS_GHC -Wno-missing-signatures #-}
|
|
|
|
{- HLINT ignore "Avoid restricted extensions" -}
|
|
{- HLINT ignore "Avoid restricted flags" -}
|
|
|
|
module Main(main) where
|
|
|
|
import Rattle
|
|
import Metadata
|
|
import Util
|
|
import Data.Char
|
|
import Data.Maybe
|
|
import System.Info.Extra
|
|
import System.Process.Extra
|
|
import System.FilePattern.Directory
|
|
import System.FilePath
|
|
import System.Directory
|
|
import System.Environment
|
|
import System.IO.Unsafe
|
|
import Control.Monad.Extra
|
|
import Data.List.Extra
|
|
|
|
targets =
|
|
["libs-haskell/prettyprinter-syntax"
|
|
,"daml-assistant"
|
|
,"daml-foundations/daml-tools/da-hs-damlc-app"
|
|
,"daml-foundations/daml-tools/da-hs-daml-cli"
|
|
,"compiler/haskell-ide-core"
|
|
,"libs-haskell/da-hs-base"
|
|
,"libs-haskell/da-hs-pretty"
|
|
,"libs-haskell/da-hs-language-server"
|
|
,"libs-haskell/da-hs-json-rpc"
|
|
,"compiler/daml-lf-ast"
|
|
,"compiler/daml-lf-tools"
|
|
,"compiler/daml-lf-proto"
|
|
,"daml-lf/archive"
|
|
,"daml-foundations/daml-ghc"
|
|
,"libs-haskell/bazel-runfiles"
|
|
,"compiler/scenario-service/client"
|
|
,"compiler/scenario-service/protos"
|
|
]
|
|
|
|
haskellExts =
|
|
["BangPatterns"
|
|
,"DeriveDataTypeable"
|
|
,"DeriveFoldable"
|
|
,"DeriveFunctor"
|
|
,"DeriveGeneric"
|
|
,"DeriveTraversable"
|
|
,"FlexibleContexts"
|
|
,"GeneralizedNewtypeDeriving"
|
|
,"LambdaCase"
|
|
,"NamedFieldPuns"
|
|
,"NumericUnderscores"
|
|
,"PackageImports"
|
|
,"RecordWildCards"
|
|
,"ScopedTypeVariables"
|
|
,"StandaloneDeriving"
|
|
,"TupleSections"
|
|
,"TypeApplications"
|
|
,"ViewPatterns"
|
|
]
|
|
|
|
haskellFlags =
|
|
["-Wall", "-Werror", "-Wincomplete-uni-patterns", "-Wno-name-shadowing"
|
|
,"-fno-omit-yields"
|
|
,"-threaded", "-rtsopts"
|
|
-- run on two cores, disable idle & parallel GC
|
|
,"-with-rtsopts=-N2 -qg -I0"
|
|
]
|
|
|
|
main = rattle $ do
|
|
putStrLn " ---- Starting rattle build ----"
|
|
metadata <- concatMapM (\x -> readMetadata $ x </> "BUILD.bazel") targets
|
|
metadata <- return [x{dhl_deps = dhl_deps x `intersect` map dhl_name metadata} | x <- metadata]
|
|
metadata <- return $ topSort [(dhl_name, dhl_deps, x) | x@Metadata{..} <- metadata]
|
|
|
|
-- Figure out what libraries we need
|
|
let neededDeps = ["grpc-haskell","proto3-suite"] ++ nubSort (concatMap dhl_hazel_deps metadata)
|
|
|
|
installDependencies neededDeps
|
|
|
|
-- generate the LF protobuf output
|
|
let lfMajorVersions = ["0", "1", "dev"]
|
|
forM_ ("":lfMajorVersions) $ \v -> do
|
|
cmd_ (Cwd "daml-lf/archive")
|
|
"compile-proto-file --proto" ["da/daml_lf" ++ ['_' | v /= ""] ++ v ++ ".proto"]
|
|
"--out ../../.rattle/generated/daml-lf/haskell"
|
|
|
|
-- generate the scenario protobuf output
|
|
cmd_ (Cwd "compiler/scenario-service/protos")
|
|
"compile-proto-file --proto scenario_service.proto"
|
|
"--out ../../../.rattle/generated/scenario-service/haskell"
|
|
|
|
-- build all the Haskell projects
|
|
let trans = transitive [(dhl_name, dhl_deps) | Metadata{..} <- metadata]
|
|
let patch x | dhl_name x == "daml_lf_haskell_proto" = x{dhl_dir = ".rattle/generated/daml-lf/haskell", dhl_srcs = ["**/*.hs"]}
|
|
| dhl_name x == "scenario_service_haskell_proto" = x{dhl_dir = ".rattle/generated/scenario-service/haskell", dhl_srcs = ["**/*.hs"]}
|
|
| otherwise = x
|
|
|
|
putStrLn $ intercalate "\n - " $ "Building targets:" : (prettyName <$> metadata)
|
|
|
|
forM_ metadata $ \m -> buildHaskellPackage $ patch m{dhl_deps = nubSort $ concatMap trans $ dhl_deps m}
|
|
|
|
putStrLn $ intercalate "\n - " $ "Successfully built targets:" : (prettyName <$> metadata)
|
|
|
|
-- | Builds a haskell package.
|
|
--
|
|
-- If the package is an executable, builds all modules and links them to an
|
|
-- executable.
|
|
--
|
|
-- If the package is a library, builds all modules and creates a package DB
|
|
-- with both a static and a dynamic lib.
|
|
buildHaskellPackage :: Metadata -> IO ()
|
|
buildHaskellPackage (fixNames -> o@Metadata{..}) = do
|
|
putStrLn "-----------"
|
|
putStrLn $ " " <> prettyName o
|
|
putStrLn "-----------"
|
|
print ("buildHaskellPackage",o)
|
|
|
|
files <- map (drop $ if null dhl_src_strip_prefix then 0 else length dhl_src_strip_prefix + 1) <$>
|
|
getDirectoryFiles dhl_dir dhl_srcs
|
|
|
|
-- Work around the fact that SdkVersion is bazel-generated
|
|
files <- pure $ files <> (case dhl_name of
|
|
"da-hs-daml-cli" -> ["SdkVersion.hs"]
|
|
_ -> [])
|
|
|
|
let modules = map (intercalate "." . splitDirectories . dropExtension) files
|
|
|
|
let dirs = [dhl_dir </> dhl_src_strip_prefix] <> (case dhl_name of
|
|
-- Work around the fact that SdkVersion is bazel-generated
|
|
"da-hs-daml-cli" -> ["rattle" </> "hacks"]
|
|
_ -> [])
|
|
|
|
let commonFlags =
|
|
-- set the correct output directories for objects, headers, etc
|
|
[ flag ++ "=.rattle/haskell" </> dhl_name
|
|
| flag <- ["-outputdir","-odir","-hidir","-stubdir"]
|
|
] <>
|
|
|
|
-- specify which directories to look into for modules
|
|
["-i" ++ dir | dir <- dirs] <>
|
|
|
|
-- makes sure GHC uses shared objects in RTS linker
|
|
-- https://github.com/ghc/ghc/blob/cf9e1837adc647c90cfa176669d14e0d413c043d/compiler/main/DynFlags.hs#L2087
|
|
["-fexternal-interpreter"] <>
|
|
|
|
-- Ensure GHC finds the packages
|
|
concat [["-package", d] | d <- dhl_deps ] <>
|
|
concat [["-package", d] | d <- dhl_hazel_deps ] <>
|
|
["-package-db=.rattle/haskell" </> d </> "pkg.db" | d <- dhl_deps] <>
|
|
|
|
-- All extra extensions and flags
|
|
map ("-X"++) haskellExts <> haskellFlags
|
|
|
|
case dhl_main_is of
|
|
Just main_ -> do
|
|
|
|
let mainMod =
|
|
-- get the module name by dropping the function name
|
|
-- Foo.Bar.main -> Foo.Bar
|
|
intercalate "." .
|
|
(reverse . drop 1 . reverse . wordsBy (== '.')) $ main_
|
|
|
|
-- Include the main module name, if it's missing
|
|
modules <- pure $ nubSort $ mainMod : modules
|
|
|
|
rpath <- ghcLibPath
|
|
|
|
-- XXX: is this going to work on windows?
|
|
cmd_ "mkdir" "-p" (".rattle/haskell" </> dhl_name)
|
|
|
|
cmd_ "ghc" commonFlags
|
|
modules
|
|
"-o" [".rattle/haskell" </> dhl_name </> dhl_name]
|
|
["-main-is", main_]
|
|
-- Set the rpath so that the executable uses the proper libffi so
|
|
["-optl-Wl,-rpath," <> rpath]
|
|
|
|
Nothing -> do
|
|
cmd_ "ghc" commonFlags
|
|
"-dynosuf=dyn_o -dynhisuf=dyn_hi"
|
|
["-static"] ["-dynamic-too" | not isWindows]
|
|
modules
|
|
["-this-unit-id=" ++ dhl_name]
|
|
|
|
cmd_ "ar -r -s" [".rattle/haskell" </> dhl_name </> "libHS" ++ dhl_name ++ ".a"]
|
|
[".rattle/haskell" </> dhl_name </> x -<.> "o" | x <- files]
|
|
if isWindows then
|
|
cmd_ "ld -x -r -o" [".rattle/haskell" </> dhl_name </> "HS" ++ dhl_name ++ ".o"]
|
|
[".rattle/haskell" </> dhl_name </> x -<.> "o" | x <- files]
|
|
else
|
|
cmd_ "ghc -shared -dynamic" ["-dynload deploy"] "-o" [".rattle/haskell" </> dhl_name </> "libHS" ++ dhl_name ++ ".dylib"]
|
|
[".rattle/haskell" </> dhl_name </> x -<.> "dyn_o" | x <- files]
|
|
unlessM (doesDirectoryExist $ ".rattle/haskell" </> dhl_name </> "pkg.db") $
|
|
cmd_ "ghc-pkg init" [".rattle/haskell" </> dhl_name </> "pkg.db"]
|
|
keys <- map (drop 4) . filter (not . isInfixOf "haskeline") . lines <$>
|
|
systemOutput_ "ghc-pkg field \"*\" key"
|
|
writeFile (".rattle/haskell" </> dhl_name </> "pkg.db" </> dhl_name <.> "conf") $ unlines $
|
|
["name: " ++ dhl_name
|
|
,"version: 0"
|
|
,"id: " ++ dhl_name
|
|
,"key: " ++ dhl_name
|
|
,"hs-libraries: HS" ++ dhl_name
|
|
,"import-dirs: ${pkgroot}"
|
|
,"library-dirs: ${pkgroot}"
|
|
,"dynamic-library-dirs: ${pkgroot}"
|
|
,"exposed: True"
|
|
,"exposed-modules:"] ++
|
|
map (" "++) modules ++
|
|
["depends:"] ++
|
|
keys ++ map (" " ++) dhl_deps
|
|
cmd_ "ghc-pkg recache" ["--package-db=" ++ ".rattle/haskell" </> dhl_name </> "pkg.db"]
|
|
|
|
-- | Installs all the specified packages in the stack database.
|
|
installDependencies :: [String] -> IO ()
|
|
installDependencies neededDeps = do
|
|
|
|
putStrLn $ "Found " <> show (length neededDeps) <> " needed dependencies"
|
|
|
|
-- Diff the installed dependencies to figure out what's missing
|
|
Stdout sout <- cmd stack "exec" "--" ["ghc-pkg", "list"]
|
|
installedDeps <- pure $ nubSort $ parseLibs $ lines sout
|
|
missingDeps <- pure $ neededDeps \\ installedDeps
|
|
|
|
unless (null missingDeps) $
|
|
putStrLn $ unwords $ "Installing missing deps:" : missingDeps
|
|
|
|
-- 'stack build' sometimes gets confused if we ask for several libs to be
|
|
-- installed at once, so we install them one by one
|
|
forM_ missingDeps $ \dep -> do
|
|
putStrLn $ "Installing " <> dep
|
|
cmd_ stack "build" dep
|
|
|
|
-- Double check that everything's available, otherwise fail
|
|
Stdout sout <- cmd stack "exec" " --" ["ghc-pkg", "list"]
|
|
installedDeps <- pure $ nubSort $ parseLibs $ lines sout
|
|
missingDeps <- pure $ neededDeps \\ installedDeps
|
|
unless (null missingDeps) $ do
|
|
error $ unwords $ "Could not find missing deps, try adding to extra-deps? :" : missingDeps
|
|
|
|
{-# NOINLINE stack #-}
|
|
stack :: String
|
|
stack = unsafePerformIO $ do -- assume LD_LIBRARY_PATH won't change during a run
|
|
-- XXX: We may have to use ';' on Windows
|
|
dirs <- maybe [] (wordsBy (== ':')) <$> lookupEnv "LD_LIBRARY_PATH"
|
|
pure $ unwords $
|
|
[ "stack" ] <>
|
|
((\d -> ["--extra-lib-dirs", d]) `concatMap` dirs) <>
|
|
["--stack-yaml=rattle/stack.yaml"]
|
|
|
|
-- | Ask stack for the path of GHC's bundled libs
|
|
-- XXX: Path gymnastics happening here, let's hope stack is somewhat consistent
|
|
ghcLibPath :: IO String
|
|
ghcLibPath = do
|
|
Stdout str <- cmd stack "path" "--compiler-bin"
|
|
case reverse . splitPath <$> lines str of
|
|
["bin" : ver : rest] -> do
|
|
pure $ joinPath $ reverse $ "rts" : ver : "lib": ver : rest
|
|
xs -> error $ "Couldn't parse ghc path: " <> show xs
|
|
|
|
-- | Parse the output of ghc-pkg list into a list of package names, e.g.
|
|
-- [ "lens", "conduit", ... ]
|
|
parseLibs :: [String] -> [String]
|
|
parseLibs = mapMaybe $ fmap parseLib . parseLine
|
|
where
|
|
parseLib :: String -> String
|
|
parseLib = reverse . drop 1 . dropWhile (\c -> isDigit c || (c == '.')) . reverse
|
|
parseLine :: String -> Maybe String
|
|
parseLine = stripPrefix " "
|
|
|
|
prettyName :: Metadata -> String
|
|
prettyName Metadata{..} =
|
|
dhl_name <> maybe " (lib)" (const " (bin)") dhl_main_is
|
|
|
|
-- some packages (e.g. daml_lf_haskell_proto) use names which are unsuitable for GHC
|
|
-- so we switch them and the dependencies here
|
|
fixNames :: Metadata -> Metadata
|
|
fixNames o = o
|
|
{ dhl_name = fixName (dhl_name o)
|
|
, dhl_deps = map fixName (dhl_deps o)
|
|
}
|
|
where
|
|
fixName = replace "_" "-"
|