Commit 3cde15f1 authored by jutaro's avatar jutaro

pretty printer fixes (FreeText starting with ., version tags, version range parens, option order).

parent 955ebbc0
......@@ -56,8 +56,8 @@ module Distribution.PackageDescription.Parse (
-- ** Supplementary build information
readHookedBuildInfo,
parseHookedBuildInfo,
writeHookedBuildInfo,
showHookedBuildInfo,
writeHookedBuildInfo,
showHookedBuildInfo,
pkgDescrFieldDescrs,
libFieldDescrs,
......
......@@ -54,9 +54,8 @@ import Distribution.PackageDescription
condExecutables, condLibrary, genPackageFlags, packageDescription,
GenericPackageDescription(..))
import Text.PrettyPrint
(comma, punctuate, fsep, sep, parens, char, nest,
empty, isEmpty, ($$), (<+>), colon, (<>), text, vcat, ($+$), Doc,
render)
(hsep, comma, punctuate, fsep, parens, char, nest, empty,
isEmpty, ($$), (<+>), colon, (<>), text, vcat, ($+$), Doc, render)
import Distribution.Simple.Utils (writeUTF8File)
import Distribution.ParseUtils (showFreeText, FieldDescr(..))
import Distribution.PackageDescription.Parse (pkgDescrFieldDescrs,binfoFieldDescrs,libFieldDescrs,
......@@ -187,11 +186,11 @@ ppTestSuites suites =
ppCondition :: Condition ConfVar -> Doc
ppCondition (Var x) = ppConfVar x
ppCondition (Lit b) = text (show b)
ppCondition (CNot c) = char '!' <> parens (ppCondition c)
ppCondition (COr c1 c2) = parens $ sep [ppCondition c1, text "||"
<+> ppCondition c2]
ppCondition (CAnd c1 c2) = parens $ sep [ppCondition c1, text "&&"
<+> ppCondition c2]
ppCondition (CNot c) = char '!' <> (ppCondition c)
ppCondition (COr c1 c2) = parens (hsep [ppCondition c1, text "||"
<+> ppCondition c2])
ppCondition (CAnd c1 c2) = parens (hsep [ppCondition c1, text "&&"
<+> ppCondition c2])
ppConfVar :: ConfVar -> Doc
ppConfVar (OS os) = text "os" <> parens (disp os)
ppConfVar (Arch arch) = text "arch" <> parens (disp arch)
......
......@@ -87,6 +87,7 @@ import Data.Tree as Tree (Tree(..), flatten)
import qualified Data.Map as Map
import Control.Monad (foldM)
import System.FilePath (normalise)
import Data.List (sortBy)
-- -----------------------------------------------------------------------------
......@@ -229,7 +230,7 @@ listField name showF readF get set =
optsField :: String -> CompilerFlavor -> (b -> [(CompilerFlavor,[String])]) -> ([(CompilerFlavor,[String])] -> b -> b) -> FieldDescr b
optsField name flavor get set =
liftField (fromMaybe [] . lookup flavor . get)
(\opts b -> set (update flavor opts (get b)) b) $
(\opts b -> set (order (update flavor opts (get b))) b) $
field name (hsep . map text)
(sepBy parseTokenQ' (munch1 isSpace))
where
......@@ -238,6 +239,7 @@ optsField name flavor get set =
update f opts ((f',opts'):rest)
| f == f' = (f, opts' ++ opts) : rest
| otherwise = (f',opts') : update f opts rest
order l = sortBy (\(f,_) (f2,_)-> compare f f2) l
-- TODO: this is a bit smelly hack. It's because we want to parse bool fields
-- liberally but not accept new parses. We cannot do that with ReadP
......@@ -676,6 +678,7 @@ showTestedWith (compiler, version) = text (show compiler) <+> disp version
-- and with blank lines replaced by dots for correct re-parsing.
showFreeText :: String -> Doc
showFreeText "" = empty
showFreeText ('\n' :r) = text " " $+$ text "." $+$ showFreeText r
showFreeText s = vcat [text (if null l then "." else l) | l <- lines_ s]
-- | 'lines_' breaks a string up into a list of strings at newline
......
......@@ -20,7 +20,7 @@ module Distribution.Text (
import qualified Distribution.Compat.ReadP as Parse
import qualified Text.PrettyPrint as Disp
import Data.Version (Version(Version))
import Data.Version (showVersion, Version(Version))
import qualified Data.Char as Char (isDigit, isAlphaNum, isSpace)
class Text a where
......@@ -52,8 +52,7 @@ instance Text Bool where
Parse.string "false") >> return False ]
instance Text Version where
disp (Version branch _tags) -- Do not display the tags
= Disp.hcat (Disp.punctuate (Disp.char '.') (map Disp.int branch))
disp v = Disp.text (showVersion v)
parse = do
branch <- Parse.sepBy1 digits (Parse.char '.')
......
......@@ -76,7 +76,7 @@ module Distribution.Version (
-- ** 'VersionIntervals' abstract type
-- | The 'VersionIntervals' type and the accompanying functions are exposed
-- primarily for completeness and testing purposes. In practice
-- primarily for completeness and testing purposes. In practice
-- 'asVersionIntervals' is the main function to use to
-- view a 'VersionRange' as a bunch of 'VersionInterval's.
--
......@@ -680,7 +680,7 @@ instance Text VersionRange where
(\v _ -> (Disp.text "==" <> dispWild v , 0))
(\(r1, p1) (r2, p2) -> (punct 2 p1 r1 <+> Disp.text "||" <+> punct 2 p2 r2 , 2))
(\(r1, p1) (r2, p2) -> (punct 1 p1 r1 <+> Disp.text "&&" <+> punct 1 p2 r2 , 1))
id
(\(r, p) -> (Disp.parens r, p))
where dispWild (Version b _) =
Disp.hcat (Disp.punctuate (Disp.char '.') (map Disp.int b))
......
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