portray-pretty 0.1.0.1 → 0.1.0.2
raw patch · 4 files changed
+133/−49 lines, 4 filesdep ~portrayPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: portray
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- portray-pretty.cabal +3/−3
- src/Data/Portray/Pretty.hs +31/−5
- test/Main.hs +95/−41
CHANGELOG.md view
@@ -7,3 +7,7 @@ * Fix needless parentheses around nullary function applications. * Improve Haddock documentation. * Improve the package description and synopsis.++# 0.1.0.2++* Update to portray-0.2.0
portray-pretty.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 93aaf5ac8b3c548a84614877b51df32bc719f8111b0fd163f33fee8d6c7daf48+-- hash: 2f09ba9b37e58400c49ded58a06b338f5b6aab89cb1b20f9b4461e347d4a9a00 name: portray-pretty-version: 0.1.0.1+version: 0.1.0.2 synopsis: A portray backend using the pretty package. description: This provides a <https://hackage.haskell.org/package/pretty pretty> backend for <https://hackage.haskell.org/package/portray portray>, along with@@ -42,7 +42,7 @@ src build-depends: base >=4.12 && <4.16- , portray >=0.1 && <0.2+ , portray >=0.2 && <0.3 , portray-diff >=0.1 && <0.2 , pretty >=1.1.3 && <1.2 , text >=0.1 && <1.3
src/Data/Portray/Pretty.hs view
@@ -106,6 +106,7 @@ import Data.Portray ( Assoc(..), Infixity(..), FactorPortrayal(..)+ , Ident(..), IdentKind(..) , Portray, Portrayal(..), PortrayalF(..) , cata, portray )@@ -145,13 +146,33 @@ portrayalToDoc :: Portrayal -> Doc portrayalToDoc t = portrayalToDocPrec t prettyNormal (-1) +ppInfix :: Ident -> Doc+ppInfix (Ident k nm) = case k of+ OpConIdent -> nmDoc+ OpIdent -> nmDoc+ VarIdent -> wrappedNm+ ConIdent -> wrappedNm+ where+ nmDoc = P.text $ T.unpack nm+ wrappedNm = P.char '`' <> nmDoc <> P.char '`'++ppPrefix :: Ident -> Doc+ppPrefix (Ident k nm) = case k of+ OpConIdent -> wrappedNm+ OpIdent -> wrappedNm+ VarIdent -> nmDoc+ ConIdent -> nmDoc+ where+ nmDoc = P.text $ T.unpack nm+ wrappedNm = P.parens nmDoc+ ppBinop- :: String+ :: Ident -> Infixity -> DocAssocPrec -> DocAssocPrec -> DocAssocPrec ppBinop nm fx@(Infixity assoc opPrec) x y lr p = P.maybeParens (not $ fixityCompatible fx lr p) $ P.sep- [ x (matchCtx AssocL assoc) opPrec P.<+> P.text nm+ [ x (matchCtx AssocL assoc) opPrec P.<+> ppInfix nm , P.nest 2 $ y (matchCtx AssocR assoc) opPrec ] @@ -171,7 +192,12 @@ -- | Render one layer of 'PortrayalF' to 'DocAssocPrec'. toDocAssocPrecF :: PortrayalF DocAssocPrec -> DocAssocPrec toDocAssocPrecF = \case- AtomF txt -> \_ _ -> P.text (T.unpack txt)+ NameF nm -> \_ _ -> ppPrefix nm+ LitIntF x -> \_ _ -> P.text (show x)+ LitRatF x -> \_ _ -> P.text (show (fromRational x :: Double))+ LitStrF x -> \_ _ -> P.text (show x)+ LitCharF x -> \_ _ -> P.text (show x)+ OpaqueF txt -> \_ _ -> P.text (T.unpack txt) ApplyF fn [] -> \_ _ -> fn AssocL 10 ApplyF fn xs -> \lr p -> P.maybeParens (not $ fixityCompatible (Infixity AssocL 10) lr p) $@@ -179,7 +205,7 @@ [ fn AssocL 10 , P.nest 2 $ P.sep $ xs <&> \docprec -> docprec AssocR 10 ]- BinopF nm fx x y -> ppBinop (T.unpack nm) fx x y+ BinopF nm fx x y -> ppBinop nm fx x y TupleF xs -> \_ _ -> ppBulletList "(" "," ")" $ xs <&> \x -> x AssocNope (-1) ListF xs -> \_ _ -> ppBulletList "[" "," "]" $ xs <&> \x -> x AssocNope (-1) LambdaCaseF xs -> \_ p ->@@ -200,7 +226,7 @@ [ con AssocNope 10 , P.nest 2 $ ppBulletList "{" "," "}" [ P.sep- [ P.text (T.unpack sel) P.<+> "="+ [ ppPrefix sel P.<+> "=" , P.nest 2 $ val AssocNope 0 ] | FactorPortrayal sel val <- sels
test/Main.hs view
@@ -30,65 +30,93 @@ main :: IO () main = defaultMain [ testGroup "Atom"- [ testCase "()" $ prettyShowPortrayal "()" @?= "()"- , testCase "2" $ prettyShowPortrayal "2" @?= "2"+ [ testCase "()" $ prettyShowPortrayal (Tuple []) @?= "()"+ , testCase "2" $ prettyShowPortrayal (LitInt 2) @?= "2" ] , testGroup "Apply" [ testCase "nullary" $- prettyShowPortrayal (Apply "Nothing" []) @?= "Nothing"+ prettyShowPortrayal (Apply (Name "Nothing") []) @?= "Nothing" , testCase "nullary 2" $- prettyShowPortrayal (Apply "id" [Apply "Nothing" []]) @?= "id Nothing"+ prettyShowPortrayal+ (Apply (Name "id") [Apply (Name "Nothing") []]) @?=+ "id Nothing" , testCase "unary" $- prettyShowPortrayal (Apply "Just" ["2"]) @?= "Just 2"+ prettyShowPortrayal (Apply (Name "Just") [LitInt 2]) @?= "Just 2" , testCase "parens" $- prettyShowPortrayal (Apply "Just" [Apply "Just" ["2"]]) @?=+ prettyShowPortrayal+ (Apply (Name "Just") [Apply (Name "Just") [LitInt 2]]) @?= "Just (Just 2)" , testCase "binary" $- prettyShowPortrayal (Apply "These" ["2", "4"]) @?=+ prettyShowPortrayal (Apply (Name "These") [LitInt 2, LitInt 4]) @?= "These 2 4" , testCase "nested" $- prettyShowPortrayal (Apply (Apply "These" ["2"]) ["4"]) @?=+ prettyShowPortrayal+ (Apply (Apply (Name "These") [LitInt 2]) [LitInt 4]) @?= "These 2 4" ] , testGroup "Binop" [ testCase "operator" $- prettyShowPortrayal (Binop ":|" (infixr_ 5) "5" (List [])) @?=+ prettyShowPortrayal+ (Binop ":|" (infixr_ 5) (LitInt 5) (List [])) @?= "5 :| []" , testCase "con" $- prettyShowPortrayal (Binop "`InfixCon`" (infixl_ 9) "2" "True") @?=+ prettyShowPortrayal + (Binop+ (Ident ConIdent "InfixCon")+ (infixl_ 9)+ (LitInt 2)+ (Name "True")) @?= "2 `InfixCon` True" , testCase "nest prec" $ prettyShowPortrayal- (Binop "+" (infixl_ 6) (Binop "*" (infixl_ 7) "2" "4") "6") @?=+ (Binop+ "+"+ (infixl_ 6)+ (Binop "*" (infixl_ 7) (LitInt 2) (LitInt 4))+ (LitInt 6)) @?= "2 * 4 + 6" , testCase "nest anti-prec" $ prettyShowPortrayal- (Binop "*" (infixl_ 7) (Binop "+" (infixl_ 6) "2" "4") "6") @?=+ (Binop+ "*"+ (infixl_ 7)+ (Binop "+" (infixl_ 6) (LitInt 2) (LitInt 4))+ (LitInt 6)) @?= "(2 + 4) * 6" , testCase "nest assoc" $ prettyShowPortrayal- (Binop "+" (infixl_ 6) (Binop "+" (infixl_ 6) "2" "4") "6") @?=+ (Binop+ "+"+ (infixl_ 6)+ (Binop "+" (infixl_ 6) (LitInt 2) (LitInt 4))+ (LitInt 6)) @?= "2 + 4 + 6" , testCase "nest anti-assoc" $ prettyShowPortrayal- (Binop "+" (infixl_ 6) "2" (Binop "+" (infixl_ 6) "4" "6")) @?=+ (Binop+ "+"+ (infixl_ 6)+ (LitInt 2)+ (Binop "+" (infixl_ 6) (LitInt 4) (LitInt 6))) @?= "2 + (4 + 6)" ] , testGroup "Tuple" [ testCase "pair" $- prettyShowPortrayal (Tuple ["2", "4"]) @?= "( 2, 4 )"+ prettyShowPortrayal (Tuple [LitInt 2, LitInt 4]) @?= "( 2, 4 )" , testCase "triple" $- prettyShowPortrayal (Tuple ["2", "4", "6"]) @?= "( 2, 4, 6 )"+ prettyShowPortrayal (Tuple [LitInt 2, LitInt 4, LitInt 6]) @?=+ "( 2, 4, 6 )" , testCase "line-break" $- prettyShowPortrayal (Tuple ["222", strAtom (replicate 61 '2')]) @?=+ prettyShowPortrayal+ (Tuple [strAtom "222", strAtom (replicate 61 '2')]) @?= "( 222\n\ \, 2222222222222222222222222222222222222222222222222222222222222\n\ \)"@@ -96,22 +124,25 @@ , testGroup "List" [ testCase "empty" $ prettyShowPortrayal (List []) @?= "[]"- , testCase "singleton" $ prettyShowPortrayal (List ["2"]) @?= "[ 2 ]"+ , testCase "singleton" $ prettyShowPortrayal (List [LitInt 2]) @?=+ "[ 2 ]" ] , testGroup "LambdaCase" [ testCase "empty" $ prettyShowPortrayal (LambdaCase []) @?= "\\case {}" , testCase "singleton" $- prettyShowPortrayal (LambdaCase [("()", "2")]) @?=+ prettyShowPortrayal (LambdaCase [(Tuple [], LitInt 2)]) @?= "\\case { () -> 2 }" , testCase "two" $- prettyShowPortrayal (LambdaCase [("True", "2"), ("False", "4")]) @?=+ prettyShowPortrayal+ (LambdaCase+ [(Name "True", LitInt 2), (Name "False", LitInt 4)]) @?= "\\case { True -> 2; False -> 4 }" , testCase "line-break" $ prettyShowPortrayal (LambdaCase- [ ("True", strAtom (replicate 25 '2'))- , ("False", strAtom (replicate 25 '4'))+ [ (Name "True", strAtom (replicate 25 '2'))+ , (Name "False", strAtom (replicate 25 '4')) ]) @?= "\\case\n\ \ { True -> 2222222222222222222222222\n\@@ -119,38 +150,57 @@ \ }" , testCase "no-parens" $ prettyShowPortrayal- (LambdaCase [(Apply "Just" ["2"], Apply "Just" ["4"])]) @?=+ (LambdaCase+ [( Apply (Name "Just") [LitInt 2]+ , Apply (Name "Just") [LitInt 4]+ )]) @?= "\\case { Just 2 -> Just 4 }" ] , testGroup "Record"- [ testCase "empty" $ prettyShowPortrayal (Record "Nothing" []) @?=+ [ testCase "empty" $ prettyShowPortrayal (Record (Name "Nothing") []) @?= "Nothing" , testCase "singleton" $- prettyShowPortrayal (Record "Just" [FactorPortrayal "it" "2"]) @?=- "Just { it = 2 }"+ prettyShowPortrayal+ (Record (Name "Just") [FactorPortrayal "it" (LitInt 2)]) @?=+ "Just { it = 2 }" , testCase "two" $- prettyShowPortrayal- (Record "These"- [FactorPortrayal "l" "2", FactorPortrayal "r" "4"]) @?=- "These { l = 2, r = 4 }"+ prettyShowPortrayal+ (Record (Name "These")+ [ FactorPortrayal "l" (LitInt 2)+ , FactorPortrayal "r" (LitInt 4)+ ]) @?=+ "These { l = 2, r = 4 }" , testCase "line-break" $- prettyShowPortrayal- (Record "These"+ prettyShowPortrayal+ (Record (Name "These") [ FactorPortrayal "l" (portray @[Int] [0..10]) , FactorPortrayal "r" (portray @[Int] [0..10]) ]) @?=- "These\n\- \ { l = [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ]\n\- \ , r = [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ]\n\- \ }"+ "These\n\+ \ { l = [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ]\n\+ \ , r = [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ]\n\+ \ }"+ , testCase "break-equals" $+ prettyShowPortrayal+ (Record (Name "These")+ [ FactorPortrayal+ "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"+ (Name "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")+ ]) @?=+ "These\n\+ \ { aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa =\n\+ \ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\+ \ }" ] , testGroup "TyApp" [ testCase "con" $- prettyShowPortrayal (TyApp "typeRep" "Int") @?= "typeRep @Int"+ prettyShowPortrayal (TyApp (Name "typeRep") (Name "Int")) @?=+ "typeRep @Int" , testCase "parens" $- prettyShowPortrayal (TyApp "typeRep" (Apply "Maybe" ["Int"])) @?=+ prettyShowPortrayal+ (TyApp (Name "typeRep") (Apply (Name "Maybe") [Name "Int"])) @?= "typeRep @(Maybe Int)" , testCase "line-break" $ prettyShowPortrayal@@ -162,10 +212,13 @@ ] , testGroup "TySig"- [ testCase "con" $ prettyShowPortrayal (TySig "2" "Int") @?= "2 :: Int"+ [ testCase "con" $ prettyShowPortrayal (TySig (LitInt 2) (Name "Int")) @?=+ "2 :: Int" , testCase "no-parens" $ prettyShowPortrayal- (TySig (Apply "Just" ["2"]) (Apply "Maybe" ["Int"])) @?=+ (TySig+ (Apply (Name "Just") [LitInt 2])+ (Apply (Name "Maybe") [Name "Int"])) @?= "Just 2 :: Maybe Int" , testCase "line-break" $ prettyShowPortrayal@@ -175,7 +228,8 @@ "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\ \ :: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" , testCase "parens" $- prettyShowPortrayal (Apply "Just" [TySig "2" "Int"]) @?=+ prettyShowPortrayal+ (Apply (Name "Just") [TySig (LitInt 2) (Name "Int")]) @?= "Just (2 :: Int)" ] ]