pretty-show 1.3 → 1.3.1
raw patch · 3 files changed
+70/−72 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
- bin/ppsh.hs +68/−0
- ppsh.hs +0/−68
- pretty-show.cabal +2/−4
+ bin/ppsh.hs view
@@ -0,0 +1,68 @@+import Text.Show.Pretty+import System.Environment+import System.IO(hPutStrLn,stderr)++main :: IO ()+main =+ do as <- getArgs+ case as of+ ["--test"] -> interactLn (show . selftest1)++ ["--html"] ->+ do txt <- getContents+ case parseValue txt of+ Just v -> putStrLn (html v)+ Nothing -> hPutStrLn stderr "Failed to parse value."++ [] -> interactLn $ \s -> case parseValue s of+ Just v -> show (ppValue v)+ Nothing -> s+ _ -> hPutStrLn stderr $ unlines+ [ "usage: ppsh < showed_value > pretty_value"+ , " --html Generate HTML."+ , " --test Self test: True means we passed."+ ]+++interactLn :: (String -> String) -> IO ()+interactLn f = interact f >> putStrLn ""++selftest :: Value -> Bool+selftest v = case parseValue $ show $ ppValue v of+ Just v1 -> v1 == v+ Nothing -> False++selftest1 :: String -> Bool+selftest1 txt = case parseValue txt of+ Just v -> selftest v+ Nothing -> True++html :: Value -> String+html val =+ case val of+ Con n xs -> node "con" (name n : map html xs)+ Rec n xs -> node "rec" (name n : map field xs)+ Tuple xs -> node "tuple" (map html xs)+ List xs -> node "list" (map html xs)+ Neg x -> node "neg" [ html x ]+ Ratio x y -> node "ratio" [ html x, html y ]+ Integer x -> leaf "integer" x+ Float x -> leaf "float" x+ Char x -> leaf "char" x+ String x -> leaf "string" x++ where+ name = leaf "name"+ field (x,v) = node "field" [ name x, html v ]++ leaf c txt = "<div class=\"" ++ c ++ "\">" ++ concatMap esc txt ++ "</div>"+ node c els = "<div class=\"" ++ c ++ "\">" ++ concat els ++ "</div>"+ esc c =+ case c of+ '<' -> "<"+ '>' -> ">"+ '&' -> "&"+ '\''-> "'"+ '"' -> """+ _ -> [c]+
− ppsh.hs
@@ -1,68 +0,0 @@-import Text.Show.Pretty-import System.Environment-import System.IO(hPutStrLn,stderr)--main :: IO ()-main =- do as <- getArgs- case as of- ["--test"] -> interactLn (show . selftest1)-- ["--html"] ->- do txt <- getContents- case parseValue txt of- Just v -> putStrLn (html v)- Nothing -> hPutStrLn stderr "Failed to parse value."-- [] -> interactLn $ \s -> case parseValue s of- Just v -> show (ppValue v)- Nothing -> s- _ -> hPutStrLn stderr $ unlines- [ "usage: ppsh < showed_value > pretty_value"- , " --html Generate HTML."- , " --test Self test: True means we passed."- ]---interactLn :: (String -> String) -> IO ()-interactLn f = interact f >> putStrLn ""--selftest :: Value -> Bool-selftest v = case parseValue $ show $ ppValue v of- Just v1 -> v1 == v- Nothing -> False--selftest1 :: String -> Bool-selftest1 txt = case parseValue txt of- Just v -> selftest v- Nothing -> True--html :: Value -> String-html val =- case val of- Con n xs -> node "con" (name n : map html xs)- Rec n xs -> node "rec" (name n : map field xs)- Tuple xs -> node "tuple" (map html xs)- List xs -> node "list" (map html xs)- Neg x -> node "neg" [ html x ]- Ratio x y -> node "ratio" [ html x, html y ]- Integer x -> leaf "integer" x- Float x -> leaf "float" x- Char x -> leaf "char" x- String x -> leaf "string" x-- where- name = leaf "name"- field (x,v) = node "field" [ name x, html v ]-- leaf c txt = "<div class=\"" ++ c ++ "\">" ++ concatMap esc txt ++ "</div>"- node c els = "<div class=\"" ++ c ++ "\">" ++ concat els ++ "</div>"- esc c =- case c of- '<' -> "<"- '>' -> ">"- '&' -> "&"- '\''-> "'"- '"' -> """- _ -> [c]-
pretty-show.cabal view
@@ -1,5 +1,5 @@ name: pretty-show-version: 1.3+version: 1.3.1 category: Text synopsis: Tools for working with derived Show instances.@@ -42,11 +42,9 @@ executable ppsh main-is: ppsh.hs + hs-source-dirs: bin build-depends: base >= 3 && < 5,- array >= 0.2 && < 2,- haskell-lexer >= 1 && < 2,- pretty >= 1 && < 2, pretty-show ghc-options: -Wall