Make Cabal-hooks more self-sufficient with additional re-exports

Cabal-hooks/src/Distribution/Simple/SetupHooks.hs

@@ -1,10 +1,14 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StaticPointers #-}
 
+{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
+
 {-|
 Module: Distribution.Simple.SetupHooks
 Description: Interface for the @Hooks@ @build-type@.
@@ -75,6 +79,8 @@ module Distribution.Simple.SetupHooks
 
     -- $rulesAPI
   , RulesM
+    -- | Rule names (use @OverloadedStrings@ or 'Data.String.fromString')
+  , ShortText
   , registerRule
   , registerRule_
 
@@ -99,11 +105,43 @@ module Distribution.Simple.SetupHooks
   , autogenComponentModulesDir
   , componentBuildDir
 
+    -- **** Path types and utilities
+  , RelativePath
+  , sameDirectory
+  , getSymbolicPath
+  , makeRelativePathEx
+  , moduleNameSymbolicPath
+  , FileLike(..)
+  , PathLike(..)
+
+    -- ***** Directory types
+  , Source, Build, Pkg, CWD
+
+    -- **** File search
+  , findAndMonitorDirFileGlob
+  , findAndMonitorSourceDirsFileExts
+
+    -- ***** File globbing re-exports
+  , Glob(..)
+  , GlobPiece(..)
+  , GlobSyntaxError(..)
+  , parseFileGlob
+  , globMatches
+  , runDirFileGlob
+
     -- *** Actions
   , RuleCommands -- gnarly constructors not exposed; API is via 'staticRule' and 'dynamicRule'
   , Command
   , mkCommand
   , Dict(..)
+    -- | Custom datatypes used as rule command arguments must implement
+    -- serialisation. Derive these instances using @DeriveAnyClass@ and
+    -- @DeriveGeneric@:
+    --
+    -- > data MyInput = MyInput { .. }
+    -- >   deriving stock    ( Eq, Show, Generic )
+    -- >   deriving anyclass Binary
+  , Binary
 
 
   -- *** File/directory monitoring
@@ -139,10 +177,22 @@ module Distribution.Simple.SetupHooks
   , ProgramDb
   , addKnownPrograms
   , configureUnconfiguredProgram
+  , lookupProgram
+  , lookupProgramByName
   , simpleProgram
+  , runProgramCwd
+
+    -- *** IO utilities
+  , warn
+  , createDirectoryIfMissingVerbose
+  , rewriteFileEx
 
     -- ** General @Cabal@ datatypes
-  , Verbosity, Compiler(..), Platform(..), Suffix(..)
+  , Compiler(..), Platform(..), Suffix(..)
+
+    -- *** Verbosity
+  , Verbosity, VerbosityFlags, VerbosityHandles
+  , mkVerbosity, defaultVerbosityHandles
 
     -- *** Package information
   , LocalBuildConfig, LocalBuildInfo, PackageBuildDescr
@@ -153,8 +203,16 @@ module Distribution.Simple.SetupHooks
 
   , PackageDescription(..)
 
+    -- **** LocalBuildInfo utilities
+  , localPkgDescr
+  , mbWorkDirLBI
+  , withPrograms
+  , interpretSymbolicPathLBI
+  , componentBuildInfo
+
     -- *** Component information
   , Component(..), ComponentName(..), componentName
+  , ModuleName
   , BuildInfo(..), emptyBuildInfo
   , TargetInfo(..), ComponentLocalBuildInfo(..)
 
@@ -167,6 +225,10 @@ module Distribution.Simple.SetupHooks
 
   )
 where
+import Distribution.Compat.Binary
+  ( Binary )
+import Distribution.ModuleName
+  ( ModuleName )
 import Distribution.PackageDescription
   ( PackageDescription(..)
   , Library(..), ForeignLib(..)
@@ -181,17 +243,32 @@ import Distribution.Simple.BuildPaths
 import Distribution.Simple.Compiler
   ( Compiler(..) )
 import Distribution.Simple.Errors
-  ( CabalException(SetupHooksException) )
+  ( CabalException(SetupHooksException, MatchDirFileGlob)
+  )
 import Distribution.Simple.FileMonitor.Types
+  hiding ( Glob )
+import Distribution.Simple.Glob
+  ( Glob, GlobSyntaxError(..)
+  , globMatches, runDirFileGlob, parseFileGlob
+  , explainGlobSyntaxError
+  )
+import Distribution.Simple.Glob.Internal
+  ( Glob(..), GlobPiece(..)
+  )
 import Distribution.Simple.Install
   ( installFileGlob )
 import Distribution.Simple.LocalBuildInfo
-  ( componentBuildDir )
+  ( componentBuildDir, componentBuildInfo
+  , mbWorkDirLBI, interpretSymbolicPathLBI
+  )
 import Distribution.Simple.PreProcess.Types
   ( Suffix(..) )
+import Distribution.Simple.Program
+  ( runProgramCwd )
 import Distribution.Simple.Program.Db
   ( ProgramDb, addKnownPrograms
   , configureUnconfiguredProgram
+  , lookupProgram, lookupProgramByName
   )
 import Distribution.Simple.Program.Find
   ( simpleProgram )
@@ -212,23 +289,38 @@ import Distribution.Simple.SetupHooks.Errors
 import Distribution.Simple.SetupHooks.Internal
 import Distribution.Simple.SetupHooks.Rule as Rule
 import Distribution.Simple.Utils
-  ( dieWithException )
+  ( createDirectoryIfMissingVerbose
+  , dieWithException
+  , intercalate
+  , rewriteFileEx
+  , warn
+  )
 import Distribution.System
   ( Platform(..) )
 import Distribution.Types.Component
   ( Component(..), componentName )
 import Distribution.Types.ComponentLocalBuildInfo
   ( ComponentLocalBuildInfo(..) )
 import Distribution.Types.LocalBuildInfo
-  ( LocalBuildInfo(..) )
+  ( LocalBuildInfo(..), withPrograms )
 import Distribution.Types.LocalBuildConfig
   ( LocalBuildConfig, PackageBuildDescr )
 import Distribution.Types.TargetInfo
   ( TargetInfo(..) )
+import Distribution.Utils.Path
+  ( SymbolicPath, CWD, Pkg, FileOrDir(..)
+  , interpretSymbolicPath, makeRelativePathEx
+  , RelativePath, Source, Build
+  , getSymbolicPath, sameDirectory, moduleNameSymbolicPath
+  , FileLike(..), PathLike(..)
+  )
 import Distribution.Utils.ShortText
   ( ShortText )
 import Distribution.Verbosity
-  ( Verbosity )
+  ( Verbosity
+  , VerbosityFlags, VerbosityHandles
+  , mkVerbosity, defaultVerbosityHandles
+  )
 
 import Control.Monad
   ( void )
@@ -239,8 +331,11 @@ import Control.Monad.Trans.Class
 import qualified Control.Monad.Trans.Reader as Reader
 import qualified Control.Monad.Trans.State as State
 import qualified Control.Monad.Trans.Writer.CPS as Writer
+import qualified Data.List.NonEmpty as NE
 import Data.Foldable
   ( for_ )
+import Data.Traversable
+  ( for )
 import Data.Map.Strict as Map
   ( insertLookupWithKey )
 
@@ -616,9 +711,67 @@ registerRule_ i r = void $ registerRule i r
 -- | Declare additional monitored objects for the collection of all rules.
 --
 -- When these monitored objects change, the rules are re-computed.
+--
+-- See also 'findAndMonitorDirFileGlob' which combines the search and the
+-- monitoring.
 addRuleMonitors :: Monad m => [MonitorFilePath] -> RulesT m ()
 addRuleMonitors = RulesT . lift . lift . Writer.tell
 {-# INLINEABLE addRuleMonitors #-}
 
--- TODO: add API functions that search and declare the appropriate monitoring
--- at the same time.
+-- | Retrieve all files matching the given 'Glob' in the specified search
+-- directories.
+--
+-- See also the canned 'findAndMonitorSourceDirsFileExts' for the simple
+-- case of monitoring a file extension in the source directories of a component.
+findAndMonitorDirFileGlob
+  :: MonadIO m
+  => Maybe (SymbolicPath CWD (Dir Pkg))
+  -> Verbosity
+  -> [SymbolicPath Pkg (Dir dir)]
+     -- ^ search directories
+  -> Glob
+     -- ^ pattern to match against
+  -> RulesT m [Location]
+findAndMonitorDirFileGlob mbWorkDir verb searchDirs glob = do
+  matchingFiles <- fmap concat $ liftIO $ for searchDirs $ \srcDir -> do
+    let root = interpretSymbolicPath mbWorkDir srcDir
+    matches <- runDirFileGlob verb Nothing root glob
+    return
+      [ Location srcDir (makeRelativePathEx match)
+      | match <- globMatches matches
+      ]
+  addRuleMonitors [monitorFileGlobExistence $ RootedGlob FilePathRelative glob]
+  return matchingFiles
+{-# INLINEABLE findAndMonitorDirFileGlob #-}
+
+-- | Scans the component source directories for files with the given extensions,
+-- and monitors the resulting file glob.
+findAndMonitorSourceDirsFileExts
+  :: MonadIO m
+  => PreBuildComponentInputs
+  -> NE.NonEmpty String -- ^ extensions (not including the @.@)
+  -> RulesT m [Location]
+findAndMonitorSourceDirsFileExts
+  PreBuildComponentInputs
+    { localBuildInfo
+    , buildingWhat = what
+    , targetInfo
+    } exts =
+  let
+    comp       = targetComponent targetInfo
+    verbosity  = mkVerbosity defaultVerbosityHandles (buildingWhatVerbosity what)
+    mbWorkDir  = mbWorkDirLBI localBuildInfo
+    searchDirs = hsSourceDirs $ componentBuildInfo comp
+    globText   = case exts of
+      e NE.:| [] -> "**/*." ++ e
+      e NE.:| es -> "**/*.{" ++ intercalate "," (e : es) ++ "}"
+    globEither = parseFileGlob (specVersion $ localPkgDescr localBuildInfo) globText
+  in
+    case globEither of
+      Right glob ->
+        findAndMonitorDirFileGlob mbWorkDir verbosity searchDirs glob
+      Left err ->
+        liftIO $
+          dieWithException verbosity $
+            MatchDirFileGlob (explainGlobSyntaxError globText err)
+{-# INLINEABLE findAndMonitorSourceDirsFileExts #-}

changelog.d/hooks-api-exports.md

@@ -0,0 +1,24 @@
+---
+synopsis: Make Cabal-hooks library more self-sufficient
+packages: [Cabal-hooks]
+prs: 11772
+issues:
+---
+
+The `Distribution.Simple.SetupHooks` module from `Cabal-hooks` now re-exports
+a lot of the functionality that is commonly needed when writing `SetupHooks`:
+
+  - File-path related functionality from `Distribution.Utils.Path`.
+  - Functionality related to the program database: `lookupProgram`, `runProgramCwd`.
+  - IO utilities such as `warn`, `createDirectoryIfMissingVerbose`, and `rewriteFileEx`.
+  - Various types frequently used in pre-build rules, such as `Binary`,
+    `ModuleName`.
+  - Functions that extract information from `LocalBuildInfo` such as
+    `localPkgDescr`, `mbWorkDirLBI`, `withPrograms`, `interpretSymbolicPathLBI`
+    and `componentBuildInfo`.
+
+
+In addition, new file monitoring helper functions `findAndMonitorDirFileGlob`
+and `findAndMonitorSourceDirsFileExts` have been added. These make it very
+simple and convenient to search for a file glob or files with a particular
+extension in the source directories, for pre-build rules.

doc/how-to-use-setup-hooks.rst

@@ -233,7 +233,7 @@ register one pre-build rule for each such file:
           autogenDir = autogenComponentModulesDir lbi clbi
 
       -- Scan the source directories for .ppExt files, registering one rule each.
-      inputFiles <- findAndMonitorSourceDirsFileExt pbci "ppExt"
+      inputFiles <- findAndMonitorSourceDirsFileExts pbci ("ppExt" NE.:| [])
       for_ inputFiles $ \loc@(Location srcDir relPath) -> do
         let baseName = dropExtension (getSymbolicPath relPath)
         registerRule_ (fromString $ "myPP:" ++ baseName) $
@@ -273,3 +273,7 @@ For rules with dynamic dependencies (e.g. parsing dependencies from the
 input files), you can use ``dynamicRule``. The API for this is more complex;
 refer to `the Hackage documentation <https://hackage-content.haskell.org/package/Cabal-hooks-3.16/docs/Distribution-Simple-SetupHooks.html#v:dynamicRule>`__
 for details.
+
+A fully worked out representative example usage of pre-build rules, for
+preprocessing LBNF grammars, can be found
+`here <https://github.com/wenkokke/cabal-hooks-example/blob/main/SetupHooks.hs>`__.