pretty-show 1.8.2 → 1.9
raw patch · 6 files changed
+121/−82 lines, 6 files
Files
- CHANGELOG +5/−0
- Text/Show/Pretty.hs +34/−1
- Text/Show/Value.hs +57/−1
- bin/ppsh.hs +20/−4
- dist/build/Text/Show/Parser.hs +2/−74
- pretty-show.cabal +3/−2
CHANGELOG view
@@ -1,3 +1,8 @@+Changes in 1.9+ * Add support for pre-processing values before printing.+ In particular, we add a pre-processor which will hide some constructors+ from the output.+ Changes in 1.8.2 * Switch to using version 3.3.1 of jquery (jquery 1 seems to be long gone)
Text/Show/Pretty.hs view
@@ -27,7 +27,7 @@ ppDocList, ppShowList, pPrintList -- * Values using the 'PrettyVal' class- , dumpDoc, dumpStr, PrettyVal(..)+ , dumpDoc, dumpStr, dumpIO, PrettyVal(..) -- * Rendering values to Html , valToHtml, HtmlOpts(..), defaultHtmlOpts, htmlPage, Html(..)@@ -35,6 +35,9 @@ -- * Get location of data files , getDataDir + , -- * Preprocessing of values+ PreProc(..), ppHide, ppHideNested, hideCon+ -- * Deprecated , ppValue ) where@@ -111,7 +114,11 @@ dumpStr :: PrettyVal a => a -> String dumpStr = show . dumpDoc +-- | Render a value using the 'PrettyVal' class and show it to standard out.+dumpIO :: PrettyVal a => a -> IO ()+dumpIO = putStrLn . dumpStr + -- | Pretty print a generic value. Our intention is that the result is -- equivalent to the 'Show' instance for the original value, except possibly -- easier to understand by a human.@@ -145,6 +152,31 @@ String x -> text x +-- | This type is used to allow pre-processing of values before showing them.+data PreProc a = PreProc (Value -> Value) a++instance Show a => Show (PreProc a) where+ showsPrec p (PreProc f a) cs =+ case parseValue txt of+ Nothing -> txt ++ cs+ Just v -> wrap (valToStr (f v))+ where+ txt = showsPrec p a ""+ wrap t = case (t,txt) of+ (h:_,'(':_) | h /= '(' -> '(' : (t ++ ')' : cs)+ _ -> t ++ cs++-- | Hide the given constructors when showing a value.+ppHide :: (Name -> Bool) -> a -> PreProc a+ppHide p = PreProc (hideCon False p)++-- | Hide the given constructors when showing a value.+-- In addition, hide values if all of their children were hidden.+ppHideNested :: (Name -> Bool) -> a -> PreProc a+ppHideNested p = PreProc (hideCon True p)+++ -- Private --------------------------------------------------------------------- ppAtom :: Value -> Doc@@ -182,5 +214,6 @@ blockWith _ a b [] = char a <> char b blockWith f a b (d:ds) = f $ (char a <+> d) : [ char ',' <+> x | x <- ds ] ++ [ char b ]+
Text/Show/Value.hs view
@@ -12,8 +12,10 @@ -------------------------------------------------------------------------------- {-# LANGUAGE Safe #-}-module Text.Show.Value ( Name, Value(..) ) where+module Text.Show.Value ( Name, Value(..), hideCon ) where +import Data.Maybe(fromMaybe,isNothing)+ -- | A name. type Name = String @@ -39,3 +41,57 @@ | Char String -- ^ Character | String String -- ^ String deriving (Eq,Show)++{- | Hide constrcutros matching the given predicate.+If the hidden value is in a record, we also hide+the corresponding record field.++If the boolean flag is true, then we also hide+constructors all of whose fields were hidden. -}+hideCon :: Bool -> (Name -> Bool) -> Value -> Value+hideCon collapse hidden = toVal . delMaybe+ where+ hiddenV = Con "_" []++ toVal = fromMaybe hiddenV++ delMany vals+ | collapse && all isNothing newVals = Nothing+ | otherwise = Just (map toVal newVals)+ where+ newVals = map delMaybe vals++ delMaybe val =+ case val of+ Con x vs+ | hidden x -> Nothing+ | null vs -> Just val+ | otherwise -> Con x `fmap` delMany vs++ Rec x fs+ | hidden x -> Nothing+ | null fs -> Just val+ | collapse && all isNothing mbs -> Nothing+ | otherwise -> Just (Rec x [ (f,v) | (f,Just v) <- zip ls mbs ])+ where (ls,vs) = unzip fs+ mbs = map delMaybe vs++ InfixCons v ys+ | any hidden cs -> Nothing+ | otherwise -> do ~(v1:vs1) <- delMany (v:vs)+ Just (InfixCons v1 (zip cs vs1))+ where (cs,vs) = unzip ys++ Tuple vs | null vs -> Just val+ | otherwise -> Tuple `fmap` delMany vs+ List vs | null vs -> Just val+ | otherwise -> List `fmap` delMany vs+ Neg v -> Neg `fmap` delMaybe v+ Ratio v1 v2 -> do ~[a,b] <- delMany [v1,v2]+ Just (Ratio a b)+ Integer {} -> Just val+ Float {} -> Just val+ Char {} -> Just val+ String {} -> Just val++
bin/ppsh.hs view
@@ -1,11 +1,18 @@ import Text.Show.Pretty-import System.Environment+import Data.Either(partitionEithers)+import Data.List(isPrefixOf)+import Data.Char(isSpace)+import System.Environment(getArgs) import System.IO(hPutStrLn,stderr) main :: IO () main = do as <- getArgs- case as of+ let (opts,hiding) = partitionEithers (map isHiding as)+ preproc v = case hiding of+ [] -> v+ xs -> hideCon False (`elem` hiding) v+ case opts of ["--test"] -> interactLn (show . selftest1) ["--html"] ->@@ -14,17 +21,26 @@ Just v -> do dir <- getDataDir let opts = defaultHtmlOpts { dataDir = dir }- putStrLn (valToHtmlPage opts v)+ -- XXX: perhaps for HTML the "hidden" values should+ -- just start off collapsed, rahter than being deleted?+ putStrLn (valToHtmlPage opts (preproc v)) Nothing -> hPutStrLn stderr "Failed to parse value." [] -> interactLn $ \s -> case parseValue s of- Just v -> show (valToDoc v)+ Just v -> show (valToDoc (preproc v)) Nothing -> s _ -> hPutStrLn stderr $ unlines [ "usage: ppsh < showed_value > pretty_value"+ , " --hide=CON Hide this constructor." , " --html Generate HTML." , " --test Self test: True means we passed." ]+ where+ isHiding a+ | pref `isPrefixOf` a = Right $ dropWhile isSpace+ $ drop (length pref) a+ | otherwise = Left a+ where pref = "--hide=" interactLn :: (String -> String) -> IO ()
dist/build/Text/Show/Parser.hs view
@@ -1052,7 +1052,7 @@ {-# LINE 10 "<command-line>" #-}-{-# LINE 1 "/home/diatchki/tools/ghc-8.4.1/lib/ghc-8.4.1/include/ghcversion.h" #-}+{-# LINE 1 "/home/diatchki/tools/ghc-8.4.3/lib/ghc-8.4.3/include/ghcversion.h" #-} @@ -1069,79 +1069,7 @@ {-# LINE 10 "<command-line>" #-}-{-# LINE 1 "/tmp/ghc12202_0/ghc_2.h" #-}------------------------------------------------------------------------+{-# LINE 1 "/tmp/ghc21054_0/ghc_2.h" #-}
pretty-show.cabal view
@@ -1,5 +1,5 @@ name: pretty-show-version: 1.8.2+version: 1.9 category: Text synopsis: Tools for working with derived `Show` instances and generic@@ -25,7 +25,8 @@ tested-with: GHC == 7.10.3 GHC == 8.0.2 GHC == 8.2.2- GHC == 8.4.3+ GHC == 8.4.4+ GHC == 8.6.1 data-files: style/jquery.js