git.iko.soy/typeable/bloodhound
on 14dbffa help sign in
51 lines 2.5 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Main (main) where
4import Data.List ( nub )
5import Data.Version ( showVersion )
6import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )
7import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )
8import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
9import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )
10import Distribution.Simple.BuildPaths ( autogenModulesDir )
11import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))
12import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )
13import Distribution.Text ( display )
14import Distribution.Verbosity ( Verbosity, normal )
15import System.FilePath ( (</>) )
17main :: IO ()
18main = 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 }
27haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath
28haddockOutputDir flags pkg = destDir where
29 baseDir = case haddockDistPref flags of
30 NoFlag -> "."
31 Flag x -> x
32 destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)
34generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
35generateBuildModule 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)
50testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]
51testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys