module Hix.Managed.Handlers.Build.Test where import Data.IORef (IORef) import Data.Map.Strict ((!?)) import Exon (exon) import Hix.Data.Monad (M) import Hix.Data.NixExpr (Expr) import qualified Hix.Data.PackageId import Hix.Data.PackageName (PackageName) import Hix.Data.Version (Version, Versions) import Hix.Managed.Cabal.Data.Config (CabalConfig) import qualified Hix.Managed.Cabal.Data.Packages import Hix.Managed.Cabal.Data.Packages (GhcPackages) import Hix.Managed.Cabal.Mock.SourcePackage (queryVersions, queryVersionsLatest, sourcePackageVersions) import Hix.Managed.Data.BuildConfig (BuildConfig) import Hix.Managed.Data.EnvConfig (EnvConfig) import Hix.Managed.Data.Envs (Envs) import Hix.Managed.Data.Mutation (FailedMutation) import Hix.Managed.Data.StageState (BuildResult) import Hix.Managed.Data.StateFileConfig (StateFileConfig) import Hix.Managed.Handlers.Build ( BuildHandlers (..), BuildOutputsPrefix, SpecialBuildHandlers (TestBumpHandlers), versionsBuilder, ) import Hix.Managed.Handlers.Build.Prod (handlersProd) import qualified Hix.Managed.Handlers.Cabal.Prod as CabalHandlers import Hix.Managed.Handlers.Cabal.Prod (testPackagesBump) import qualified Hix.Managed.Handlers.Hackage as HackageHandlers import qualified Hix.Managed.Handlers.Report.Test as ReportHandlers import qualified Hix.Managed.Handlers.StateFile.Test as StateFile import Hix.Monad (clientError) handlersUnitTest :: MonadIO m => GhcPackages -> (Versions -> M BuildResult) -> m (BuildHandlers, IORef [Expr], IORef [FailedMutation]) handlersUnitTest :: forall (m :: * -> *). MonadIO m => GhcPackages -> (Versions -> M BuildResult) -> m (BuildHandlers, IORef [Expr], IORef [FailedMutation]) handlersUnitTest GhcPackages ghcPackages Versions -> M BuildResult builder = do (StateFileHandlers stateFile, IORef [Expr] stateFileRef) <- m (StateFileHandlers, IORef [Expr]) forall (m :: * -> *). MonadIO m => m (StateFileHandlers, IORef [Expr]) StateFile.handlersUnitTest (ReportHandlers report, IORef [FailedMutation] mutationsRef) <- m (ReportHandlers, IORef [FailedMutation]) forall (m :: * -> *). MonadIO m => m (ReportHandlers, IORef [FailedMutation]) ReportHandlers.handlersUnitTest let handlers :: BuildHandlers handlers = BuildHandlers { StateFileHandlers stateFile :: StateFileHandlers stateFile :: StateFileHandlers stateFile, ReportHandlers report :: ReportHandlers report :: ReportHandlers report, Packages ManagedPackage -> GhcDb -> M CabalHandlers cabal :: Packages ManagedPackage -> GhcDb -> M CabalHandlers cabal :: Packages ManagedPackage -> GhcDb -> M CabalHandlers cabal, withBuilder :: forall a. (Builder -> M a) -> M a withBuilder = HackageHandlers -> (Versions -> M BuildResult) -> (Builder -> M a) -> M a forall a. HackageHandlers -> (Versions -> M BuildResult) -> (Builder -> M a) -> M a versionsBuilder HackageHandlers HackageHandlers.handlersNull Versions -> M BuildResult builder, versions :: PackageName -> M [Version] versions = SourcePackageVersions -> PackageName -> M [Version] queryVersions SourcePackageVersions versions, latestVersion :: PackageName -> M (Maybe Version) latestVersion = SourcePackageVersions -> PackageName -> M (Maybe Version) queryVersionsLatest SourcePackageVersions versions } (BuildHandlers, IORef [Expr], IORef [FailedMutation]) -> m (BuildHandlers, IORef [Expr], IORef [FailedMutation]) forall a. a -> m a forall (f :: * -> *) a. Applicative f => a -> f a pure (BuildHandlers handlers, IORef [Expr] stateFileRef, IORef [FailedMutation] mutationsRef) where cabal :: Packages ManagedPackage -> GhcDb -> M CabalHandlers cabal = CabalConfig -> Bool -> Packages ManagedPackage -> GhcDb -> M CabalHandlers CabalHandlers.handlersProd CabalConfig forall a. Default a => a def Bool False versions :: SourcePackageVersions versions = SourcePackages -> SourcePackageVersions sourcePackageVersions GhcPackages ghcPackages.available latestVersionNixTestBump :: PackageName -> M (Maybe Version) latestVersionNixTestBump :: PackageName -> M (Maybe Version) latestVersionNixTestBump PackageName name = M (Maybe Version) -> (PackageId -> M (Maybe Version)) -> Maybe PackageId -> M (Maybe Version) forall b a. b -> (a -> b) -> Maybe a -> b maybe M (Maybe Version) invalid PackageId -> M (Maybe Version) found (Map PackageName PackageId testPackagesBump Map PackageName PackageId -> PackageName -> Maybe PackageId forall k a. Ord k => Map k a -> k -> Maybe a !? PackageName name) where invalid :: M (Maybe Version) invalid = Text -> M (Maybe Version) forall a. Text -> M a clientError [exon|Invalid package for latestVersion: ##{name}|] found :: PackageId -> M (Maybe Version) found = Maybe Version -> M (Maybe Version) forall a. a -> M a forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Version -> M (Maybe Version)) -> (PackageId -> Maybe Version) -> PackageId -> M (Maybe Version) forall b c a. (b -> c) -> (a -> b) -> a -> c . Version -> Maybe Version forall a. a -> Maybe a Just (Version -> Maybe Version) -> (PackageId -> Version) -> PackageId -> Maybe Version forall b c a. (b -> c) -> (a -> b) -> a -> c . (.version) handlersBumpTest :: MonadIO m => StateFileConfig -> Envs EnvConfig -> Maybe BuildOutputsPrefix -> BuildConfig -> CabalConfig -> Bool -> m BuildHandlers handlersBumpTest :: forall (m :: * -> *). MonadIO m => StateFileConfig -> Envs EnvConfig -> Maybe BuildOutputsPrefix -> BuildConfig -> CabalConfig -> Bool -> m BuildHandlers handlersBumpTest StateFileConfig stateFileConf Envs EnvConfig envsConf Maybe BuildOutputsPrefix buildOutputsPrefix BuildConfig buildConf CabalConfig cabalConf Bool oldest = do BuildHandlers handlers <- StateFileConfig -> Envs EnvConfig -> Maybe BuildOutputsPrefix -> BuildConfig -> CabalConfig -> Bool -> m BuildHandlers forall (m :: * -> *). MonadIO m => StateFileConfig -> Envs EnvConfig -> Maybe BuildOutputsPrefix -> BuildConfig -> CabalConfig -> Bool -> m BuildHandlers handlersProd StateFileConfig stateFileConf Envs EnvConfig envsConf Maybe BuildOutputsPrefix buildOutputsPrefix BuildConfig buildConf CabalConfig cabalConf Bool oldest pure BuildHandlers handlers { cabal = CabalHandlers.handlersTest cabalConf oldest, latestVersion = latestVersionNixTestBump } chooseHandlers :: MonadIO m => StateFileConfig -> Envs EnvConfig -> Maybe BuildOutputsPrefix -> BuildConfig -> CabalConfig -> Maybe SpecialBuildHandlers -> m BuildHandlers chooseHandlers :: forall (m :: * -> *). MonadIO m => StateFileConfig -> Envs EnvConfig -> Maybe BuildOutputsPrefix -> BuildConfig -> CabalConfig -> Maybe SpecialBuildHandlers -> m BuildHandlers chooseHandlers StateFileConfig stateFileConf Envs EnvConfig envsConf Maybe BuildOutputsPrefix buildOutputsPrefix BuildConfig buildConf CabalConfig cabalConf = \case Just SpecialBuildHandlers TestBumpHandlers -> StateFileConfig -> Envs EnvConfig -> Maybe BuildOutputsPrefix -> BuildConfig -> CabalConfig -> Bool -> m BuildHandlers forall (m :: * -> *). MonadIO m => StateFileConfig -> Envs EnvConfig -> Maybe BuildOutputsPrefix -> BuildConfig -> CabalConfig -> Bool -> m BuildHandlers handlersBumpTest StateFileConfig stateFileConf Envs EnvConfig envsConf Maybe BuildOutputsPrefix buildOutputsPrefix BuildConfig buildConf CabalConfig cabalConf Bool oldest Maybe SpecialBuildHandlers Nothing -> StateFileConfig -> Envs EnvConfig -> Maybe BuildOutputsPrefix -> BuildConfig -> CabalConfig -> Bool -> m BuildHandlers forall (m :: * -> *). MonadIO m => StateFileConfig -> Envs EnvConfig -> Maybe BuildOutputsPrefix -> BuildConfig -> CabalConfig -> Bool -> m BuildHandlers handlersProd StateFileConfig stateFileConf Envs EnvConfig envsConf Maybe BuildOutputsPrefix buildOutputsPrefix BuildConfig buildConf CabalConfig cabalConf Bool oldest where oldest :: Bool oldest = Bool False