module Hix.Managed.EnvRequest where

import Control.Lens ((%~))
import Distribution.Pretty (pretty)
import Exon (exon)

import Hix.Class.Map (nFlatten, nMap, nRestrictKeys, (!!))
import Hix.Data.EnvName (EnvName)
import Hix.Data.Monad (M)
import Hix.Data.VersionBounds (majorRange)
import qualified Hix.Log as Log
import Hix.Managed.Data.Diff (Change (Unchanged))
import qualified Hix.Managed.Data.EnvContext
import Hix.Managed.Data.EnvContext (EnvContext)
import qualified Hix.Managed.Data.EnvRequest
import Hix.Managed.Data.EnvRequest (EnvRequest (EnvRequest))
import qualified Hix.Managed.Data.EnvResult
import Hix.Managed.Data.EnvResult (EnvResult)
import qualified Hix.Managed.Data.EnvState
import Hix.Managed.Data.EnvState (EnvState (EnvState))
import Hix.Managed.Data.Initial (Initial (Initial))
import Hix.Managed.Data.Mutable (mutReplace)
import qualified Hix.Managed.Data.ProcessState
import Hix.Managed.Data.ProcessState (ProcessState (ProcessState))
import qualified Hix.Managed.Data.ProjectState
import Hix.Managed.Data.ProjectState (ProjectState)
import Hix.Managed.Data.Targets (overTargets, targetsSet)
import Hix.Managed.Diff (initChanges, reifyBoundsChange)
import qualified Hix.Managed.Handlers.Build
import Hix.Managed.Handlers.Build (BuildHandlers, Builder, runBuilder)
import Hix.Managed.UpdateState (projectStateWithEnv)

initialEnvState ::
  EnvContext ->
  ProjectState ->
  Initial EnvState
initialEnvState :: EnvContext -> ProjectState -> Initial EnvState
initialEnvState EnvContext
context ProjectState
projectState =
  EnvState -> Initial EnvState
forall a. a -> Initial a
Initial EnvState {Overrides
MutableDeps VersionChange
MutableDeps BoundsChange
bounds :: MutableDeps BoundsChange
versions :: MutableDeps VersionChange
overrides :: Overrides
initial :: MutableDeps VersionChange
initial :: MutableDeps VersionChange
overrides :: Overrides
versions :: MutableDeps VersionChange
bounds :: MutableDeps BoundsChange
..}
  where
    bounds :: MutableDeps BoundsChange
bounds = (VersionBounds -> BoundsChange)
-> Packages MutableBounds -> MutableDeps BoundsChange
forall map1 map2 map3 k1 k2 v1 v2 s1 s2.
(Monoid map2, NMap map1 k1 map2 LookupMonoid, NMap map2 k2 v1 s1,
 NMap map3 k2 v2 s2) =>
(v1 -> v2) -> map1 -> map3
nFlatten (Maybe VersionBounds -> BoundsChange
forall d a. Maybe a -> Change d a
Unchanged (Maybe VersionBounds -> BoundsChange)
-> (VersionBounds -> Maybe VersionBounds)
-> VersionBounds
-> BoundsChange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionBounds -> Maybe VersionBounds
forall a. a -> Maybe a
Just) (Set LocalPackage
-> Packages MutableBounds -> Packages MutableBounds
forall map k v sort. NMap map k v sort => Set k -> map -> map
nRestrictKeys (Targets -> Set LocalPackage
targetsSet EnvContext
context.targets) ProjectState
projectState.bounds)
    versions :: MutableDeps VersionChange
versions = MutableVersions -> MutableDeps VersionChange
forall map1 k v1 s1 map2 d s2.
(NMap map1 k (Maybe v1) s1, NMap map2 k (Change d v1) s2) =>
map1 -> map2
initChanges (ProjectState
projectState.versions Envs MutableVersions -> EnvName -> MutableVersions
forall map k v sort l.
(NMap map k v sort, NLookup sort k v l) =>
map -> k -> l
!! EnvContext
context.env)
    overrides :: Overrides
overrides = ProjectState
projectState.overrides Envs Overrides -> EnvName -> Overrides
forall map k v sort l.
(NMap map k v sort, NLookup sort k v l) =>
map -> k -> l
!! EnvContext
context.env
    initial :: MutableDeps VersionChange
initial = MutableVersions -> MutableDeps VersionChange
forall map1 k v1 s1 map2 d s2.
(NMap map1 k (Maybe v1) s1, NMap map2 k (Change d v1) s2) =>
map1 -> map2
initChanges (ProjectState
projectState.initial Envs MutableVersions -> EnvName -> MutableVersions
forall map k v sort l.
(NMap map k v sort, NLookup sort k v l) =>
map -> k -> l
!! EnvContext
context.env)

updateProcessState ::
  EnvContext ->
  Initial EnvState ->
  EnvResult ->
  ProcessState ->
  ProcessState
updateProcessState :: EnvContext
-> Initial EnvState -> EnvResult -> ProcessState -> ProcessState
updateProcessState EnvContext
context (Initial EnvState
initialState) EnvResult
envResult ProcessState {state :: ProcessState -> ProjectState
state = ProjectState
projectState, Packages ManagedPackage
packages :: Packages ManagedPackage
packages :: ProcessState -> Packages ManagedPackage
packages} = do
  ProcessState {
    packages :: Packages ManagedPackage
packages = Targets
-> (ManagedPackage -> ManagedPackage)
-> Packages ManagedPackage
-> Packages ManagedPackage
forall a. Targets -> (a -> a) -> Packages a -> Packages a
overTargets EnvContext
context.targets ManagedPackage -> ManagedPackage
replaceBounds Packages ManagedPackage
packages,
    state :: ProjectState
state = EnvContext -> EnvState -> ProjectState -> ProjectState
projectStateWithEnv EnvContext
context EnvState
final ProjectState
projectState
  }
  where
    replaceBounds :: ManagedPackage -> ManagedPackage
replaceBounds = ASetter ManagedPackage ManagedPackage MutableRanges MutableRanges
#mutable ASetter ManagedPackage ManagedPackage MutableRanges MutableRanges
-> (MutableRanges -> MutableRanges)
-> ManagedPackage
-> ManagedPackage
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ MutableRanges -> MutableRanges -> MutableRanges
forall map v sort. NMap map MutableDep v sort => map -> map -> map
mutReplace MutableRanges
ranges
    ranges :: MutableRanges
ranges = (BoundsChange -> VersionRange)
-> MutableDeps BoundsChange -> MutableRanges
forall map1 k v1 sort1 map2 v2 sort2.
(NMap map1 k v1 sort1, NMap map2 k v2 sort2) =>
(v1 -> v2) -> map1 -> map2
nMap (VersionBounds -> VersionRange
majorRange (VersionBounds -> VersionRange)
-> (BoundsChange -> VersionBounds) -> BoundsChange -> VersionRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundsChange -> VersionBounds
reifyBoundsChange) EnvState
final.bounds
    final :: EnvState
final = EnvState -> Maybe EnvState -> EnvState
forall a. a -> Maybe a -> a
fromMaybe EnvState
initialState EnvResult
envResult.state

withEnvRequest ::
  BuildHandlers ->
  ProcessState ->
  EnvContext ->
  Builder ->
  (EnvRequest -> M EnvResult) ->
  M (ProcessState, EnvResult)
withEnvRequest :: BuildHandlers
-> ProcessState
-> EnvContext
-> Builder
-> (EnvRequest -> M EnvResult)
-> M (ProcessState, EnvResult)
withEnvRequest BuildHandlers
build ProcessState
state EnvContext
context Builder
builder EnvRequest -> M EnvResult
use = do
  CabalHandlers
cabal <- BuildHandlers
build.cabal ProcessState
state.packages EnvContext
context.ghc
  EnvResult
envResult <- Builder
-> CabalHandlers
-> EnvContext
-> Initial EnvState
-> (EnvBuilder -> M EnvResult)
-> M EnvResult
forall a.
Builder
-> CabalHandlers
-> EnvContext
-> Initial EnvState
-> (EnvBuilder -> M a)
-> M a
runBuilder Builder
builder CabalHandlers
cabal EnvContext
context Initial EnvState
initialState \ EnvBuilder
envBuilder ->
    EnvRequest -> M EnvResult
use EnvRequest {EnvContext
context :: EnvContext
context :: EnvContext
context, builder :: EnvBuilder
builder = EnvBuilder
envBuilder, state :: Initial EnvState
state = Initial EnvState
initialState}
  let newState :: ProcessState
newState = EnvContext
-> Initial EnvState -> EnvResult -> ProcessState -> ProcessState
updateProcessState EnvContext
context Initial EnvState
initialState EnvResult
envResult ProcessState
state
  Text -> M ()
Log.debug [exon|Finished '##{context.env :: EnvName}' with final state:|]
  Doc -> M ()
Log.debugP (ProcessState -> Doc
forall a. Pretty a => a -> Doc
pretty ProcessState
newState)
  pure (ProcessState
newState, EnvResult
envResult)
  where
    initialState :: Initial EnvState
initialState = EnvContext -> ProjectState -> Initial EnvState
initialEnvState EnvContext
context ProcessState
state.state