module Hix.Managed.Cabal.Changes where

import Data.List (partition)
import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
import Distribution.Client.SolverInstallPlan (ResolverPackage (Configured, PreExisting), SolverInstallPlan)
import Distribution.InstalledPackageInfo (InstalledPackageInfo (..))
import Distribution.Pretty (Pretty, pretty)
import Distribution.Solver.Types.InstSolverPackage (InstSolverPackage (..))
import Distribution.Solver.Types.SolverPackage (SolverPackage (..))
import Distribution.Solver.Types.SourcePackage (SourcePackage (..))
import Text.PrettyPrint (hang, ($+$))

import qualified Hix.Data.PackageId as PackageId
import Hix.Data.PackageId (PackageId)
import Hix.Data.Version (Versions)
import Hix.Managed.Cabal.Config (isNonReinstallableId)
import Hix.Pretty (prettyL)

-- | Raw results from Cabal, which include local packages in the overrides.
data SolverPlan =
  SolverPlan {
    -- | Deps whose versions differ from those in the package db, i.e. where the GHC set from nixpkgs has a different
    -- version.
    -- We need to add Nix overrides for these.
    SolverPlan -> [PackageId]
changes :: [PackageId],

    -- | Versions that match those in the package db.
    -- We don't need to add Nix overrides for these.
    SolverPlan -> [PackageId]
matching :: [PackageId],

    -- | GHC boot packages that were selected for reinstallation, which is an error with the default settings.
    SolverPlan -> Maybe (NonEmpty PackageId)
nonReinstallable :: Maybe (NonEmpty PackageId)
  }
  deriving stock (SolverPlan -> SolverPlan -> Bool
(SolverPlan -> SolverPlan -> Bool)
-> (SolverPlan -> SolverPlan -> Bool) -> Eq SolverPlan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SolverPlan -> SolverPlan -> Bool
== :: SolverPlan -> SolverPlan -> Bool
$c/= :: SolverPlan -> SolverPlan -> Bool
/= :: SolverPlan -> SolverPlan -> Bool
Eq, Int -> SolverPlan -> ShowS
[SolverPlan] -> ShowS
SolverPlan -> String
(Int -> SolverPlan -> ShowS)
-> (SolverPlan -> String)
-> ([SolverPlan] -> ShowS)
-> Show SolverPlan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SolverPlan -> ShowS
showsPrec :: Int -> SolverPlan -> ShowS
$cshow :: SolverPlan -> String
show :: SolverPlan -> String
$cshowList :: [SolverPlan] -> ShowS
showList :: [SolverPlan] -> ShowS
Show, (forall x. SolverPlan -> Rep SolverPlan x)
-> (forall x. Rep SolverPlan x -> SolverPlan) -> Generic SolverPlan
forall x. Rep SolverPlan x -> SolverPlan
forall x. SolverPlan -> Rep SolverPlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SolverPlan -> Rep SolverPlan x
from :: forall x. SolverPlan -> Rep SolverPlan x
$cto :: forall x. Rep SolverPlan x -> SolverPlan
to :: forall x. Rep SolverPlan x -> SolverPlan
Generic)

instance Pretty SolverPlan where
  pretty :: SolverPlan -> Doc
pretty SolverPlan {[PackageId]
changes :: SolverPlan -> [PackageId]
changes :: [PackageId]
changes, [PackageId]
matching :: SolverPlan -> [PackageId]
matching :: [PackageId]
matching} =
    Doc -> Int -> Doc -> Doc
hang Doc
"changes:" Int
2 ([PackageId] -> Doc
forall (t :: * -> *) a. (Pretty a, Foldable t) => t a -> Doc
prettyL [PackageId]
changes) Doc -> Doc -> Doc
$+$ Doc -> Int -> Doc -> Doc
hang Doc
"matching:" Int
2 ([PackageId] -> Doc
forall (t :: * -> *) a. (Pretty a, Foldable t) => t a -> Doc
prettyL [PackageId]
matching)

solverPlan ::
  SolverInstallPlan ->
  SolverPlan
solverPlan :: SolverInstallPlan -> SolverPlan
solverPlan SolverInstallPlan
plan =
  SolverPlan {[PackageId]
Maybe (NonEmpty PackageId)
changes :: [PackageId]
matching :: [PackageId]
nonReinstallable :: Maybe (NonEmpty PackageId)
nonReinstallable :: Maybe (NonEmpty PackageId)
changes :: [PackageId]
matching :: [PackageId]
..}
  where
    ([PackageId] -> Maybe (NonEmpty PackageId)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty -> Maybe (NonEmpty PackageId)
nonReinstallable, [PackageId]
changes) = (PackageId -> Bool) -> [PackageId] -> ([PackageId], [PackageId])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition PackageId -> Bool
isNonReinstallableId [PackageId]
configured

    ([PackageId]
configured, [PackageId]
matching) = [Either PackageId PackageId] -> ([PackageId], [PackageId])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (ResolverPackage UnresolvedPkgLoc -> Either PackageId PackageId
forall {loc}. ResolverPackage loc -> Either PackageId PackageId
mkVersion (ResolverPackage UnresolvedPkgLoc -> Either PackageId PackageId)
-> [ResolverPackage UnresolvedPkgLoc]
-> [Either PackageId PackageId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SolverInstallPlan -> [ResolverPackage UnresolvedPkgLoc]
SolverInstallPlan.toList SolverInstallPlan
plan)

    mkVersion :: ResolverPackage loc -> Either PackageId PackageId
mkVersion = \case
      Configured SolverPackage {solverPkgSource :: forall loc. SolverPackage loc -> SourcePackage loc
solverPkgSource = SourcePackage {PackageId
srcpkgPackageId :: PackageId
srcpkgPackageId :: forall loc. SourcePackage loc -> PackageId
srcpkgPackageId}} ->
        PackageId -> Either PackageId PackageId
forall a b. a -> Either a b
Left (PackageId -> PackageId
PackageId.fromCabal PackageId
srcpkgPackageId)
      PreExisting InstSolverPackage {instSolverPkgIPI :: InstSolverPackage -> InstalledPackageInfo
instSolverPkgIPI = InstalledPackageInfo {PackageId
sourcePackageId :: PackageId
sourcePackageId :: InstalledPackageInfo -> PackageId
sourcePackageId}} ->
        PackageId -> Either PackageId PackageId
forall a b. b -> Either a b
Right (PackageId -> PackageId
PackageId.fromCabal PackageId
sourcePackageId)

data SolverChanges =
  SolverChanges {
    SolverChanges -> Versions
versions :: Versions,
    SolverChanges -> [PackageId]
overrides :: [PackageId],
    SolverChanges -> Versions
projectDeps :: Versions
  }
  deriving stock (SolverChanges -> SolverChanges -> Bool
(SolverChanges -> SolverChanges -> Bool)
-> (SolverChanges -> SolverChanges -> Bool) -> Eq SolverChanges
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SolverChanges -> SolverChanges -> Bool
== :: SolverChanges -> SolverChanges -> Bool
$c/= :: SolverChanges -> SolverChanges -> Bool
/= :: SolverChanges -> SolverChanges -> Bool
Eq, Int -> SolverChanges -> ShowS
[SolverChanges] -> ShowS
SolverChanges -> String
(Int -> SolverChanges -> ShowS)
-> (SolverChanges -> String)
-> ([SolverChanges] -> ShowS)
-> Show SolverChanges
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SolverChanges -> ShowS
showsPrec :: Int -> SolverChanges -> ShowS
$cshow :: SolverChanges -> String
show :: SolverChanges -> String
$cshowList :: [SolverChanges] -> ShowS
showList :: [SolverChanges] -> ShowS
Show, (forall x. SolverChanges -> Rep SolverChanges x)
-> (forall x. Rep SolverChanges x -> SolverChanges)
-> Generic SolverChanges
forall x. Rep SolverChanges x -> SolverChanges
forall x. SolverChanges -> Rep SolverChanges x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SolverChanges -> Rep SolverChanges x
from :: forall x. SolverChanges -> Rep SolverChanges x
$cto :: forall x. Rep SolverChanges x -> SolverChanges
to :: forall x. Rep SolverChanges x -> SolverChanges
Generic)

instance Pretty SolverChanges where
  pretty :: SolverChanges -> Doc
pretty SolverChanges {[PackageId]
Versions
versions :: SolverChanges -> Versions
overrides :: SolverChanges -> [PackageId]
projectDeps :: SolverChanges -> Versions
versions :: Versions
overrides :: [PackageId]
projectDeps :: Versions
..} =
    Doc -> Int -> Doc -> Doc
hang Doc
"overrides:" Int
2 ([PackageId] -> Doc
forall (t :: * -> *) a. (Pretty a, Foldable t) => t a -> Doc
prettyL [PackageId]
overrides) Doc -> Doc -> Doc
$+$
    Doc -> Int -> Doc -> Doc
hang Doc
"projectDeps:" Int
2 (Versions -> Doc
forall a. Pretty a => a -> Doc
pretty Versions
projectDeps)