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