module Hix.Managed.Bump.Candidates where

import Distribution.Version (Version)

import Hix.Data.Monad (M)
import qualified Hix.Managed.Data.Bump
import Hix.Managed.Data.Bump (Bump (Bump))
import Hix.Managed.Data.Mutable (depName)
import qualified Hix.Managed.Data.Mutation
import Hix.Managed.Data.Mutation (DepMutation (DepMutation))
import qualified Hix.Managed.Data.QueryDep
import Hix.Managed.Data.QueryDep (QueryDep (QueryDep))
import qualified Hix.Managed.Handlers.Build
import Hix.Managed.Handlers.Build (BuildHandlers)
import Hix.Version (nextMajor)

-- | We only want to report a bump if the new version actually changes the build.
isBump :: Version -> Maybe Version -> Bool
isBump :: Version -> Maybe Version -> Bool
isBump Version
version = \case
  Just Version
current -> Version
version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> Version
current
  Maybe Version
Nothing -> Bool
True

-- | Decide whether the latest version of a dependency requires changes to the currently specified bound.
--
-- If no latest version can be found, we return 'Nothing' to indicate that the dep should be skipped.
--
-- Otherwise, the range field of the 'DepMutation' is determined:
--
-- If the specified dependency has no upper bound (e.g. because the user has only entered the package name and ran the
-- app to resolve the bounds), or if the latest version is outside of the existing bounds, then we add a new bound to
-- the managed state, so we extend the version range by setting the upper bound to the major prefix of the next-highest
-- major of the latest version and return 'NewBounds'.
--
-- Otherwise, we return 'OldBounds'.
candidatesBump ::
  BuildHandlers ->
  QueryDep ->
  M (Maybe (DepMutation Bump))
candidatesBump :: BuildHandlers -> QueryDep -> M (Maybe (DepMutation Bump))
candidatesBump BuildHandlers
handlers QueryDep {MutableDep
package :: MutableDep
package :: QueryDep -> MutableDep
package, Maybe Version
current :: Maybe Version
current :: QueryDep -> Maybe Version
current} = do
  (Version -> DepMutation Bump)
-> Maybe Version -> Maybe (DepMutation Bump)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Version -> DepMutation Bump
mutation (Maybe Version -> Maybe (DepMutation Bump))
-> M (Maybe Version) -> M (Maybe (DepMutation Bump))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BuildHandlers
handlers.latestVersion (MutableDep -> PackageName
depName MutableDep
package)
  where
    mutation :: Version -> DepMutation Bump
mutation Version
version =
      DepMutation {
        MutableDep
package :: MutableDep
package :: MutableDep
package,
        retract :: Bool
retract = Bool
False,
        mutation :: Bump
mutation = Bump {Version
version :: Version
version :: Version
version, bound :: Version
bound = Version -> Version
nextMajor Version
version, changed :: Bool
changed = Version -> Maybe Version -> Bool
isBump Version
version Maybe Version
current}
      }