Merge pull request #8 from GaloisInc/prettyprinter

Switch jvm-parser from ansi-wl-pprint/pretty to prettyprinter package.
GaloisInc · Feb 2, 2021 · af447d7 · af447d7
2 parents d440e6b + 95e2e80
commit af447d7
Show file tree

Hide file tree

Showing 3 changed files with 36 additions and 30 deletions.
diff --git a/jvm-parser.cabal b/jvm-parser.cabal
@@ -26,18 +26,17 @@ Library
 
   Ghc-options:         -Wall
 
-  Build-depends:       ansi-wl-pprint,
-                       array,
+  Build-depends:       array,
                        base       >= 4.0.0.0 && < 5.0.0.0,
                        binary,
                        bytestring,
                        containers,
                        data-binary-ieee754,
                        fgl,
                        fingertree,
+                       prettyprinter >= 1.7.0,
                        text,
-                       zlib,
-                       pretty
+                       zlib
 
 test-suite test-jvm-parser
   type: exitcode-stdio-1.0
@@ -50,4 +49,4 @@ test-suite test-jvm-parser
                  HUnit,
                  jvm-parser,
                  tasty,
-                 tasty-hunit
+                 tasty-hunit
diff --git a/src/Language/JVM/CFG.hs b/src/Language/JVM/CFG.hs
@@ -50,7 +50,7 @@ import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe
 import Prelude hiding (rem, (<>))
-import Text.PrettyPrint
+import Prettyprinter
 
 import Language.JVM.Common
 
@@ -236,11 +236,11 @@ getPostDominators cfg bb = M.findWithDefault [] bb (pdoms cfg)
 data BBId = BBIdEntry | BBIdExit | BBId PC
   deriving (Eq, Ord, Show)
 
-ppBBId :: BBId -> Doc
+ppBBId :: BBId -> Doc ann
 ppBBId bbid = case bbid of
     BBIdEntry    -> "BB%entry"
     BBIdExit     -> "BB%exit"
-    BBId      pc -> "BB%" <> int (fromIntegral pc)
+    BBId      pc -> "BB%" <> pretty pc
 
 instance Enum BBId where
   toEnum 0 = BBIdEntry

diff --git a/src/Language/JVM/Common.hs b/src/Language/JVM/Common.hs
@@ -60,8 +60,7 @@ import Data.Int
 import Data.String (IsString(..))
 import Data.Text (Text, pack, unpack)
 import Data.Word
-import Text.PrettyPrint
-import qualified Text.PrettyPrint.ANSI.Leijen as PPL
+import Prettyprinter
 import Prelude hiding ((<>))
 
 -- | Replace @/@ characters with @.@ characters
@@ -178,9 +177,9 @@ data MethodKey = MethodKey {
   , methodKeyReturnType :: Maybe Type
   } deriving (Eq, Ord, Show)
 
-ppMethodKey :: MethodKey -> Doc
+ppMethodKey :: MethodKey -> Doc ann
 ppMethodKey (MethodKey name params ret) =
-       text name
+       pretty name
     <> (parens . commas . map ppType) params
     <> maybe "void" ppType ret
   where commas = sep . punctuate comma
@@ -361,8 +360,8 @@ data Instruction
   deriving (Eq,Show)
 
 -- TODO: improve this
-ppInstruction :: Instruction -> Doc
-ppInstruction = text . show
+ppInstruction :: Instruction -> Doc ann
+ppInstruction = viaShow
 
 -- | An entry in the exception table for a method
 data ExceptionTableEntry = ExceptionTableEntry {
@@ -456,20 +455,28 @@ safeNextPcPrim istrm pc | pc <= snd (bounds istrm) = Just $ nextPcPrim istrm pc
 --------------------------------------------------------------------------------
 -- Instances
 
+instance Pretty ClassName where
+  pretty (ClassName s) = pretty s
+
+instance Pretty FieldId where
+  pretty fldId = pretty (fieldIdClass fldId) <> "." <> pretty (fieldIdName fldId)
+
+ppType :: Type -> Doc ann
+ppType t =
+  case t of
+    ByteType     -> "byte"
+    CharType     -> "char"
+    DoubleType   -> "double"
+    FloatType    -> "float"
+    IntType      -> "int"
+    LongType     -> "long"
+    ClassType cn -> pretty (slashesToDots (unClassName cn))
+    ShortType    -> "short"
+    BooleanType  -> "boolean"
+    ArrayType tp -> ppType tp <> "[]"
+
 instance Show Type where
-  show ByteType       = "byte"
-  show CharType       = "char"
-  show DoubleType     = "double"
-  show FloatType      = "float"
-  show IntType        = "int"
-  show LongType       = "long"
-  show (ClassType cn) = slashesToDots (unClassName cn)
-  show ShortType      = "short"
-  show BooleanType    = "boolean"
-  show (ArrayType tp) = (show tp) ++ "[]"
-
-ppType :: Type -> Doc
-ppType = text . show
-
-instance PPL.Pretty Type where
-  pretty = PPL.text . show
+  show = show . pretty
+
+instance Pretty Type where
+  pretty = ppType