cabal-testsuite/PackageTests/SetupHooks/SetupHooksRuleOrdering/SetupHooks.hs

   1 {-# LANGUAGE DeriveTraversable #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE RecursiveDo #-}
   5 {-# LANGUAGE StaticPointers #-}
   6
   7 module SetupHooks where
   8
   9 import Distribution.Simple.LocalBuildInfo (interpretSymbolicPathLBI)
  10 import Distribution.Simple.SetupHooks
  11 import Distribution.Simple.Utils ( rewriteFileEx, warn )
  12 import Distribution.Utils.Path
  13
  14 import Data.Foldable ( for_ )
  15 import qualified Data.List.NonEmpty as NE ( NonEmpty(..) )
  16 import Data.Traversable ( for )
  17
  18 setupHooks :: SetupHooks
  19 setupHooks =
  20   noSetupHooks
  21     { buildHooks =
  22         noBuildHooks
  23           { preBuildComponentRules = Just $ rules (static ()) preBuildRules
  24           }
  25     }
  26
  27 -- Register three rules:
  28 --
  29 -- r1: B --> C
  30 -- r2: A --> B
  31 -- r3: C --> D
  32 --
  33 -- and check that we run them in dependency order, i.e. r2, r1, r3.
  34 preBuildRules :: PreBuildComponentInputs -> RulesM ()
  35 preBuildRules (PreBuildComponentInputs { buildingWhat = what, localBuildInfo = lbi, targetInfo = tgt }) = mdo
  36   let verbosity = buildingWhatVerbosity what
  37       clbi = targetCLBI tgt
  38       autogenDir = autogenComponentModulesDir lbi clbi
  39
  40       mkAction =
  41         mkCommand (static Dict) $ static (\ (dir, verb, (inMod, outMod)) -> do
  42           warn verb $ "Running rule: " ++ inMod ++ " --> " ++ outMod
  43           let loc = getSymbolicPath dir </> outMod <.> "hs"
  44           rewriteFileEx verb loc $
  45             "module " ++ outMod ++ " where { import " ++ inMod ++ " }"
  46         )
  47
  48       actionArg inMod outMod =
  49         (autogenDir, verbosity, (inMod, outMod))
  50
  51       mkRule action input outMod =
  52         staticRule action
  53           [ input ]
  54           ( Location autogenDir (makeRelativePathEx outMod <.> "hs") NE.:| [] )
  55
  56   -- B --> C
  57   -- A --> B
  58   -- C --> D
  59   r1 <- registerRule "r1" $ mkRule (mkAction (actionArg "B" "C")) (RuleDependency $ RuleOutput r2 0) "C"
  60   r2 <- registerRule "r2" $ mkRule (mkAction (actionArg "A" "B")) (FileDependency $ Location sameDirectory (makeRelativePathEx "A.hs")) "B"
  61   r3 <- registerRule "r3" $ mkRule (mkAction (actionArg "C" "D")) (RuleDependency $ RuleOutput r1 0) "D"
  62   return ()