Portage.EBuild: Switch to LinesBuilder

LinesBuilder is a custom Monad that works by building up a list of
prettyprinter Docs and then concats them with vcat. It is helpful for
when a logical piece of the ebuild may use a variable number of lines,
including no lines at all (for instance when no CABAL_HACKAGE_REVISION
or CABAL_PN are used).

Improve some formatting

Signed-off-by: hololeap <[email protected]>

Author: hololeap

src/Portage/EBuild.hs

@@ -7,7 +7,9 @@ Functions and types related to interpreting and manipulating an ebuild,
 as understood by the Portage package manager.
 -}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-} -- Needed to get OverloadedStrings to work
 module Portage.EBuild
         ( EBuild(..)
         , ebuildTemplate
@@ -29,8 +31,12 @@ import qualified Data.Function as F
 import qualified Data.List as L
 import qualified Data.List.Split as LS
 import           Data.Version(Version(..))
-import           Data.Maybe (catMaybes, maybeToList)
+import           Control.Monad.Trans.Writer.CPS
+import           Data.Foldable (toList)
+import           Data.Maybe (catMaybes)
+import           Data.Monoid (Endo(..)) -- more efficient list concat
 import           Hackport.Pretty
+import           GHC.Exts (IsString(..))
 
 import           Network.URI
 import qualified Paths_hackport(version)
@@ -100,66 +106,65 @@ ebuildTemplate = EBuild {
 
 -- | Pretty-print an 'EBuild' as a 'String'.
 showEBuild :: TC.UTCTime -> EBuild -> String
-showEBuild now ebuild = renderDoc $ vsep $
-  [ "# Copyright 1999-" <> this_year <> " Gentoo Authors"
-  , "# Distributed under the terms of the GNU General Public License v2"
-  , emptyDoc
-  , "EAPI=8"
-  , emptyDoc
-  , "# ebuild generated by hackport" <+> pretty (hackportVersion ebuild)
-  , vsep $ map
-      (\(k,v) -> "#hackport: " <> pretty k <> ": " <> pretty v)
-      (used_options ebuild)
-  , emptyDoc
-  , beforeInherit
-  , "CABAL_FEATURES=" <> dquotes (hsep (map (pretty . render) (features ebuild)))
-  , "inherit haskell-cabal"
-  , emptyDoc
-  , "DESCRIPTION=" <> dquotes (pretty (drop_tdot (description ebuild)))
-  , "HOMEPAGE=" <> dquotes (pretty (toHttps $ expandVars (homepage ebuild)))
-  , emptyDoc
-  , "LICENSE=" <> (either (\err -> dquotes emptyDoc <> "\t# FIXME: " <> pretty err)
-                         (dquotes . pretty)
-                         (license ebuild))
-  , "SLOT=" <> dquotes (pretty (slot ebuild))
-  , "KEYWORDS=" <> dquotes (hsep (map pretty (keywords ebuild)))
-  , let iuseList = hsep $ map pretty $ sort_iuse $ L.nub $ iuse ebuild
-        x = if null (iuse ebuild)
-          then Nothing
-          else Just $ "IUSE=" <> dquotes iuseList
-       -- IUSE line if needed, then an empty line
-    in vsep $ maybeToList x ++ [emptyDoc]
-  , dep_str "RDEPEND" (rdepend_extra ebuild) (rdepend ebuild)
-  , dep_str "DEPEND"  ( depend_extra ebuild) ( depend ebuild)
-  ] ++ catMaybes
-  [ verbatim
+showEBuild now ebuild = replaceLeadingSpaces $ renderDoc $ execLinesBuilder $ do
+    fromDoc $ "# Copyright 1999-" <> this_year <> " Gentoo Authors"
+    "# Distributed under the terms of the GNU General Public License v2"
+    emptyLine
+    "EAPI=8"
+    emptyLine
+    fromDoc $ "# ebuild generated by hackport" <+> pretty (hackportVersion ebuild)
+    let optLine (k,v) = "#hackport: " <> pretty k <> ": " <> pretty v
+    fromDocs $ map optLine (used_options ebuild)
+    emptyLine
+    preFeatures
+    fromDoc $ "CABAL_FEATURES=" <> dquotes (hsep (map (pretty . render) (features ebuild)))
+    "inherit haskell-cabal"
+    emptyLine
+    fromDoc $ "DESCRIPTION=" <> dquotes (pretty (drop_tdot (description ebuild)))
+    fromDoc $ "HOMEPAGE=" <> dquotes (pretty (toHttps (expandVars (homepage ebuild))))
+    emptyLine
+    fromDoc $ "LICENSE=" <> (either (\err -> dquotes emptyDoc <> "\t# FIXME: " <> pretty err)
+                                    (dquotes . pretty)
+                                    (license ebuild) )
+    fromDoc $ "SLOT=" <> dquotes (pretty (slot ebuild))
+    fromDoc $ "KEYWORDS=" <> dquotes (hsep (map pretty (keywords ebuild)))
+    fromDocs $
+      if null (iuse ebuild)
+        then Nothing
+        else
+          let iuseList = hsep $ map pretty $ sort_iuse $ L.nub $ iuse ebuild
+          in Just $ "IUSE=" <> dquotes iuseList
+    emptyLine
+    dep_str "RDEPEND" (rdepend_extra ebuild) (rdepend ebuild)
+    dep_str "DEPEND"  ( depend_extra ebuild) ( depend ebuild)
+    verbatim
       (vsep [emptyDoc, "src_prepare() {"])
-      (src_prepare ebuild)
+      (map pretty (src_prepare ebuild))
       "}"
-  , verbatim
+    verbatim
       (vsep [emptyDoc, "src_configure() {"])
-      (src_configure ebuild)
+      (map pretty (src_configure ebuild))
       "}"
-  ]
   where
         expandVars = replaceMultiVars [ (        name ebuild, "${PN}")
                                       , (hackage_name ebuild, "${HACKAGE_N}")
                                       ]
 
-
         this_year :: Doc ann
         this_year = pretty $ TC.formatTime TC.defaultTimeLocale "%Y" now
 
-        beforeInherit =
-            let rev = revision ebuild
-                mpn = cabal_pn ebuild
-               -- Any needed lines then an empty line
-            in vsep $ catMaybes [revLine rev, pnLine <$> mpn] ++ [emptyDoc]
+        preFeatures =
+            let rev = revLine (revision ebuild)
+                pn = pnLine <$> cabal_pn ebuild
+                preList = catMaybes [rev, pn]
+            in if null preList
+                  then pure ()
+                  else fromDocs $ preList ++ [emptyDoc]
 
         revLine "0" = Nothing
-        revLine r   = Just $ hcat ["CABAL_HACKAGE_REVISION=", pretty r]
+        revLine r   = Just $ "CABAL_HACKAGE_REVISION=" <> pretty r
 
-        pnLine pn = hcat ["CABAL_PN=", dquotes (pretty pn)]
+        pnLine pn = "CABAL_PN=" <> dquotes (pretty pn)
 
 -- | Convert http urls into https urls, unless whitelisted as http-only.
 --
@@ -203,14 +208,21 @@ sort_iuse = L.sortBy (compare `F.on` dropWhile ( `elem` ("+" :: String)))
 drop_tdot :: String -> String
 drop_tdot = reverse . dropWhile (== '.') . reverse
 
-verbatim :: Doc ann -> [String] -> Doc ann -> Maybe (Doc ann)
+-- | Print the @pre@ line, each line in the list and the @post@ line, _only_
+-- if the list is not empty.
+verbatim :: Doc ann -> [Doc ann] -> Doc ann -> LinesBuilder ann ()
 verbatim pre s post
-  | null s = Nothing
-  | otherwise = Just $ vsep $ [pre] ++ map (hang 1 . pretty) s ++ [post]
+  | null s = pure ()
+  | otherwise = fromDocs $ [pre] ++ s ++ [post]
 
-dep_str :: Doc ann -> [String] -> Dependency -> Doc ann
-dep_str var extra dep = var <> "=" <> dquotes (hang 1 inner)
-  where inner = vsep $ map pretty extra ++ [showDepend (PN.normalize_depend dep)]
+dep_str :: Doc ann -> [String] -> Dependency -> LinesBuilder ann ()
+dep_str var extra dep = fromDoc $ vsep
+    [ var <> "=\""
+    , indent 1 (
+        vsep (map pretty extra ++ [showDepend (PN.normalize_depend dep)])
+      )
+    , "\""
+    ]
 
 getRestIfPrefix :: String       -- ^ the prefix
                 -> String       -- ^ the string
@@ -236,3 +248,30 @@ replaceMultiVars [] str = str
 replaceMultiVars whole@((pname,cont):rest) str = case subStr cont str of
     Nothing -> replaceMultiVars rest str
     Just (pre,post) -> (replaceMultiVars rest pre)++pname++(replaceMultiVars whole post)
+
+
+emptyLine :: LinesBuilder ann ()
+emptyLine = fromDoc emptyDoc
+
+fromDoc :: Doc ann -> LinesBuilder ann ()
+fromDoc = fromDocs . (:[])
+
+fromDocs :: Foldable t => t (Doc ann) -> LinesBuilder ann ()
+fromDocs = LinesBuilder . tell . Endo . (\x -> (toList x ++))
+
+newtype LinesBuilder ann a = LinesBuilder (Writer (Endo [Doc ann]) a)
+    deriving (Functor, Applicative, Monad)
+
+instance (a ~ ()) => IsString (LinesBuilder ann a) where
+    fromString = fromDoc . fromString
+
+execLinesBuilder :: LinesBuilder ann a -> Doc ann
+execLinesBuilder (LinesBuilder w) = vsep (appEndo (execWriter w) [])
+
+-- | Replace any leading spaces on each line with tabs
+replaceLeadingSpaces :: String -> String
+replaceLeadingSpaces = unlines . map go . lines
+  where
+    go (' ' : rest) = '\t' : go rest
+    go rest = rest
+