-
Notifications
You must be signed in to change notification settings - Fork 118
/
Self.hs
90 lines (68 loc) · 3.29 KB
/
Self.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, TypeFamilies #-}
module Test.Self(main, cabalBuildDepends) where
import Development.Shake
import Development.Shake.Classes
import Development.Shake.FilePath
import Test.Type
import Control.Monad.Extra
import Data.Char
import Data.List.Extra
import System.Info.Extra
newtype GhcPkg = GhcPkg () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)
newtype GhcFlags = GhcFlags () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)
type instance RuleResult GhcPkg = [String]
type instance RuleResult GhcFlags = [String]
-- Doesn't work on CI, seems self-building under `cabal test` is just hard
main = testBuild (notCI . defaultTest) $ do
let moduleToFile ext xs = replace "." "/" xs <.> ext
want ["Main" <.> exe]
-- fixup to cope with Cabal's generated files
let fixPaths x = if x == "Paths_shake.hs" then "Paths.hs" else x
ghcPkg <- addOracleHash $ \GhcPkg{} -> do
Stdout out <- quietly $ cmd "ghc-pkg list --simple-output"
pure $ words out
ghcFlags <- addOracleHash $ \GhcFlags{} ->
map ("-package=" ++) <$> readFileLines ".pkgs"
let ghc args = do
trackAllow ["**/package.cache", "**/.ghc.environment.*"]
-- since ghc-pkg includes the ghc package, it changes if the version does
ghcPkg $ GhcPkg ()
flags <- ghcFlags $ GhcFlags ()
cmd "ghc" flags args
"Main" <.> exe %> \out -> do
src <- readFileLines "Run.deps"
let os = map (moduleToFile "o") $ "Run" : src
need os
ghc $ ["-o",out] ++ os
"**/*.deps" %> \out -> do
dep <- readFileLines $ out -<.> "dep"
let xs = map (moduleToFile "deps") dep
need xs
ds <- nubOrd . sort . (++) dep <$> concatMapM readFileLines xs
writeFileLines out ds
"**/*.dep" %> \out -> do
src <- readFile' $ shakeRoot </> "src" </> fixPaths (out -<.> "hs")
let xs = hsImports src
xs <- filterM (doesFileExist . (\x -> shakeRoot </> "src" </> x) . fixPaths . moduleToFile "hs") xs
writeFileLines out xs
["**/*.o","**/*.hi"] &%> \[out,_] -> do
deps <- readFileLines $ out -<.> "deps"
let hs = shakeRoot </> "src" </> fixPaths (out -<.> "hs")
need $ hs : map (moduleToFile "hi") deps
ghc ["-c",hs,"-i" ++ shakeRoot </> "src","-main-is","Run.main"
,"-hide-all-packages","-outputdir=."
,"-DPORTABLE"] -- to test one CPP branch
".pkgs" %> \out -> do
src <- readFile' $ shakeRoot </> "shake.cabal"
writeFileLines out $ sort $ cabalBuildDepends src
---------------------------------------------------------------------
-- GRAB INFORMATION FROM FILES
hsImports :: String -> [String]
hsImports xs = [ takeWhile (\x -> isAlphaNum x || x `elem` "._") $ dropWhile (not . isUpper) x
| x <- concatMap (wordsBy (== ';')) $ lines xs, "import " `isPrefixOf` trim x]
-- FIXME: Should actually parse the list from the contents of the .cabal file
cabalBuildDepends :: String -> [String]
cabalBuildDepends _ = packages ++ ["unix" | not isWindows]
packages = words $
"base transformers binary unordered-containers hashable heaps time bytestring primitive " ++
"filepath directory process deepseq random utf8-string extra js-dgtable js-jquery js-flot filepattern"