Commit 1f8c58d3 authored by Oleg Grenrus's avatar Oleg Grenrus
Browse files

Move some prettyprinting stuff from .Parse to .PrettyPrint

parent b45c351e
......@@ -18,9 +18,7 @@
module Distribution.PackageDescription.Parse (
-- * Package descriptions
readPackageDescription,
writePackageDescription,
parsePackageDescription,
showPackageDescription,
-- ** Parsing
ParseResult(..),
......@@ -30,8 +28,6 @@ module Distribution.PackageDescription.Parse (
-- ** Supplementary build information
readHookedBuildInfo,
parseHookedBuildInfo,
writeHookedBuildInfo,
showHookedBuildInfo,
pkgDescrFieldDescrs,
libFieldDescrs,
......@@ -65,9 +61,10 @@ import Control.Applicative (Applicative(..))
#endif
import Control.Arrow (first)
import System.Directory (doesFileExist)
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
import Text.PrettyPrint
(empty, vcat, ($$), (<+>), text, render,
comma, fsep, nest, ($+$), punctuate)
-- -----------------------------------------------------------------------------
......@@ -1248,53 +1245,6 @@ parseHookedBuildInfo inp = do
parseBI st = parseFields binfoFieldDescrs storeXFieldsBI emptyBuildInfo st
-- ---------------------------------------------------------------------------
-- Pretty printing
writePackageDescription :: FilePath -> PackageDescription -> IO ()
writePackageDescription fpath pkg = writeUTF8File fpath (showPackageDescription pkg)
--TODO: make this use section syntax
-- add equivalent for GenericPackageDescription
showPackageDescription :: PackageDescription -> String
showPackageDescription pkg = render $
ppPackage pkg
$$ ppCustomFields (customFieldsPD pkg)
$$ (case library pkg of
Nothing -> empty
Just lib -> ppLibrary lib)
$$ vcat [ space $$ ppLibrary lib | lib <- subLibraries pkg ]
$$ vcat [ space $$ ppExecutable exe | exe <- executables pkg ]
where
ppPackage = ppFields pkgDescrFieldDescrs
ppLibrary = ppFields libFieldDescrs
ppExecutable = ppFields executableFieldDescrs
ppCustomFields :: [(String,String)] -> Doc
ppCustomFields flds = vcat (map ppCustomField flds)
ppCustomField :: (String,String) -> Doc
ppCustomField (name,val) = text name <> colon <+> showFreeText val
writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> IO ()
writeHookedBuildInfo fpath = writeFileAtomic fpath . BS.Char8.pack
. showHookedBuildInfo
showHookedBuildInfo :: HookedBuildInfo -> String
showHookedBuildInfo bis = render $
vcat [ space
$$ ppName name
$$ ppBuildInfo bi
| (name, bi) <- bis ]
where
ppName CLibName = text "library"
ppName (CSubLibName name) = text "library:" <+> text name
ppName (CExeName name) = text "executable:" <+> text name
ppName (CTestName name) = text "test-suite:" <+> text name
ppName (CBenchName name) = text "benchmark:" <+> text name
ppBuildInfo bi = ppFields binfoFieldDescrs bi
$$ ppCustomFields (customFieldsBI bi)
-- replace all tabs used as indentation with whitespace, also return where
-- tabs were found
findIndentTabs :: String -> [(Int,Int)]
......
......@@ -13,8 +13,17 @@
-----------------------------------------------------------------------------
module Distribution.PackageDescription.PrettyPrint (
-- * Generic package descriptions
writeGenericPackageDescription,
showGenericPackageDescription,
-- * Package descriptions
writePackageDescription,
showPackageDescription,
-- ** Supplementary build information
writeHookedBuildInfo,
showHookedBuildInfo,
) where
import Distribution.PackageDescription
......@@ -27,9 +36,11 @@ import Distribution.Text
import Data.Monoid as Mon (Monoid(mempty))
import Data.Maybe (isJust)
import Text.PrettyPrint
(hsep, parens, char, nest, empty, isEmpty, ($$), (<+>),
(hsep, space, parens, char, nest, empty, isEmpty, ($$), (<+>),
colon, (<>), text, vcat, ($+$), Doc, render)
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
-- | Recompile with false for regression testing
simplifiedPrinting :: Bool
simplifiedPrinting = False
......@@ -258,3 +269,45 @@ ppIfElse it ppIt c thenTree elseTree =
emptyLine :: Doc -> Doc
emptyLine d = text "" $+$ d
-- | @since 1.26.0.0@
writePackageDescription :: FilePath -> PackageDescription -> IO ()
writePackageDescription fpath pkg = writeUTF8File fpath (showPackageDescription pkg)
--TODO: make this use section syntax
-- add equivalent for GenericPackageDescription
-- | @since 1.26.0.0@
showPackageDescription :: PackageDescription -> String
showPackageDescription pkg = render $
ppPackage pkg
$$ ppCustomFields (customFieldsPD pkg)
$$ (case library pkg of
Nothing -> empty
Just lib -> ppLibrary' lib)
$$ vcat [ space $$ ppLibrary' lib | lib <- subLibraries pkg ]
$$ vcat [ space $$ ppExecutable exe | exe <- executables pkg ]
where
ppPackage = ppFields pkgDescrFieldDescrs
ppLibrary' = ppFields libFieldDescrs
ppExecutable = ppFields executableFieldDescrs
-- | @since 1.26.0.0@
writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> IO ()
writeHookedBuildInfo fpath = writeFileAtomic fpath . BS.Char8.pack
. showHookedBuildInfo
-- | @since 1.26.0.0@
showHookedBuildInfo :: HookedBuildInfo -> String
showHookedBuildInfo bis = render $
vcat [ space
$$ ppName name
$$ ppBuildInfo bi
| (name, bi) <- bis ]
where
ppName CLibName = text "library"
ppName (CSubLibName name) = text "library:" <+> text name
ppName (CExeName name) = text "executable:" <+> text name
ppName (CTestName name) = text "test-suite:" <+> text name
ppName (CBenchName name) = text "benchmark:" <+> text name
ppBuildInfo bi = ppFields binfoFieldDescrs bi
$$ ppCustomFields (customFieldsBI bi)
......@@ -65,7 +65,6 @@ import Data.List (sortBy)
-- -----------------------------------------------------------------------------
type LineNo = Int
type Separator = ([Doc] -> Doc)
data PError = AmbiguousParse String LineNo
| NoParse String LineNo
......
......@@ -10,6 +10,8 @@
-- Utilities for pretty printing.
{-# OPTIONS_HADDOCK hide #-}
module Distribution.PrettyUtils (
Separator,
-- * Internal
showFilePath,
showToken,
showTestedWith,
......@@ -24,6 +26,8 @@ import Data.Char (isSpace)
import Distribution.Text (disp)
import Text.PrettyPrint (Doc, empty, text, vcat, (<+>))
type Separator = ([Doc] -> Doc)
showFilePath :: FilePath -> Doc
showFilePath "" = empty
showFilePath x = showToken x
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment