{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE StaticPointers #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
module Distribution.Simple.SetupHooks
(
SetupHooks(..)
, noSetupHooks
, ConfigureHooks(..)
, noConfigureHooks
, PreConfPackageInputs(..)
, PreConfPackageOutputs(..)
, noPreConfPackageOutputs
, PreConfPackageHook
, PostConfPackageInputs(..)
, PostConfPackageHook
, PreConfComponentInputs(..)
, PreConfComponentOutputs(..)
, noPreConfComponentOutputs
, PreConfComponentHook
, ComponentDiff(..), emptyComponentDiff, buildInfoComponentDiff
, LibraryDiff, ForeignLibDiff, ExecutableDiff
, TestSuiteDiff, BenchmarkDiff
, BuildInfoDiff
, BuildHooks(..), noBuildHooks
, BuildingWhat(..), buildingWhatVerbosity, buildingWhatDistPref
, PreBuildComponentInputs(..)
, PreBuildComponentRules
, PostBuildComponentInputs(..)
, PostBuildComponentHook
, Rules
, rules
, noRules
, Rule
, Dependency (..)
, RuleOutput (..)
, RuleId
, staticRule, dynamicRule
, Location(..)
, location
, autogenComponentModulesDir
, componentBuildDir
, RuleCommands(..)
, Command
, mkCommand
, Dict(..)
, RulesM
, registerRule
, registerRule_
, addRuleMonitors
, module Distribution.Simple.FileMonitor.Types
, InstallHooks(..), noInstallHooks
, InstallComponentInputs(..), InstallComponentHook
, ConfigFlags(..)
, BuildFlags(..), ReplFlags(..), HaddockFlags(..), HscolourFlags(..)
, CopyFlags(..)
, installFileGlob
, Program(..), ConfiguredProgram(..), ProgArg
, ProgramLocation(..)
, ProgramDb
, addKnownPrograms
, configureUnconfiguredProgram
, simpleProgram
, Verbosity, Compiler(..), Platform(..), Suffix(..)
, LocalBuildConfig, LocalBuildInfo, PackageBuildDescr
, PackageDescription(..)
, Component(..), ComponentName(..), componentName
, BuildInfo(..), emptyBuildInfo
, TargetInfo(..), ComponentLocalBuildInfo(..)
, Library(..), ForeignLib(..), Executable(..)
, TestSuite(..), Benchmark(..)
, LibraryName(..)
, emptyLibrary, emptyForeignLib, emptyExecutable
, emptyTestSuite, emptyBenchmark
)
where
import Distribution.PackageDescription
( PackageDescription(..)
, Library(..), ForeignLib(..)
, Executable(..), TestSuite(..), Benchmark(..)
, emptyLibrary, emptyForeignLib
, emptyExecutable, emptyBenchmark, emptyTestSuite
, BuildInfo(..), emptyBuildInfo
, ComponentName(..), LibraryName(..)
)
import Distribution.Simple.BuildPaths
( autogenComponentModulesDir )
import Distribution.Simple.Compiler
( Compiler(..) )
import Distribution.Simple.Errors
( CabalException(SetupHooksException) )
import Distribution.Simple.FileMonitor.Types
import Distribution.Simple.Install
( installFileGlob )
import Distribution.Simple.LocalBuildInfo
( componentBuildDir )
import Distribution.Simple.PreProcess.Types
( Suffix(..) )
import Distribution.Simple.Program.Db
( ProgramDb, addKnownPrograms
, configureUnconfiguredProgram
)
import Distribution.Simple.Program.Find
( simpleProgram )
import Distribution.Simple.Program.Types
( Program(..), ConfiguredProgram(..)
, ProgArg
, ProgramLocation(..)
)
import Distribution.Simple.Setup
( BuildFlags(..)
, ConfigFlags(..)
, CopyFlags(..)
, HaddockFlags(..)
, HscolourFlags(..)
, ReplFlags(..)
)
import Distribution.Simple.SetupHooks.Errors
import Distribution.Simple.SetupHooks.Internal
import Distribution.Simple.SetupHooks.Rule as Rule
import Distribution.Simple.Utils
( dieWithException )
import Distribution.System
( Platform(..) )
import Distribution.Types.Component
( Component(..), componentName )
import Distribution.Types.ComponentLocalBuildInfo
( ComponentLocalBuildInfo(..) )
import Distribution.Types.LocalBuildInfo
( LocalBuildInfo(..) )
import Distribution.Types.LocalBuildConfig
( LocalBuildConfig, PackageBuildDescr )
import Distribution.Types.TargetInfo
( TargetInfo(..) )
import Distribution.Utils.ShortText
( ShortText )
import Distribution.Verbosity
( Verbosity )
import Control.Monad
( void )
import Control.Monad.IO.Class
( MonadIO(liftIO) )
import Control.Monad.Trans.Class
( lift )
import qualified Control.Monad.Trans.Reader as Reader
import qualified Control.Monad.Trans.State as State
#if MIN_VERSION_transformers(0,5,6)
import qualified Control.Monad.Trans.Writer.CPS as Writer
#else
import qualified Control.Monad.Trans.Writer.Strict as Writer
#endif
import Data.Foldable
( for_ )
import Data.Map.Strict as Map
( insertLookupWithKey )
registerRule
:: ShortText
-> Rule
-> RulesM RuleId
registerRule :: ShortText -> Rule -> RulesM RuleId
registerRule ShortText
nm !Rule
newRule = ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
RuleId
-> RulesM RuleId
forall (m :: * -> *) a.
ReaderT
RulesEnv (StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m)) a
-> RulesT m a
RulesT (ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
RuleId
-> RulesM RuleId)
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
RuleId
-> RulesM RuleId
forall a b. (a -> b) -> a -> b
$ do
RulesEnv { rulesEnvNameSpace :: RulesEnv -> RulesNameSpace
rulesEnvNameSpace = RulesNameSpace
ns
, rulesEnvVerbosity :: RulesEnv -> Verbosity
rulesEnvVerbosity = Verbosity
verbosity } <- ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
RulesEnv
forall (m :: * -> *) r. Monad m => ReaderT r m r
Reader.ask
Map RuleId Rule
oldRules <- StateT
(Map RuleId Rule) (WriterT [MonitorFilePath] IO) (Map RuleId Rule)
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
(Map RuleId Rule)
forall (m :: * -> *) a. Monad m => m a -> ReaderT RulesEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT
(Map RuleId Rule) (WriterT [MonitorFilePath] IO) (Map RuleId Rule)
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
(Map RuleId Rule))
-> StateT
(Map RuleId Rule) (WriterT [MonitorFilePath] IO) (Map RuleId Rule)
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
(Map RuleId Rule)
forall a b. (a -> b) -> a -> b
$ StateT
(Map RuleId Rule) (WriterT [MonitorFilePath] IO) (Map RuleId Rule)
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
let rId :: RuleId
rId = RuleId { ruleNameSpace :: RulesNameSpace
ruleNameSpace = RulesNameSpace
ns, ruleName :: ShortText
ruleName = ShortText
nm }
(Maybe Rule
mbDup, Map RuleId Rule
newRules) = (RuleId -> Rule -> Rule -> Rule)
-> RuleId
-> Rule
-> Map RuleId Rule
-> (Maybe Rule, Map RuleId Rule)
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
Map.insertLookupWithKey (\ RuleId
_ Rule
new Rule
_old -> Rule
new) RuleId
rId Rule
newRule Map RuleId Rule
oldRules
Maybe Rule
-> (Rule
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
Any)
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Rule
mbDup ((Rule
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
Any)
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
())
-> (Rule
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
Any)
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
()
forall a b. (a -> b) -> a -> b
$ \ Rule
oldRule ->
IO Any
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
Any
forall a.
IO a
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Any
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
Any)
-> IO Any
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
Any
forall a b. (a -> b) -> a -> b
$ Verbosity -> CabalException -> IO Any
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity
(CabalException -> IO Any) -> CabalException -> IO Any
forall a b. (a -> b) -> a -> b
$ SetupHooksException -> CabalException
SetupHooksException
(SetupHooksException -> CabalException)
-> SetupHooksException -> CabalException
forall a b. (a -> b) -> a -> b
$ RulesException -> SetupHooksException
RulesException
(RulesException -> SetupHooksException)
-> RulesException -> SetupHooksException
forall a b. (a -> b) -> a -> b
$ RuleId -> Rule -> Rule -> RulesException
DuplicateRuleId RuleId
rId Rule
oldRule Rule
newRule
StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO) ()
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
()
forall (m :: * -> *) a. Monad m => m a -> ReaderT RulesEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO) ()
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
())
-> StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO) ()
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
()
forall a b. (a -> b) -> a -> b
$ Map RuleId Rule
-> StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put Map RuleId Rule
newRules
RuleId
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
RuleId
forall a.
a
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] IO))
a
forall (m :: * -> *) a. Monad m => a -> m a
return RuleId
rId
registerRule_
:: ShortText
-> Rule
-> RulesT IO ()
registerRule_ :: ShortText -> Rule -> RulesT IO ()
registerRule_ ShortText
i Rule
r = RulesM RuleId -> RulesT IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RulesM RuleId -> RulesT IO ()) -> RulesM RuleId -> RulesT IO ()
forall a b. (a -> b) -> a -> b
$ ShortText -> Rule -> RulesM RuleId
registerRule ShortText
i Rule
r
addRuleMonitors :: Monad m => [MonitorFilePath] -> RulesT m ()
addRuleMonitors :: forall (m :: * -> *). Monad m => [MonitorFilePath] -> RulesT m ()
addRuleMonitors = ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m))
()
-> RulesT m ()
forall (m :: * -> *) a.
ReaderT
RulesEnv (StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m)) a
-> RulesT m a
RulesT (ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m))
()
-> RulesT m ())
-> ([MonitorFilePath]
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m))
())
-> [MonitorFilePath]
-> RulesT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m) ()
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m))
()
forall (m :: * -> *) a. Monad m => m a -> ReaderT RulesEnv m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m) ()
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m))
())
-> ([MonitorFilePath]
-> StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m) ())
-> [MonitorFilePath]
-> ReaderT
RulesEnv
(StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m))
()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [MonitorFilePath] m ()
-> StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m) ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Map RuleId Rule) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT [MonitorFilePath] m ()
-> StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m) ())
-> ([MonitorFilePath] -> WriterT [MonitorFilePath] m ())
-> [MonitorFilePath]
-> StateT (Map RuleId Rule) (WriterT [MonitorFilePath] m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MonitorFilePath] -> WriterT [MonitorFilePath] m ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
Writer.tell
{-# INLINEABLE addRuleMonitors #-}