Add tests

haskell · Nov 19, 2024 · b27b413 · b27b413
1 parent bc8716a
commit b27b413
Show file tree

Hide file tree

Showing 24 changed files with 665 additions and 216 deletions.
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/SourcePackage.hs b/cabal-install-solver/src/Distribution/Solver/Types/SourcePackage.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+
 module Distribution.Solver.Types.SourcePackage
     ( PackageDescriptionOverride
     , SourcePackage(..)
@@ -25,7 +27,7 @@ data SourcePackage loc = SourcePackage
   , srcpkgSource        :: loc
   , srcpkgDescrOverride :: PackageDescriptionOverride
   }
-  deriving (Eq, Show, Generic, Typeable)
+  deriving (Eq, Show, Functor, Generic, Typeable)
 
 instance Binary loc => Binary (SourcePackage loc)
 instance Structured loc => Structured (SourcePackage loc)

diff --git a/cabal-install/src/Distribution/Client/CmdSdist.hs b/cabal-install/src/Distribution/Client/CmdSdist.hs
@@ -150,7 +150,6 @@ import System.FilePath
   , (<.>)
   , (</>)
   )
-import Text.PrettyPrint (text)
 
 -------------------------------------------------------------------------------
 -- Command
@@ -286,7 +285,7 @@ sdistAction (pf@ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do
       dieWithException verbosity $
         SdistActionException $
           map
-            (prettyShow . fmap (text . renderTargetProblem))
+            (renderTargetProblem . constraintPackage)
             errs
     Right pkgs
       | length pkgs > 1

diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs
@@ -1284,23 +1284,23 @@ legacyProjectConfigFieldDescrs :: ConstraintSource -> [FieldDescr LegacyProjectC
 legacyProjectConfigFieldDescrs constraintSrc =
   [ newLineListField
       "packages"
-      (pretty . fmap (Disp.text . renderPackageLocationToken))
+      (Disp.text . renderPackageLocationToken . constraintPackage)
       ( (\pkg -> WithConstraintSource{constraintPackage = pkg, constraintConstraint = constraintSrc})
           `fmap` parsePackageLocationTokenQ
       )
       legacyPackages
       (\v flags -> flags{legacyPackages = v})
   , newLineListField
       "optional-packages"
-      (pretty . fmap (Disp.text . renderPackageLocationToken))
+      (Disp.text . renderPackageLocationToken . constraintPackage)
       ( (\pkg -> WithConstraintSource{constraintPackage = pkg, constraintConstraint = constraintSrc})
           `fmap` parsePackageLocationTokenQ
       )
       legacyPackagesOptional
       (\v flags -> flags{legacyPackagesOptional = v})
   , commaNewLineListFieldParsec
       "extra-packages"
-      pretty
+      (pretty . constraintPackage)
       ( (\pkg -> WithConstraintSource{constraintPackage = pkg, constraintConstraint = constraintSrc})
           `fmap` parsec
       )
@@ -1422,15 +1422,15 @@ legacySharedConfigFieldDescrs constraintSrc =
         . addFields
           [ commaNewLineListFieldParsec
               "constraints"
-              pretty
+              (pretty . constraintPackage)
               ( (\constraint -> WithConstraintSource{constraintPackage = constraint, constraintConstraint = constraintSrc})
                   `fmap` parsec
               )
               configExConstraints
               (\v conf -> conf{configExConstraints = v})
           , commaNewLineListFieldParsec
               "preferences"
-              pretty
+              (pretty . constraintPackage)
               ( (\preference -> WithConstraintSource{constraintPackage = preference, constraintConstraint = constraintSrc})
                   `fmap` parsec
               )