diff --git a/Cabal-hooks/src/Distribution/Simple/SetupHooks.hs b/Cabal-hooks/src/Distribution/Simple/SetupHooks.hs index a625b17de0f..492d3c96993 100644 --- a/Cabal-hooks/src/Distribution/Simple/SetupHooks.hs +++ b/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,7 +289,12 @@ 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 @@ -220,15 +302,25 @@ import Distribution.Types.Component 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 #-} diff --git a/changelog.d/hooks-api-exports.md b/changelog.d/hooks-api-exports.md new file mode 100644 index 00000000000..dc9a13316e8 --- /dev/null +++ b/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. diff --git a/doc/how-to-use-setup-hooks.rst b/doc/how-to-use-setup-hooks.rst index 917c495025f..6036509761a 100644 --- a/doc/how-to-use-setup-hooks.rst +++ b/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 `__ for details. + +A fully worked out representative example usage of pre-build rules, for +preprocessing LBNF grammars, can be found +`here `__.