module Hix.Managed.Handlers.Build where

import Data.Aeson (FromJSON)
import Data.IORef (IORef, newIORef)

import Hix.Data.Monad (M)
import Hix.Data.Overrides (Overrides)
import Hix.Data.PackageId (PackageId)
import Hix.Data.PackageName (PackageName)
import Hix.Data.Version (Version, Versions)
import Hix.Managed.Cabal.Changes (SolverPlan)
import Hix.Managed.Cabal.Data.Config (GhcDb)
import Hix.Managed.Data.Constraints (EnvConstraints)
import Hix.Managed.Data.EnvContext (EnvContext)
import Hix.Managed.Data.EnvState (EnvState)
import Hix.Managed.Data.Initial (Initial)
import Hix.Managed.Data.ManagedPackage (ManagedPackage)
import Hix.Managed.Data.Packages (Packages)
import Hix.Managed.Data.StageState (BuildStatus (Failure))
import qualified Hix.Managed.Handlers.Cabal as Solve
import qualified Hix.Managed.Handlers.Cabal as Cabal
import Hix.Managed.Handlers.Cabal (CabalHandlers)
import Hix.Managed.Handlers.Hackage (HackageHandlers)
import qualified Hix.Managed.Handlers.Report as Report
import Hix.Managed.Handlers.Report (ReportHandlers)
import qualified Hix.Managed.Handlers.StateFile as StateFileHandlers
import Hix.Managed.Handlers.StateFile (StateFileHandlers)
import Hix.Managed.Overrides (packageOverrides)

newtype BuildOutputsPrefix =
  BuildOutputsPrefix Text
  deriving stock (BuildOutputsPrefix -> BuildOutputsPrefix -> Bool
(BuildOutputsPrefix -> BuildOutputsPrefix -> Bool)
-> (BuildOutputsPrefix -> BuildOutputsPrefix -> Bool)
-> Eq BuildOutputsPrefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildOutputsPrefix -> BuildOutputsPrefix -> Bool
== :: BuildOutputsPrefix -> BuildOutputsPrefix -> Bool
$c/= :: BuildOutputsPrefix -> BuildOutputsPrefix -> Bool
/= :: BuildOutputsPrefix -> BuildOutputsPrefix -> Bool
Eq, Int -> BuildOutputsPrefix -> ShowS
[BuildOutputsPrefix] -> ShowS
BuildOutputsPrefix -> String
(Int -> BuildOutputsPrefix -> ShowS)
-> (BuildOutputsPrefix -> String)
-> ([BuildOutputsPrefix] -> ShowS)
-> Show BuildOutputsPrefix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildOutputsPrefix -> ShowS
showsPrec :: Int -> BuildOutputsPrefix -> ShowS
$cshow :: BuildOutputsPrefix -> String
show :: BuildOutputsPrefix -> String
$cshowList :: [BuildOutputsPrefix] -> ShowS
showList :: [BuildOutputsPrefix] -> ShowS
Show, (forall x. BuildOutputsPrefix -> Rep BuildOutputsPrefix x)
-> (forall x. Rep BuildOutputsPrefix x -> BuildOutputsPrefix)
-> Generic BuildOutputsPrefix
forall x. Rep BuildOutputsPrefix x -> BuildOutputsPrefix
forall x. BuildOutputsPrefix -> Rep BuildOutputsPrefix x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BuildOutputsPrefix -> Rep BuildOutputsPrefix x
from :: forall x. BuildOutputsPrefix -> Rep BuildOutputsPrefix x
$cto :: forall x. Rep BuildOutputsPrefix x -> BuildOutputsPrefix
to :: forall x. Rep BuildOutputsPrefix x -> BuildOutputsPrefix
Generic)
  deriving newtype (String -> BuildOutputsPrefix
(String -> BuildOutputsPrefix) -> IsString BuildOutputsPrefix
forall a. (String -> a) -> IsString a
$cfromString :: String -> BuildOutputsPrefix
fromString :: String -> BuildOutputsPrefix
IsString, Eq BuildOutputsPrefix
Eq BuildOutputsPrefix
-> (BuildOutputsPrefix -> BuildOutputsPrefix -> Ordering)
-> (BuildOutputsPrefix -> BuildOutputsPrefix -> Bool)
-> (BuildOutputsPrefix -> BuildOutputsPrefix -> Bool)
-> (BuildOutputsPrefix -> BuildOutputsPrefix -> Bool)
-> (BuildOutputsPrefix -> BuildOutputsPrefix -> Bool)
-> (BuildOutputsPrefix -> BuildOutputsPrefix -> BuildOutputsPrefix)
-> (BuildOutputsPrefix -> BuildOutputsPrefix -> BuildOutputsPrefix)
-> Ord BuildOutputsPrefix
BuildOutputsPrefix -> BuildOutputsPrefix -> Bool
BuildOutputsPrefix -> BuildOutputsPrefix -> Ordering
BuildOutputsPrefix -> BuildOutputsPrefix -> BuildOutputsPrefix
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BuildOutputsPrefix -> BuildOutputsPrefix -> Ordering
compare :: BuildOutputsPrefix -> BuildOutputsPrefix -> Ordering
$c< :: BuildOutputsPrefix -> BuildOutputsPrefix -> Bool
< :: BuildOutputsPrefix -> BuildOutputsPrefix -> Bool
$c<= :: BuildOutputsPrefix -> BuildOutputsPrefix -> Bool
<= :: BuildOutputsPrefix -> BuildOutputsPrefix -> Bool
$c> :: BuildOutputsPrefix -> BuildOutputsPrefix -> Bool
> :: BuildOutputsPrefix -> BuildOutputsPrefix -> Bool
$c>= :: BuildOutputsPrefix -> BuildOutputsPrefix -> Bool
>= :: BuildOutputsPrefix -> BuildOutputsPrefix -> Bool
$cmax :: BuildOutputsPrefix -> BuildOutputsPrefix -> BuildOutputsPrefix
max :: BuildOutputsPrefix -> BuildOutputsPrefix -> BuildOutputsPrefix
$cmin :: BuildOutputsPrefix -> BuildOutputsPrefix -> BuildOutputsPrefix
min :: BuildOutputsPrefix -> BuildOutputsPrefix -> BuildOutputsPrefix
Ord, Value -> Parser [BuildOutputsPrefix]
Value -> Parser BuildOutputsPrefix
(Value -> Parser BuildOutputsPrefix)
-> (Value -> Parser [BuildOutputsPrefix])
-> FromJSON BuildOutputsPrefix
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser BuildOutputsPrefix
parseJSON :: Value -> Parser BuildOutputsPrefix
$cparseJSONList :: Value -> Parser [BuildOutputsPrefix]
parseJSONList :: Value -> Parser [BuildOutputsPrefix]
FromJSON)

data EnvBuilder =
  EnvBuilder {
    EnvBuilder -> CabalHandlers
cabal :: CabalHandlers,
    EnvBuilder -> Versions -> [PackageId] -> M (Overrides, BuildStatus)
buildWithState :: Versions -> [PackageId] -> M (Overrides, BuildStatus)
  }

data Builder =
  Builder {
    Builder
-> forall a.
   CabalHandlers
   -> EnvContext -> Initial EnvState -> (EnvBuilder -> M a) -> M a
withEnvBuilder :: ∀ a . CabalHandlers -> EnvContext -> Initial EnvState -> (EnvBuilder -> M a) -> M a
  }

runBuilder :: Builder -> CabalHandlers -> EnvContext -> Initial EnvState -> (EnvBuilder -> M a) -> M a
runBuilder :: forall a.
Builder
-> CabalHandlers
-> EnvContext
-> Initial EnvState
-> (EnvBuilder -> M a)
-> M a
runBuilder Builder {forall a.
CabalHandlers
-> EnvContext -> Initial EnvState -> (EnvBuilder -> M a) -> M a
$sel:withEnvBuilder:Builder :: Builder
-> forall a.
   CabalHandlers
   -> EnvContext -> Initial EnvState -> (EnvBuilder -> M a) -> M a
withEnvBuilder :: forall a.
CabalHandlers
-> EnvContext -> Initial EnvState -> (EnvBuilder -> M a) -> M a
withEnvBuilder} = CabalHandlers
-> EnvContext -> Initial EnvState -> (EnvBuilder -> M a) -> M a
forall a.
CabalHandlers
-> EnvContext -> Initial EnvState -> (EnvBuilder -> M a) -> M a
withEnvBuilder

data BuildHandlers =
  BuildHandlers {
    BuildHandlers -> StateFileHandlers
stateFile :: StateFileHandlers,
    BuildHandlers -> ReportHandlers
report :: ReportHandlers,
    BuildHandlers
-> Packages ManagedPackage -> GhcDb -> M CabalHandlers
cabal :: Packages ManagedPackage -> GhcDb -> M CabalHandlers,
    BuildHandlers -> forall a. (Builder -> M a) -> M a
withBuilder :: ∀ a . (Builder -> M a) -> M a,
    BuildHandlers -> PackageName -> M [Version]
versions :: PackageName -> M [Version],
    BuildHandlers -> PackageName -> M (Maybe Version)
latestVersion :: PackageName -> M (Maybe Version)
  }

testBuilder :: (Versions -> [PackageId] -> M (Overrides, BuildStatus)) -> (Builder -> M a) -> M a
testBuilder :: forall a.
(Versions -> [PackageId] -> M (Overrides, BuildStatus))
-> (Builder -> M a) -> M a
testBuilder Versions -> [PackageId] -> M (Overrides, BuildStatus)
buildWithState Builder -> M a
use =
  Builder -> M a
use Builder {$sel:withEnvBuilder:Builder :: forall a.
CabalHandlers
-> EnvContext -> Initial EnvState -> (EnvBuilder -> M a) -> M a
withEnvBuilder = \ CabalHandlers
cabal EnvContext
_ Initial EnvState
_ EnvBuilder -> M a
useE -> EnvBuilder -> M a
useE EnvBuilder {CabalHandlers
$sel:cabal:EnvBuilder :: CabalHandlers
cabal :: CabalHandlers
cabal, Versions -> [PackageId] -> M (Overrides, BuildStatus)
$sel:buildWithState:EnvBuilder :: Versions -> [PackageId] -> M (Overrides, BuildStatus)
buildWithState :: Versions -> [PackageId] -> M (Overrides, BuildStatus)
buildWithState}}

versionsBuilder :: HackageHandlers -> (Versions -> M BuildStatus) -> (Builder -> M a) -> M a
versionsBuilder :: forall a.
HackageHandlers
-> (Versions -> M BuildStatus) -> (Builder -> M a) -> M a
versionsBuilder HackageHandlers
hackage Versions -> M BuildStatus
build =
  (Versions -> [PackageId] -> M (Overrides, BuildStatus))
-> (Builder -> M a) -> M a
forall a.
(Versions -> [PackageId] -> M (Overrides, BuildStatus))
-> (Builder -> M a) -> M a
testBuilder \ Versions
versions [PackageId]
overrideVersions -> do
    Overrides
overrides <- HackageHandlers -> [PackageId] -> M Overrides
packageOverrides HackageHandlers
hackage [PackageId]
overrideVersions
    BuildStatus
status <- Versions -> M BuildStatus
build Versions
versions
    pure (Overrides
overrides, BuildStatus
status)

handlersNull :: BuildHandlers
handlersNull :: BuildHandlers
handlersNull =
  BuildHandlers {
    $sel:stateFile:BuildHandlers :: StateFileHandlers
stateFile = StateFileHandlers
StateFileHandlers.handlersNull,
    $sel:report:BuildHandlers :: ReportHandlers
report = ReportHandlers
Report.handlersNull,
    $sel:cabal:BuildHandlers :: Packages ManagedPackage -> GhcDb -> M CabalHandlers
cabal = \ Packages ManagedPackage
_ GhcDb
_ -> CabalHandlers -> M CabalHandlers
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CabalHandlers
Solve.handlersNull,
    $sel:withBuilder:BuildHandlers :: forall a. (Builder -> M a) -> M a
withBuilder = (Versions -> [PackageId] -> M (Overrides, BuildStatus))
-> (Builder -> M a) -> M a
forall a.
(Versions -> [PackageId] -> M (Overrides, BuildStatus))
-> (Builder -> M a) -> M a
testBuilder \ Versions
_ [PackageId]
_ -> (Overrides, BuildStatus) -> M (Overrides, BuildStatus)
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Overrides
forall a. Monoid a => a
mempty, BuildStatus
Failure),
    $sel:versions:BuildHandlers :: PackageName -> M [Version]
versions = \ PackageName
_ -> [Version] -> M [Version]
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [],
    $sel:latestVersion:BuildHandlers :: PackageName -> M (Maybe Version)
latestVersion = \ PackageName
_ -> Maybe Version -> M (Maybe Version)
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing
  }

wrapCabal :: (CabalHandlers -> CabalHandlers) -> BuildHandlers -> BuildHandlers
wrapCabal :: (CabalHandlers -> CabalHandlers) -> BuildHandlers -> BuildHandlers
wrapCabal CabalHandlers -> CabalHandlers
f BuildHandlers {StateFileHandlers
ReportHandlers
PackageName -> M [Version]
PackageName -> M (Maybe Version)
Packages ManagedPackage -> GhcDb -> M CabalHandlers
forall a. (Builder -> M a) -> M a
$sel:stateFile:BuildHandlers :: BuildHandlers -> StateFileHandlers
$sel:report:BuildHandlers :: BuildHandlers -> ReportHandlers
$sel:cabal:BuildHandlers :: BuildHandlers
-> Packages ManagedPackage -> GhcDb -> M CabalHandlers
$sel:withBuilder:BuildHandlers :: BuildHandlers -> forall a. (Builder -> M a) -> M a
$sel:versions:BuildHandlers :: BuildHandlers -> PackageName -> M [Version]
$sel:latestVersion:BuildHandlers :: BuildHandlers -> PackageName -> M (Maybe Version)
stateFile :: StateFileHandlers
report :: ReportHandlers
cabal :: Packages ManagedPackage -> GhcDb -> M CabalHandlers
withBuilder :: forall a. (Builder -> M a) -> M a
versions :: PackageName -> M [Version]
latestVersion :: PackageName -> M (Maybe Version)
..} =
  BuildHandlers {$sel:cabal:BuildHandlers :: Packages ManagedPackage -> GhcDb -> M CabalHandlers
cabal = \ Packages ManagedPackage
p GhcDb
d -> CabalHandlers -> CabalHandlers
f (CabalHandlers -> CabalHandlers)
-> M CabalHandlers -> M CabalHandlers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Packages ManagedPackage -> GhcDb -> M CabalHandlers
cabal Packages ManagedPackage
p GhcDb
d, StateFileHandlers
ReportHandlers
PackageName -> M [Version]
PackageName -> M (Maybe Version)
(Builder -> M a) -> M a
forall a. (Builder -> M a) -> M a
$sel:stateFile:BuildHandlers :: StateFileHandlers
$sel:report:BuildHandlers :: ReportHandlers
$sel:withBuilder:BuildHandlers :: forall a. (Builder -> M a) -> M a
$sel:versions:BuildHandlers :: PackageName -> M [Version]
$sel:latestVersion:BuildHandlers :: PackageName -> M (Maybe Version)
stateFile :: StateFileHandlers
report :: ReportHandlers
withBuilder :: forall a. (Builder -> M a) -> M a
versions :: PackageName -> M [Version]
latestVersion :: PackageName -> M (Maybe Version)
..}

logCabal ::
  MonadIO m =>
  BuildHandlers ->
  m (IORef [(EnvConstraints, Maybe SolverPlan)], BuildHandlers)
logCabal :: forall (m :: * -> *).
MonadIO m =>
BuildHandlers
-> m (IORef [(EnvConstraints, Maybe SolverPlan)], BuildHandlers)
logCabal BuildHandlers
handlers = do
  IORef [(EnvConstraints, Maybe SolverPlan)]
ref <- IO (IORef [(EnvConstraints, Maybe SolverPlan)])
-> m (IORef [(EnvConstraints, Maybe SolverPlan)])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([(EnvConstraints, Maybe SolverPlan)]
-> IO (IORef [(EnvConstraints, Maybe SolverPlan)])
forall a. a -> IO (IORef a)
newIORef [])
  pure (IORef [(EnvConstraints, Maybe SolverPlan)]
ref, (CabalHandlers -> CabalHandlers) -> BuildHandlers -> BuildHandlers
wrapCabal (IORef [(EnvConstraints, Maybe SolverPlan)]
-> CabalHandlers -> CabalHandlers
Cabal.logCabal IORef [(EnvConstraints, Maybe SolverPlan)]
ref) BuildHandlers
handlers)

data SpecialBuildHandlers =
  TestBumpHandlers
  deriving stock (SpecialBuildHandlers -> SpecialBuildHandlers -> Bool
(SpecialBuildHandlers -> SpecialBuildHandlers -> Bool)
-> (SpecialBuildHandlers -> SpecialBuildHandlers -> Bool)
-> Eq SpecialBuildHandlers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecialBuildHandlers -> SpecialBuildHandlers -> Bool
== :: SpecialBuildHandlers -> SpecialBuildHandlers -> Bool
$c/= :: SpecialBuildHandlers -> SpecialBuildHandlers -> Bool
/= :: SpecialBuildHandlers -> SpecialBuildHandlers -> Bool
Eq, Int -> SpecialBuildHandlers -> ShowS
[SpecialBuildHandlers] -> ShowS
SpecialBuildHandlers -> String
(Int -> SpecialBuildHandlers -> ShowS)
-> (SpecialBuildHandlers -> String)
-> ([SpecialBuildHandlers] -> ShowS)
-> Show SpecialBuildHandlers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpecialBuildHandlers -> ShowS
showsPrec :: Int -> SpecialBuildHandlers -> ShowS
$cshow :: SpecialBuildHandlers -> String
show :: SpecialBuildHandlers -> String
$cshowList :: [SpecialBuildHandlers] -> ShowS
showList :: [SpecialBuildHandlers] -> ShowS
Show)