diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +# 0.1.0 + +Initial version. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/portray-prettyprinter.cabal b/portray-prettyprinter.cabal new file mode 100644 --- /dev/null +++ b/portray-prettyprinter.cabal @@ -0,0 +1,74 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.33.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: c09be156b143855f336e4a1cb5847e88d29f06163780223de49dd8ec74711e3d + +name: portray-prettyprinter +version: 0.1.0 +synopsis: A portray backend using the prettyprinter package. +description: This provides a + backend for + along with derivable + 'Pretty' instances for types with 'Portray' instances. + . + This started out as a copy of + , and is + still very similar. However, @prettyprinter@ gives more flexibility to + documents at the cost of requiring more behavior to be specified explicitly. + As such, some formats can be nicer with the @prettyprinter@ backend, but as + of the initial release, this backend is less mature and hasn't been used in + practice, so there are likely more formatting bugs. Please do file bugs on + the GitHub issue tracker if you find anything that seems obviously wrong! +category: Text +homepage: https://github.com/google/hs-portray#readme +bug-reports: https://github.com/google/hs-portray/issues +author: Andrew Pritchard +maintainer: Andrew Pritchard +copyright: 2021 Google LLC +license: Apache-2.0 +license-file: LICENSE +build-type: Simple +extra-source-files: + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/google/hs-portray + subdir: portray-prettyprinter + +library + exposed-modules: + Data.Portray.Prettyprinter + other-modules: + Paths_portray_prettyprinter + hs-source-dirs: + src + build-depends: + base >=4.12 && <4.16 + , portray >=0.1 && <0.2 + , portray-diff >=0.1 && <0.2 + , prettyprinter + , text >=0.1 && <1.3 + default-language: Haskell2010 + +test-suite PortrayPrettyprinter-test + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Paths_portray_prettyprinter + hs-source-dirs: + test + build-depends: + HUnit + , base >=4.12 && <4.16 + , portray + , portray-diff >=0.1 && <0.2 + , portray-prettyprinter + , prettyprinter + , test-framework + , test-framework-hunit + , text >=0.1 && <1.3 + default-language: Haskell2010 diff --git a/src/Data/Portray/Prettyprinter.hs b/src/Data/Portray/Prettyprinter.hs new file mode 100644 --- /dev/null +++ b/src/Data/Portray/Prettyprinter.hs @@ -0,0 +1,266 @@ +-- Copyright 2021 Google LLC +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- | Provides rendering of 'Portrayal' to 'Doc'. +-- +-- There are two intended uses of this module: firstly, to use @prettyprinter@'s +-- layout and rendering algorithms to render 'Portray' instances, 'Diff's, or +-- other 'Portrayal's; and secondly, to derive 'Pretty' instances based on +-- existing 'Portray' instances. I find the former more ergonomic, but in +-- established codebases that want to benefit from deriving, the latter may be +-- more achievable. +-- +-- The first usage is for codebases with pervasive use of 'Portray', and +-- involves using e.g. 'pp' and 'ppd' in GHCi, or 'showPortrayal' or 'showDiff' +-- in application code. With this usage, anything you want to pretty-print +-- needs a 'Portray' instance, and the typeclass 'Pretty' is not involved in +-- any way. With this approach, pretty-printable types and the types they +-- include should derive only 'Portray', and pretty-printing should be done +-- with the aforementioned utility functions: +-- +-- @ +-- data MyRecord = MyRecord { anInt :: Int, anotherRecord :: MyOtherRecord } +-- deriving Generic +-- deriving Portray via Wrapped Generic MyRecord +-- +-- example = 'showPortrayal' (MyRecord 2 ...) +-- @ +-- +-- The second usage is to use @portray@'s generic deriving to provide derived +-- 'Pretty' instances, in a codebase that uses 'Pretty' as the preferred +-- typeclass for pretty-printable values. With this usage, things you want to +-- pretty-print need 'Pretty' instances, and 'Portray' is needed for the +-- transitive closure of types included in types you want to derive 'Pretty' +-- instances for. This may result in many types needing both instances of both +-- 'Pretty' (for direct pretty-printing) and 'Portray' (for deriving 'Portray' +-- on downstream types) instances. Note that with this approach, types that +-- derive their 'Pretty' instances via 'Portray' will ignore any custom +-- 'Pretty' instances of nested types, since they recurse to nested 'Portray' +-- instances instead. +-- +-- To derive an instance for a pretty-printable type, the type itself should +-- look like the following: +-- +-- @ +-- data MyRecord = MyRecord { anInt :: Int, anotherRecord :: MyOtherRecord } +-- deriving Generic +-- deriving Portray via Wrapped Generic MyRecord +-- deriving Pretty via WrappedPortray MyRecord +-- +-- example = 'R.renderStrict' $ 'pretty' (MyRecord 2 ...) +-- @ +-- +-- And any types transitively included in it should look like the following: +-- +-- @ +-- data MyOtherRecord = MyOtherRecord +-- deriving Generic +-- deriving Portray via Wrapped Generic MyRecord +-- @ +-- +-- This module also exports the underlying rendering functionality in a variety +-- of forms for more esoteric uses. + +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Portray.Prettyprinter + ( -- * Pretty-Printing + showPortrayal, pp + -- * Diffing + , showDiff, ppd + -- * DerivingVia wrapper + , WrappedPortray(..) + -- * Rendering Functions + -- ** With Associativity + , DocAssocPrec, toDocAssocPrecF, toDocAssocPrec + -- ** With Precedence + , portrayalToDocPrecF, portrayalToDocPrec + -- ** Convenience Functions + , portrayalToDoc + , prettyShowPortrayal + ) where + +import Data.Functor ((<&>)) +import Data.Text (Text) +import qualified Data.Text.IO as T (putStrLn) + +import Prettyprinter (Doc, Pretty(..)) +import qualified Prettyprinter as P +import qualified Prettyprinter.Render.Text as R + +import Data.Portray + ( Assoc(..), Infixity(..), FactorPortrayal(..) + , Portray, Portrayal(..), PortrayalF(..) + , cata, portray + ) +import Data.Portray.Diff (Diff(..)) + +-- | Pretty-print a value to stdout using its 'Portray' instance. +pp :: Portray a => a -> IO () +pp = T.putStrLn . showPortrayal + +-- | Pretty-print a value using its 'Portray' instance. +showPortrayal :: Portray a => a -> Text +showPortrayal = prettyShowPortrayal . portray + +-- | Pretty-print a diff between two values to stdout using a 'Diff' instance. +ppd :: Diff a => a -> a -> IO () +ppd x = T.putStrLn . showDiff x + +-- | Pretty-print a diff between two values using a 'Diff' instance. +showDiff :: Diff a => a -> a -> Text +showDiff x = maybe "_" prettyShowPortrayal . diff x + +-- | A 'Doc' that varies according to associativity and precedence context. +type DocAssocPrec ann = Assoc -> Rational -> Doc ann + +fixityCompatible :: Infixity -> Assoc -> Rational -> Bool +fixityCompatible (Infixity assoc p) assoc' p' = case compare p' p of + GT -> False -- Context has higher precedence than this binop. + EQ -> assoc == assoc' + LT -> True + +matchCtx :: Assoc -> Assoc -> Assoc +matchCtx ctx assoc + | ctx == assoc = ctx + | otherwise = AssocNope + +-- | Convert a 'Portrayal' to a 'Doc'. +portrayalToDoc :: Portrayal -> Doc ann +portrayalToDoc t = portrayalToDocPrec t (-1) + +-- Conditionally wrap a document in parentheses. +maybeParens :: Bool -> Doc ann -> Doc ann +maybeParens = \case True -> P.parens; False -> id + +-- Convert Text to a document; 'pretty' specialized to 'Text'. +text :: Text -> Doc ann +text = pretty + +-- Convert a Char to a document; 'pretty' specialized to 'Char'. +char :: Char -> Doc ann +char = pretty + +ppBinop + :: Text + -> Infixity + -> DocAssocPrec ann -> DocAssocPrec ann -> DocAssocPrec ann +ppBinop nm fx@(Infixity assoc opPrec) x y lr p = + maybeParens (not $ fixityCompatible fx lr p) $ P.nest 2 $ P.sep + [ x (matchCtx AssocL assoc) opPrec P.<+> text nm + , y (matchCtx AssocR assoc) opPrec + ] + +ppBulletList + :: Doc ann -- ^ Open brace, e.g. { [ { ( + -> Doc ann -- ^ Separator, e.g. ; , , , + -> Doc ann -- ^ Close brace, e.g. } ] } ) + -> [Doc ann] + -> Doc ann +ppBulletList opener _ closer [] = opener <> closer +ppBulletList opener separator closer (doc:docs) = + P.group $ + P.concatWith (\x y -> x <> P.group (P.line' <> y)) + (opener <> P.flatAlt " " "" <> doc : + zipWith (P.<+>) (repeat separator) docs) <> + P.line' <> closer + +-- | Render one layer of 'PortrayalF' to 'DocAssocPrec'. +toDocAssocPrecF :: PortrayalF (DocAssocPrec ann) -> DocAssocPrec ann +toDocAssocPrecF = \case + AtomF txt -> \_ _ -> text txt + ApplyF fn [] -> \_ _ -> fn AssocL 10 + ApplyF fn xs -> \lr p -> + maybeParens (not $ fixityCompatible (Infixity AssocL 10) lr p) $ + P.nest 2 $ P.sep + [ fn AssocL 10 + , P.sep $ xs <&> \docprec -> docprec AssocR 10 + ] + 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 -> + maybeParens (p >= 10) $ + P.nest 2 $ P.sep + [ "\\case" + , ppBulletList "{" ";" "}" + [ P.nest 2 $ P.sep $ + [ pat AssocNope 0 P.<+> "->" + , val AssocNope 0 + ] + | (pat, val) <- xs + ] + ] + RecordF con sels -> \_ _ -> case sels of + [] -> con AssocNope (-1) + _ -> P.nest 2 $ P.sep + [ con AssocNope 10 + , ppBulletList "{" "," "}" + [ P.nest 2 $ P.sep + [ text sel P.<+> "=" + , val AssocNope 0 + ] + | FactorPortrayal sel val <- sels + ] + ] + TyAppF val ty -> \_ _ -> + P.nest 2 $ P.sep [val AssocNope 10, "@" <> ty AssocNope 10] + TySigF val ty -> \_ p -> maybeParens (p >= 0) $ + P.nest 2 $ P.sep [val AssocNope 0, "::" P.<+> ty AssocNope 0] + QuotF nm content -> \_ _ -> + P.nest 2 $ P.sep + [ char '[' <> text nm <> char '|' + , content AssocNope (-1) + , "|]" + ] + UnlinesF ls -> \_ _ -> P.vcat (ls <&> \l -> l AssocNope (-1)) + NestF n x -> \_ _ -> P.nest n (x AssocNope (-1)) + +toDocPrec :: DocAssocPrec ann -> Rational -> Doc ann +toDocPrec dap = dap AssocNope . subtract 1 + +-- | Render a 'PortrayalF' to a 'Doc'. +portrayalToDocPrecF + :: PortrayalF (DocAssocPrec ann) -> Rational -> Doc ann +portrayalToDocPrecF = toDocPrec . toDocAssocPrecF + +-- | Render a 'Portrayal' to a 'Doc' with support for operator associativity. +toDocAssocPrec :: Portrayal -> DocAssocPrec ann +toDocAssocPrec = cata toDocAssocPrecF . unPortrayal + +-- | Render a 'Portrayal' to a 'Doc' with only operator precedence. +portrayalToDocPrec :: Portrayal -> Rational -> Doc ann +portrayalToDocPrec = toDocPrec . toDocAssocPrec + +-- | Convenience function for rendering a 'Portrayal' to a 'String'. +prettyShowPortrayal :: Portrayal -> Text +prettyShowPortrayal p = + R.renderStrict $ P.layoutPretty P.defaultLayoutOptions $ + toDocAssocPrec p AssocNope (-1) + +-- | A newtype providing a 'Pretty' instance via 'Portray', for @DerivingVia@. +-- +-- Sadly we can't use @Wrapped@ since it would be an orphan instance. Oh well. +-- We'll just define a unique 'WrappedPortray' newtype in each +-- pretty-printer-integration package. +newtype WrappedPortray a = WrappedPortray { unWrappedPortray :: a } + deriving newtype (Eq, Ord, Show) + +-- | Provide an instance for 'Pretty' by way of 'Portray'. +instance Portray a => Pretty (WrappedPortray a) where + pretty x = portrayalToDocPrec (portray $ unWrappedPortray x) 0 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,182 @@ +-- Copyright 2021 Google LLC +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +module Main where + +import Test.Framework (defaultMain, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit ((@?=)) + +import Data.Portray +import Data.Portray.Prettyprinter + +main :: IO () +main = defaultMain + [ testGroup "Atom" + [ testCase "()" $ prettyShowPortrayal "()" @?= "()" + , testCase "2" $ prettyShowPortrayal "2" @?= "2" + ] + + , testGroup "Apply" + [ testCase "nullary" $ + prettyShowPortrayal (Apply "Nothing" []) @?= "Nothing" + , testCase "nullary 2" $ + prettyShowPortrayal (Apply "id" [Apply "Nothing" []]) @?= "id Nothing" + , testCase "unary" $ + prettyShowPortrayal (Apply "Just" ["2"]) @?= "Just 2" + , testCase "parens" $ + prettyShowPortrayal (Apply "Just" [Apply "Just" ["2"]]) @?= + "Just (Just 2)" + , testCase "binary" $ + prettyShowPortrayal (Apply "These" ["2", "4"]) @?= + "These 2 4" + , testCase "nested" $ + prettyShowPortrayal (Apply (Apply "These" ["2"]) ["4"]) @?= + "These 2 4" + ] + + , testGroup "Binop" + [ testCase "operator" $ + prettyShowPortrayal (Binop ":|" (infixr_ 5) "5" (List [])) @?= + "5 :| []" + + , testCase "con" $ + prettyShowPortrayal (Binop "`InfixCon`" (infixl_ 9) "2" "True") @?= + "2 `InfixCon` True" + + , testCase "nest prec" $ + prettyShowPortrayal + (Binop "+" (infixl_ 6) (Binop "*" (infixl_ 7) "2" "4") "6") @?= + "2 * 4 + 6" + + , testCase "nest anti-prec" $ + prettyShowPortrayal + (Binop "*" (infixl_ 7) (Binop "+" (infixl_ 6) "2" "4") "6") @?= + "(2 + 4) * 6" + + , testCase "nest assoc" $ + prettyShowPortrayal + (Binop "+" (infixl_ 6) (Binop "+" (infixl_ 6) "2" "4") "6") @?= + "2 + 4 + 6" + + , testCase "nest anti-assoc" $ + prettyShowPortrayal + (Binop "+" (infixl_ 6) "2" (Binop "+" (infixl_ 6) "4" "6")) @?= + "2 + (4 + 6)" + ] + + , testGroup "Tuple" + [ testCase "pair" $ + prettyShowPortrayal (Tuple ["2", "4"]) @?= "(2, 4)" + , testCase "triple" $ + prettyShowPortrayal (Tuple ["2", "4", "6"]) @?= "(2, 4, 6)" + , testCase "line-break" $ + prettyShowPortrayal (Tuple ["222", strAtom (replicate 80 '2')]) @?= + "( 222\n\ + \, 2222222222222222222222222222222222222222222222222222222222222\ + \2222222222222222222\n\ + \)" + ] + + , testGroup "List" + [ testCase "empty" $ prettyShowPortrayal (List []) @?= "[]" + , testCase "singleton" $ prettyShowPortrayal (List ["2"]) @?= "[2]" + ] + + , testGroup "LambdaCase" + [ testCase "empty" $ prettyShowPortrayal (LambdaCase []) @?= "\\case {}" + , testCase "singleton" $ + prettyShowPortrayal (LambdaCase [("()", "2")]) @?= + "\\case {() -> 2}" + , testCase "two" $ + prettyShowPortrayal (LambdaCase [("True", "2"), ("False", "4")]) @?= + "\\case {True -> 2; False -> 4}" + , testCase "line-break" $ + prettyShowPortrayal + (LambdaCase + [ ("True", strAtom (replicate 40 '2')) + , ("False", strAtom (replicate 40 '4')) + ]) @?= + "\\case\n\ + \ { True -> 2222222222222222222222222222222222222222\n\ + \ ; False -> 4444444444444444444444444444444444444444\n\ + \ }" + , testCase "no-parens" $ + prettyShowPortrayal + (LambdaCase [(Apply "Just" ["2"], Apply "Just" ["4"])]) @?= + "\\case {Just 2 -> Just 4}" + ] + + , testGroup "Record" + [ testCase "empty" $ prettyShowPortrayal (Record "Nothing" []) @?= + "Nothing" + , testCase "singleton" $ + prettyShowPortrayal (Record "Just" [FactorPortrayal "it" "2"]) @?= + "Just {it = 2}" + , testCase "two" $ + prettyShowPortrayal + (Record "These" + [FactorPortrayal "l" "2", FactorPortrayal "r" "4"]) @?= + "These {l = 2, r = 4}" + , testCase "line-break" $ + prettyShowPortrayal + (Record "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\ + \ }" + ] + + , testGroup "TyApp" + [ testCase "con" $ + prettyShowPortrayal (TyApp "typeRep" "Int") @?= "typeRep @Int" + , testCase "parens" $ + prettyShowPortrayal (TyApp "typeRep" (Apply "Maybe" ["Int"])) @?= + "typeRep @(Maybe Int)" + , testCase "line-break" $ + prettyShowPortrayal + (TyApp + (strAtom $ replicate 50 'a') + (strAtom $ replicate 50 'a')) @?= + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\ + \ @aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + ] + + , testGroup "TySig" + [ testCase "con" $ prettyShowPortrayal (TySig "2" "Int") @?= "2 :: Int" + , testCase "no-parens" $ + prettyShowPortrayal + (TySig (Apply "Just" ["2"]) (Apply "Maybe" ["Int"])) @?= + "Just 2 :: Maybe Int" + , testCase "line-break" $ + prettyShowPortrayal + (TySig + (strAtom $ replicate 50 'a') + (strAtom $ replicate 50 'a')) @?= + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\ + \ :: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + , testCase "parens" $ + prettyShowPortrayal (Apply "Just" [TySig "2" "Int"]) @?= + "Just (2 :: Int)" + ] + ]