pretty -> prettyprinter

src/Rlp/AltSyntax.hs

@@ -116,67 +116,67 @@ pattern Finr ga = Fix (InR ga)
 
 --------------------------------------------------------------------------------
 
-instance (Pretty b, Pretty a) => Pretty (ExprF b a) where
-    prettyPrec = prettyPrec1
+instance (Out b, Out a) => Out (ExprF b a) where
+    outPrec = outPrec1
 
-instance (Pretty b, Pretty a) => Pretty (Alter b a) where
-    prettyPrec = prettyPrec1
+instance (Out b, Out a) => Out (Alter b a) where
+    outPrec = outPrec1
 
-instance (Pretty b) => Pretty1 (Alter b) where
-    liftPrettyPrec pr _ (Alter p e) =
-        hsep [ pretty p, "->", pr 0 e]
+instance (Out b) => Out1 (Alter b) where
+    liftOutPrec pr _ (Alter p e) =
+        hsep [ out p, "->", pr 0 e]
 
-instance Pretty b => Pretty1 (ExprF b) where
-    liftPrettyPrec pr p (InfixEF o a b) = maybeParens (p>0) $
-        pr 1 a <+> pretty o <+> pr 1 b
-    liftPrettyPrec pr p (CaseEF e as) = maybeParens (p>0) $
-        hsep [ "case", pr 0 e, "of" ]
-        $+$ nest 2 (vcat $ liftPrettyPrec pr 0 <$> as)
+instance Out b => Out1 (ExprF b) where
+    liftOutPrec pr p (InfixEF o a b) = maybeParens (p>0) $
+        pr 1 a <+> out o <+> pr 1 b
+    liftOutPrec pr p (CaseEF e as) = maybeParens (p>0) $
+        vsep [ hsep [ "case", pr 0 e, "of" ]
+             , nest 2 (vcat $ liftOutPrec pr 0 <$> as) ]
 
-instance (Pretty b, Pretty a) => Pretty (Decl b a) where
-    prettyPrec = prettyPrec1
+instance (Out b, Out a) => Out (Decl b a) where
+    outPrec = outPrec1
 
-instance (Pretty b) => Pretty1 (Decl b) where
-    liftPrettyPrec pr _ (FunD f as e) =
-        hsep [ ttext f, hsep (prettyPrec appPrec1 <$> as)
+instance (Out b) => Out1 (Decl b) where
+    liftOutPrec pr _ (FunD f as e) =
+        hsep [ ttext f, hsep (outPrec appPrec1 <$> as)
              , "=", pr 0 e ]
 
-    liftPrettyPrec _ _ (DataD f as []) =
-        hsep [ "data", ttext f, hsep (pretty <$> as) ]
+    liftOutPrec _ _ (DataD f as []) =
+        hsep [ "data", ttext f, hsep (out <$> as) ]
 
-    liftPrettyPrec _ _ (DataD f as ds) =
-        hsep [ "data", ttext f, hsep (pretty <$> as), cons ]
+    liftOutPrec _ _ (DataD f as ds) =
+        hsep [ "data", ttext f, hsep (out <$> as), cons ]
       where
-        cons = vcat $ zipWith (<+>) delims (pretty <$> ds)
+        cons = vcat $ zipWith (<+>) delims (out <$> ds)
         delims = "=" : repeat "|"
 
-    liftPrettyPrec _ _ (TySigD n t) =
-        hsep [ ttext n, ":", pretty t ]
+    liftOutPrec _ _ (TySigD n t) =
+        hsep [ ttext n, ":", out t ]
 
-instance (Pretty b) => Pretty (DataCon b) where
-    pretty (DataCon n as) = ttext n <+> hsep (prettyPrec appPrec1 <$> as)
+instance (Out b) => Out (DataCon b) where
+    out (DataCon n as) = ttext n <+> hsep (outPrec appPrec1 <$> as)
 
 -- (->) is given prec `appPrec-1`
-instance (Pretty b) => Pretty (Type b) where
-    prettyPrec _ (VarT n) = ttext n
-    prettyPrec _ (ConT n) = ttext n
-    prettyPrec p (s Core.:-> t) = maybeParens (p>appPrec-1) $
-        hsep [ prettyPrec appPrec s, "->", prettyPrec (appPrec-1) t ]
-    prettyPrec p (AppT f x) = maybeParens (p>appPrec) $
-        prettyPrec appPrec f <+> prettyPrec appPrec1 x
-    prettyPrec p FunT = maybeParens (p>0) "->"
+instance (Out b) => Out (Type b) where
+    outPrec _ (VarT n) = ttext n
+    outPrec _ (ConT n) = ttext n
+    outPrec p (s Core.:-> t) = maybeParens (p>appPrec-1) $
+        hsep [ outPrec appPrec s, "->", outPrec (appPrec-1) t ]
+    outPrec p (AppT f x) = maybeParens (p>appPrec) $
+        outPrec appPrec f <+> outPrec appPrec1 x
+    outPrec p FunT = maybeParens (p>0) "->"
 
-instance (Pretty b) => Pretty (Pat b) where
-    prettyPrec p (VarP b) = prettyPrec p b
-    prettyPrec p (ConP b) = prettyPrec p b
-    prettyPrec p (AppP c x) = maybeParens (p>appPrec) $
-        prettyPrec appPrec c <+> prettyPrec appPrec1 x
+instance (Out b) => Out (Pat b) where
+    outPrec p (VarP b) = outPrec p b
+    outPrec p (ConP b) = outPrec p b
+    outPrec p (AppP c x) = maybeParens (p>appPrec) $
+        outPrec appPrec c <+> outPrec appPrec1 x
 
-instance (Pretty a, Pretty b) => Pretty (Program b a) where
-    prettyPrec = prettyPrec1
+instance (Out a, Out b) => Out (Program b a) where
+    outPrec = outPrec1
 
-instance (Pretty b) => Pretty1 (Program b) where
-    liftPrettyPrec pr p (Program ds) = vsep $ liftPrettyPrec pr p <$> ds
+instance (Out b) => Out1 (Program b) where
+    liftOutPrec pr p (Program ds) = vsep $ liftOutPrec pr p <$> ds
 
 makePrisms ''Pat
 makePrisms ''Binding

src/Rlp/HindleyMilner.hs

@@ -20,7 +20,7 @@ import Control.Monad
 import Control.Arrow            ((>>>))
 import Control.Monad.Writer.Strict
 import Data.Text                qualified as T
-import Data.Pretty
+import Data.Pretty              hiding (annotate)
 import Data.Hashable
 import Data.HashMap.Strict      (HashMap)
 import Data.HashMap.Strict      qualified as H
@@ -153,11 +153,11 @@ subst n t' = para \case
                           | otherwise -> ForallT x post
     t -> embed $ t <&> view _2
 
-prettyHM :: (Pretty a)
+prettyHM :: (Out a)
          => Either [TypeError] (a, [Constraint])
          -> Either [TypeError] (String, [String])
-prettyHM = over (mapped . _1) rpretty
-         . over (mapped . _2 . each) rpretty
+prettyHM = over (mapped . _1) rout
+         . over (mapped . _2 . each) rout
 
 fixtend :: Functor f => (f (Fix f) -> b) -> Fix f -> Cofree f b
 fixtend c (Fix f) = c f :< fmap (fixtend c) f

src/Rlp/HindleyMilner/Types.hs

@@ -73,16 +73,16 @@ instance IsRlpcError TypeError where
         -- todo: use anti-parser instead of show
         TyErrCouldNotUnify t u -> Text
             [ T.pack $ printf "Could not match type `%s` with `%s`."
-                              (rpretty @String t) (rpretty @String u)
-            , "Expected: " <> rpretty t
-            , "Got: " <> rpretty u
+                              (rout @String t) (rout @String u)
+            , "Expected: " <> rout t
+            , "Got: " <> rout u
             ]
         TyErrUntypedVariable n -> Text
             [ "Untyped (likely undefined) variable `" <> n <> "`"
             ]
         TyErrRecursiveType t x -> Text
             [ T.pack $ printf "Recursive type: `%s' occurs in `%s'"
-                              (rpretty @String t) (rpretty @String x)
+                              (rout @String t) (rout @String x)
             ]
 
 -- type Memo t = HashMap t (Type PsName, PartialJudgement)
@@ -156,7 +156,7 @@ demoContext = Context
 constraintTypes :: Traversal' Constraint (Type PsName)
 constraintTypes k (Equality s t) = Equality <$> k s <*> k t
 
-instance Pretty Constraint where
-    pretty (Equality s t) =
-        hsep [prettyPrec appPrec1 s, "~", prettyPrec appPrec1 t]
+instance Out Constraint where
+    out (Equality s t) =
+        hsep [outPrec appPrec1 s, "~", outPrec appPrec1 t]
 

src/Rlp/HindleyMilner/Visual.hs

@@ -9,7 +9,7 @@ import Control.Monad
 import System.IO
 import Data.Text                        qualified as T
 import Data.Text.IO                     qualified as T
-import Data.Pretty
+import Data.Pretty                      hiding (annotate)
 import Data.String                      (IsString(..))
 import Data.Foldable
 import Misc.CofreeF
@@ -77,14 +77,14 @@ withTooltip normal hover =
 --           -- ! onload "installHoverListener(this)"
 --         $ normal
 
-annExpr :: (ann -> Doc) -> AnnExpr ann -> Html
+annExpr :: (a -> Doc ann) -> AnnExpr a -> Html
 annExpr sf = code . cata \case
-    t :<$ InL (LitF l)   -> withTooltip (rpretty l) (sf' t)
-    t :<$ InL (VarF n)   -> withTooltip (rpretty n) (sf' t)
+    t :<$ InL (LitF l)   -> withTooltip (rout l) (sf' t)
+    t :<$ InL (VarF n)   -> withTooltip (rout n) (sf' t)
     t :<$ InL (AppF f x) -> withTooltip (f *> " " *> x) (sf' t)
     t :<$ InL (LamF bs e) -> withTooltip ("λ" *> bs' *> " -> " *> e) (sf' t)
         where
-            bs' = fromString . render . hsep $ prettyPrec appPrec1 <$> bs
+            bs' = fromString . show . hsep $ outPrec appPrec1 <$> bs
   where
     sf' = fromString . show . sf
 
@@ -129,5 +129,5 @@ renderExpr e = case runHM' . annotate $ e of
 renderExpr' :: RlpExpr PsName -> IO ()
 renderExpr' e = case runHM' . solve $ e of
     Left es -> error (show es)
-    Right e' -> renderTmp' . annExpr pretty $ e'
+    Right e' -> renderTmp' . annExpr out $ e'