@@ -1,51 +1,7 @@
1−{-# OPTIONS_GHC -Wall #-}
2−module Main (main) where
1+#!/usr/bin/env runhaskell
32
4−import Data.List ( nub )
5−import Data.Version ( showVersion )
6−import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )
7−import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )
8−import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
9−import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )
10−import Distribution.Simple.BuildPaths ( autogenModulesDir )
11−import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))
12−import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )
13−import Distribution.Text ( display )
14−import Distribution.Verbosity ( Verbosity, normal )
15−import System.FilePath ( (</>) )
3+module Main where
4+import Distribution.Simple
165
176main :: IO ()
18−main = defaultMainWithHooks simpleUserHooks
19− { buildHook = \pkg lbi hooks flags -> do
20− generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi
21− buildHook simpleUserHooks pkg lbi hooks flags
22− , postHaddock = \args flags pkg lbi -> do
23− -- copyFiles normal (haddockOutputDir flags pkg) [("images","Hierarchy.png")]
24− postHaddock simpleUserHooks args flags pkg lbi
25− }
26−
27−haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath
28−haddockOutputDir flags pkg = destDir where
29− baseDir = case haddockDistPref flags of
30− NoFlag -> "."
31− Flag x -> x
32− destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)
33−
34−generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
35−generateBuildModule verbosity pkg lbi = do
36− let dir = autogenModulesDir lbi
37− createDirectoryIfMissingVerbose verbosity True dir
38− withLibLBI pkg lbi $ \_ libcfg -> do
39− withTestLBI pkg lbi $ \suite suitecfg -> do
40− rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines
41− [ "module Build_" ++ testName suite ++ " where"
42− , "deps :: [String]"
43− , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))
44− ]
45− where
46− formatdeps = map (formatone . snd)
47− formatone p = case packageName p of
48− PackageName n -> n ++ "-" ++ showVersion (packageVersion p)
49−
50−testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]
51−testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys
7+main = defaultMain