module EL.Private.PPrint (
pprint, pshow
, format, format_str
) where
import qualified Data.Char as Char
import qualified Data.Maybe as Maybe
import qualified Language.Haskell.Parser as Parser
import qualified Language.Haskell.Pretty as Pretty
import Language.Haskell.Syntax
import qualified Text.PrettyPrint as PrettyPrint
pprint :: Show a => a -> IO ()
pprint = putStr . pshow
pshow :: Show a => a -> String
pshow = format . show
format :: String -> String
format = parse format_parsed
format_str :: String -> String
format_str = parse format_nonstr
where
format_nonstr m = Maybe.fromMaybe (format_parsed m) (is_str m)
is_str (HsModule _ _ _ _ [HsPatBind _ _ (HsUnGuardedRhs rhs) _]) =
case rhs of
HsLit (HsString s) -> Just s
_ -> Nothing
is_str _ = Nothing
parse :: (HsModule -> String) -> String -> String
parse format s = case Parser.parseModule ("value = " ++ s) of
Parser.ParseOk m -> format m
Parser.ParseFailed _ _ -> s ++ "\n"
format_parsed :: HsModule -> String
format_parsed = strip_boilerplate . pprint_mode
strip_boilerplate :: String -> String
strip_boilerplate = dedent . (" "++) . strip_match "value="
. dropWhile (/='\n')
strip_match :: String -> String -> String
strip_match pattern str = go pattern str
where
go "" s = strip s
go _ "" = ""
go (p:ps) s = case strip s of
c : cs | p == c -> go ps cs
_ -> str
strip = dropWhile Char.isSpace
pprint_mode :: Pretty.Pretty a => a -> String
pprint_mode = Pretty.prettyPrintStyleMode pp_style Pretty.defaultMode
where
pp_style = PrettyPrint.style
{ PrettyPrint.ribbonsPerLine = 1, PrettyPrint.lineLength = 80 }
dedent :: String -> String
dedent s = unlines $ map (drop indent) slines
where
indent = minimum $ 80 : map (length . takeWhile Char.isSpace) slines
slines = lines s