Improve generated .ebuild output

.github/workflows/haskell.yml

@@ -73,7 +73,7 @@ jobs:
         run: cabal build all
 
       - name: Run tests
-        run: cabal test all --test-option=--color --test-show-details=streaming --jobs=1
+        run: cabal test all --test-option=--color=always --test-option=--size-cutoff=999999 --test-show-details=streaming --jobs=1
 
       - name: Check cabal file
         run: cabal check

hackport.cabal

@@ -20,6 +20,10 @@ tested-with:
   , GHC == 9.6.4
   , GHC == 9.8.2
 
+data-files:
+  , tests/data/golden/*.out
+  , tests/data/golden/*.ebuild
+
 source-repository head
   type:     git
   location: git://github.com/gentoo-haskell/hackport.git
@@ -814,6 +818,7 @@ library hackport-internal
     , parallel                              >=3.2.1.0
     , parsec
     , pretty
+    , prettyprinter
     , process
     , QuickCheck
     , split
@@ -847,6 +852,7 @@ library hackport-internal
     Hackport.Command.Update
     Hackport.Completion
     Hackport.Env
+    Hackport.Pretty
     Hackport.Util
     Merge
     Merge.Dependencies
@@ -1058,6 +1064,8 @@ test-suite doctests-v2
 
 test-suite spec
   import:             warnings
+  if flag(threads)
+    ghc-options:      -threaded -rtsopts -with-rtsopts=-N
   type:               exitcode-stdio-1.0
   default-language:   Haskell2010
   main-is:            Main.hs
@@ -1067,12 +1075,14 @@ test-suite spec
     Portage.CabalSpec
     Portage.Dependency.PrintSpec
     Portage.EBuildSpec
+    Portage.EBuild.Golden
     Portage.GHCCoreSpec
     Portage.Metadata.RemoteIdSpec
     Portage.MetadataSpec
     Portage.PackageIdSpec
     Portage.VersionSpec
     QuickCheck.Instances
+    Paths_hackport
 
   build-depends:
     , hackport-external-libs-Cabal-syntax
@@ -1095,6 +1105,9 @@ test-suite spec
     , process
     , QuickCheck                            >=2.0
     , split
+    , tasty
+    , tasty-golden
+    , tasty-hspec
     , text
     , time
     , xml

src/Cabal2Ebuild.hs

@@ -30,7 +30,8 @@ import qualified Distribution.Version as Cabal  ( VersionRange
                                                 , cataVersionRange, normaliseVersionRange
                                                 , majorUpperBound, mkVersion )
 import Distribution.Version (VersionRangeF(..))
-import Distribution.Pretty (prettyShow)
+import qualified Distribution.Pretty as Disp
+import Hackport.Pretty (prettyShow)
 
 import qualified Distribution.Utils.ShortText as ST
 
@@ -54,7 +55,7 @@ cabal2ebuild cat pkg = Portage.ebuildTemplate {
     E.name        = Portage.cabal_pn_to_PN cabal_pn,
     E.category    = prettyShow cat,
     E.hackage_name= cabalPkgName,
-    E.version     = prettyShow (Cabal.pkgVersion (Cabal.package pkg)),
+    E.version     = Disp.prettyShow (Cabal.pkgVersion (Cabal.package pkg)),
     E.revision    = getHackageRevision,
     E.sourceURIs  = getSourceURIs,
     E.description = ST.fromShortText $ if ST.null (Cabal.synopsis pkg)
@@ -78,7 +79,7 @@ cabal2ebuild cat pkg = Portage.ebuildTemplate {
                                    else [])
   } where
         cabal_pn = Cabal.pkgName $ Cabal.package pkg
-        cabalPkgName = prettyShow cabal_pn
+        cabalPkgName = Disp.prettyShow cabal_pn
         hasLibs = isJust (Cabal.library pkg)
         hasTests = (not . null) (Cabal.testSuites pkg)
         getHackageRevision =

src/Hackport/Pretty.hs

@@ -0,0 +1,16 @@
+module Hackport.Pretty
+    ( renderDoc
+    , prettyShow
+    , module Prettyprinter
+    ) where
+
+import Prettyprinter hiding (cat)
+import Prettyprinter.Render.String
+
+renderDoc :: Doc ann -> String
+renderDoc
+    = renderString
+    . layoutPretty defaultLayoutOptions { layoutPageWidth = Unbounded }
+
+prettyShow :: Pretty a => a -> String
+prettyShow = renderDoc . pretty

src/Merge.hs

@@ -12,6 +12,7 @@ Core functionality of the @merge@ command of @HackPort@.
 module Merge
   ( merge
   , mergeGenericPackageDescription
+  , mkEbuild
   ) where
 
 import           Control.Applicative
@@ -37,7 +38,8 @@ import qualified Distribution.PackageDescription.PrettyPrint as Cabal (showPacka
 import qualified Distribution.Solver.Types.SourcePackage as CabalInstall
 import qualified Distribution.Solver.Types.PackageIndex as CabalInstall
 
-import           Distribution.Pretty (prettyShow)
+import qualified Distribution.Pretty as Disp
+import           Hackport.Pretty (prettyShow)
 
 
 -- cabal-install
@@ -157,7 +159,7 @@ merge repoContext packageString users_cabal_flags
           notice $ "Ambiguous names: " ++ L.intercalate ", " names
           forM_ pkgs $ \ps -> do
               let p_name = (cabal_pkg_to_pn . NE.head) ps
-                  showPkg = prettyShow . Cabal.pkgVersion . CabalInstall.srcpkgPackageId
+                  showPkg = Disp.prettyShow . Cabal.pkgVersion . CabalInstall.srcpkgPackageId
               notice $ p_name ++ ": " ++ L.intercalate ", " (map showPkg (NE.toList ps))
           return $ pkgs >>= NE.toList
 
@@ -168,7 +170,7 @@ merge repoContext packageString users_cabal_flags
       Nothing -> do
         putStrLn "No such version for that package, available versions:"
         forM_ availablePkgs $ \ avail ->
-          putStrLn (prettyShow . CabalInstall.srcpkgPackageId $ avail)
+          putStrLn (Disp.prettyShow . CabalInstall.srcpkgPackageId $ avail)
         throw (ArgumentError "no such version for that package")
       Just avail -> return avail
 
@@ -179,7 +181,7 @@ merge repoContext packageString users_cabal_flags
   forM_ availablePkgs $ \ avail -> do
     let match_text | CabalInstall.srcpkgPackageId avail == CabalInstall.srcpkgPackageId selectedPkg = "* "
                   | otherwise = "- "
-    info $ match_text ++ (prettyShow . CabalInstall.srcpkgPackageId $ avail)
+    info $ match_text ++ (Disp.prettyShow . CabalInstall.srcpkgPackageId $ avail)
 
   let cabal_pkgId = CabalInstall.srcpkgPackageId selectedPkg
       norm_pkgName = Cabal.packageName (Portage.normalizeCabalPackageId cabal_pkgId)
@@ -251,7 +253,7 @@ mergeGenericPackageDescription cat pkgGenericDesc fetch users_cabal_flags = do
   debug "searching for minimal suitable ghc version"
   (compiler_info, ghc_packages, pkgDesc0, _flags, pix) <- case GHCCore.minimumGHCVersionToBuildPackage pkgGenericDesc (Cabal.mkFlagAssignment user_specified_fas) of
               Just v  -> return v
-              Nothing -> let pn = prettyShow merged_cabal_pkg_name
+              Nothing -> let pn = Disp.prettyShow merged_cabal_pkg_name
                              cn = prettyShow cat
                          in error $ unlines [ "mergeGenericPackageDescription: failed to find suitable GHC for " ++ pn
                                             , "  You can try to merge the package manually:"
@@ -395,17 +397,17 @@ mergeGenericPackageDescription cat pkgGenericDesc fetch users_cabal_flags = do
     A.inColor A.Yellow True A.Default "This may take a while."
 
   debug $ "buildDepends pkgDesc0 raw: " ++ Cabal.showPackageDescription pkgDesc0
-  debug $ "buildDepends pkgDesc0: " ++ show (map prettyShow (Merge.exeAndLibDeps pkgDesc0))
-  debug $ "buildDepends pkgDesc:  " ++ show (map prettyShow (Merge.buildDepends pkgDesc))
+  debug $ "buildDepends pkgDesc0: " ++ show (map Disp.prettyShow (Merge.exeAndLibDeps pkgDesc0))
+  debug $ "buildDepends pkgDesc:  " ++ show (map Disp.prettyShow (Merge.buildDepends pkgDesc))
 
   -- <https://github.com/gentoo-haskell/hackport/issues/116>
   warnings <- errorWarnOnUnbuildable
     (prettyShow cat)
-    (prettyShow merged_cabal_pkg_name)
+    (Disp.prettyShow merged_cabal_pkg_name)
     pkgDesc0
 
-  notice $ "Accepted depends: " ++ show (map prettyShow accepted_deps)
-  notice $ "Skipped  depends: " ++ show (map prettyShow skipped_deps)
+  notice $ "Accepted depends: " ++ show (map Disp.prettyShow accepted_deps)
+  notice $ "Skipped  depends: " ++ show (map Disp.prettyShow skipped_deps)
   notice $ "Dead flags: " ++ show (map pp_fa irresolvable_flag_assignments)
   notice $ "Dropped  flags: " ++ show (map (Cabal.unFlagName.fst) common_fa)
   notice $ "Active flags: " ++ show (map Cabal.unFlagName active_flags)
@@ -423,47 +425,16 @@ mergeGenericPackageDescription cat pkgGenericDesc fetch users_cabal_flags = do
           Just [] -> die "No output from 'portageq envvar ARCH'"
           Just (l:_) -> pure l
 
-  let pp_fn (cabal_fn, yesno) = b yesno ++ Cabal.unFlagName cabal_fn
-          where b True  = ""
-                b False = "-"
-
-      -- appends 's' to each line except the last one
-      --  handy to build multiline shell expressions
-      icalate _s []     = []
-      icalate _s [x]    = [x]
-      icalate  s (x:xs) = (x ++ s) : icalate s xs
-
-      build_configure_call :: [String] -> [String]
-      build_configure_call [] = []
-      build_configure_call conf_args = icalate " \\" $
-                                           "haskell-cabal_src_configure" :
-                                           map ('\t':) conf_args
-
-      -- returns list USE-parameters to './setup configure'
-      selected_flags :: ([Cabal.FlagName], CabalFlags) -> [String]
-      selected_flags ([], []) = []
-      selected_flags (active_fns, users_fas) = map snd (L.sortBy (compare `on` fst) flag_pairs)
-          where flag_pairs :: [(String, String)]
-                flag_pairs = active_pairs ++ users_pairs
-                active_pairs = map (\fn -> (fn,                    "$(cabal_flag " ++ cfn_to_iuse fn ++ " " ++ fn ++ ")")) $ map Cabal.unFlagName active_fns
-                users_pairs  = map (\fa -> ((Cabal.unFlagName . fst) fa, "--flag=" ++ pp_fn fa)) users_fas
-      to_iuse x = let fn = Cabal.unFlagName $ Cabal.flagName x
-                      p  = if Cabal.flagDefault x then "+" else ""
-                  in p ++ cfn_to_iuse fn
-
-      ebuild =   (\e -> e { E.iuse = E.iuse e ++ map to_iuse active_flag_descs })
-               . ( case requested_cabal_flags of
-                       Nothing  -> id
-                       Just ucf -> (\e -> e { E.used_options  = E.used_options e ++ [("flags", ucf)] }))
-               $ (C2E.cabal2ebuild cat (Merge.packageDescription pkgDesc))
-                  { E.depend        =            Merge.dep tdeps
-                  , E.depend_extra  = S.toList $ Merge.dep_e tdeps
-                  , E.rdepend       =            Merge.rdep tdeps
-                  , E.rdepend_extra = S.toList $ Merge.rdep_e tdeps
-                  , E.src_configure = build_configure_call $
-                      selected_flags (active_flags, user_specified_fas)
-                  , E.keywords      = [ '~' : thisArch ]
-                  }
+  let ebuild = mkEbuild
+                  requested_cabal_flags
+                  cat
+                  pkgDesc
+                  tdeps
+                  active_flags
+                  user_specified_fas
+                  cf_to_iuse_rename
+                  thisArch
+                  active_flag_descs
 
   let active_flag_descs_renamed =
         (\f -> f { Cabal.flagName = Cabal.mkFlagName . cfn_to_iuse . Cabal.unFlagName
@@ -474,7 +445,7 @@ mergeGenericPackageDescription cat pkgGenericDesc fetch users_cabal_flags = do
   when fetch $ do
     let cabal_pkgId = Cabal.packageId (Merge.packageDescription pkgDesc)
         norm_pkgName = Cabal.packageName (Portage.normalizeCabalPackageId cabal_pkgId)
-    fetchDigestAndCheck (overlayPath </> prettyShow cat </> prettyShow norm_pkgName)
+    fetchDigestAndCheck (overlayPath </> prettyShow cat </> Disp.prettyShow norm_pkgName)
       $ Portage.fromCabalPackageId cat cabal_pkgId
 
   forM_ warnings $ notice . ("\n" ++)
@@ -489,7 +460,7 @@ fetchDigestAndCheck
   -> Portage.PackageId -- ^ newest ebuild
   -> Env env ()
 fetchDigestAndCheck ebuildDir pkgId = do
-  let ebuild = prettyShow (Portage.cabalPkgName . Portage.packageId $ pkgId)
+  let ebuild = Disp.prettyShow (Portage.cabalPkgName . Portage.packageId $ pkgId)
                ++ "-" ++ prettyShow (Portage.pkgVersion pkgId) <.> "ebuild"
   withWorkingDirectory ebuildDir $ do
     notice "Recalculating digests..."
@@ -601,6 +572,76 @@ mergeEbuild existing_meta pkgdir ebuild flags = do
     notice $ "Writing " ++ emeta
     liftIO $ T.writeFile mpath updatedMetaText
 
+mkEbuild
+    :: Maybe String
+    -> Portage.Category
+    -> Merge.RetroPackageDescription
+    -> Merge.EDep
+    -> [Cabal.FlagName]
+    -> CabalFlags
+    -> [(String, String)]
+    -> String
+    -> [Cabal.PackageFlag]
+    -> E.EBuild
+mkEbuild
+    requested_cabal_flags
+    cat
+    pkgDesc
+    tdeps
+    active_flags
+    user_specified_fas
+    cf_to_iuse_rename
+    thisArch
+    active_flag_descs
+    = (\e -> e { E.iuse = E.iuse e ++ map to_iuse active_flag_descs })
+               . ( case requested_cabal_flags of
+                       Nothing  -> id
+                       Just ucf -> (\e -> e { E.used_options  = E.used_options e ++ [("flags", ucf)] }))
+               $ (C2E.cabal2ebuild cat (Merge.packageDescription pkgDesc))
+                  { E.depend        =            Merge.dep tdeps
+                  , E.depend_extra  = S.toList $ Merge.dep_e tdeps
+                  , E.rdepend       =            Merge.rdep tdeps
+                  , E.rdepend_extra = S.toList $ Merge.rdep_e tdeps
+                  , E.src_configure = build_configure_call $
+                      selected_flags (active_flags, user_specified_fas)
+                  , E.keywords      = [ '~' : thisArch ]
+                  }
+  where
+    icalate :: [a] -> [[a]] -> [[a]]
+    icalate _s []     = []
+    icalate _s [x]    = [x]
+    icalate  s (x:xs) = (x ++ s) : icalate s xs
+
+    build_configure_call :: [String] -> [String]
+    build_configure_call [] = []
+    build_configure_call conf_args = icalate " \\" $
+                                          "haskell-cabal_src_configure" :
+                                          map ('\t':) conf_args
+
+    selected_flags :: ([Cabal.FlagName], CabalFlags) -> [String]
+    selected_flags ([], []) = []
+    selected_flags (active_fns, users_fas) = map snd (L.sortBy (compare `on` fst) flag_pairs)
+        where flag_pairs :: [(String, String)]
+              flag_pairs = active_pairs ++ users_pairs
+              active_pairs = map (\fn -> (fn,                    "$(cabal_flag " ++ cfn_to_iuse fn ++ " " ++ fn ++ ")")) $ map Cabal.unFlagName active_fns
+              users_pairs  = map (\fa -> ((Cabal.unFlagName . fst) fa, "--flag=" ++ pp_fn fa)) users_fas
+
+    to_iuse :: Cabal.PackageFlag -> String
+    to_iuse x = let fn = Cabal.unFlagName $ Cabal.flagName x
+                    p  = if Cabal.flagDefault x then "+" else ""
+                in p ++ cfn_to_iuse fn
+
+    cfn_to_iuse :: String -> String
+    cfn_to_iuse cfn =
+        case lookup cfn cf_to_iuse_rename of
+            Nothing  -> Merge.mangle_iuse cfn
+            Just ein -> ein
+
+    pp_fn :: (Cabal.FlagName, Bool) -> String
+    pp_fn (cabal_fn, yesno) = b yesno ++ Cabal.unFlagName cabal_fn
+          where b True  = ""
+                b False = "-"
+
 -- <https://github.com/gentoo-haskell/hackport/issues/116>
 -- TODO: Make it so this is automatically fixed instead of requiring manual
 -- intervention