portray 0.1.1 → 0.2.0

raw patch · 4 files changed

+322/−151 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• portray.cabal +2/−2
• src/Data/Portray.hs +236/−121
• test/Main.hs +78/−28

@@ -7,3 +7,9 @@ Transitional version towards 0.2.0.  * Add `Name` and `Opaque` pattern synonyms.++# 0.2.0++* Split Atom into literals, identifiers, and opaque text.+* Make operator names and record field names `Ident`s.+* Special-case `String`s so they don't get formatted as lists of `Char`s.

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 109ae2214b5ae5900ac117adf167e79fe09d0d97374f1a340a4bb042182e40fd+-- hash: d8a84a7f579005a1a70aca7e5c6b39b36177ae03fe56d8a033d5f7cec00d3875  name:           portray-version:        0.1.1+version:        0.2.0 synopsis:       A pseudo-Haskell syntax type and typeclass producing it. description:    This provides a single place to describe how a type should be formatted as                 pseudo-Haskell syntax, independently of the actual pretty-printing library

@@ -40,28 +40,31 @@ module Data.Portray          ( -- * Syntax Tree            Portrayal-             ( Atom, Name, Opaque, Apply, Binop, Tuple, List+             ( Name, LitInt, LitRat, LitStr, LitChar, Opaque+             , Apply, Binop, Tuple, List              , LambdaCase, Record, TyApp, TySig              , Quot, Unlines, Nest              , ..              )          , FactorPortrayal(..)+         , IdentKind(..), Ident(..)            -- ** Operator Fixity          , Assoc(..), Infixity(..), infix_, infixl_, infixr_            -- ** Base Functor          , PortrayalF(..)            -- * Class          , Portray(..)-           -- ** Via Show-         , ShowAtom(..)            -- ** Via Generic          , GPortray(..), GPortrayProduct(..)+           -- ** Via Show, Integral, and Real+         , PortrayIntLit(..), PortrayRatLit(..), ShowAtom(..)            -- * Convenience          , showAtom, strAtom, strQuot, strBinop            -- * Miscellaneous          , Fix(..), cata, portrayCallStack, portrayType          ) where +import Data.Char (isAlpha, isDigit, isUpper) import Data.Coerce (Coercible, coerce) import Data.Functor.Identity (Identity(..)) import Data.Functor.Const (Const(..))@@ -74,7 +77,7 @@ import Data.Ratio (Ratio, numerator, denominator) import Data.Sequence (Seq) import Data.Set (Set)-import Data.String (IsString(..))+import Data.String (IsString) import Data.Text (Text) import Data.Type.Coercion (Coercion(..)) import Data.Type.Equality ((:~:)(..))@@ -125,40 +128,70 @@ infixr_ :: Rational -> Infixity infixr_ = Infixity AssocR +-- | The kind of identifier a particular 'Ident' represents.+data IdentKind = VarIdent | ConIdent | OpIdent | OpConIdent+  deriving (Eq, Ord, Read, Show, Generic)+  deriving Portray via Wrapped Generic IdentKind++-- | An identifier or operator name.+data Ident = Ident !IdentKind !Text+  deriving (Eq, Ord, Read, Show, Generic)+  deriving Portray via Wrapped Generic Ident++instance IsString Ident where+  fromString nm = Ident k (T.pack nm)+   where+    k = case nm of+      (':':_) -> OpConIdent+      ('_':_) -> VarIdent+      (c:_)+        | isUpper c -> ConIdent+        | isAlpha c -> VarIdent+        | otherwise -> OpIdent+      "" -> VarIdent -- /shrug/+ -- | A single level of pseudo-Haskell expression; used to define 'Portrayal'. data PortrayalF a-  = AtomF !Text-    -- ^ Render this text directly.+  = NameF {-# UNPACK #-} !Ident+    -- ^ An identifier, including variable, constructor and operator names.+  | LitIntF !Integer+    -- ^ An integral literal.  e.g. @42@+  | LitRatF {-# UNPACK #-} !Rational+    -- ^ A rational / floating-point literal.  e.g. @42.002@+  | LitStrF !Text+    -- ^ A string literal, stored without escaping or quotes.  e.g. @"hi"@+  | LitCharF !Char+    -- ^ A character literal.  e.g. @\'a\'@+  | OpaqueF !Text+    -- ^ A chunk of opaque text.  e.g. @abc"]def@   | ApplyF !a [a]-    -- ^ Render a function application to several arguments.-  | BinopF !Text !Infixity !a !a-    -- ^ Render a binary infix operator application to two arguments.+    -- ^ A function application to several arguments.+  | BinopF !Ident !Infixity !a !a+    -- ^ A binary infix operator application to two arguments.   | TupleF [a]-    -- ^ Render a tuple of sub-values.+    -- ^ A tuple of sub-values.   | ListF [a]-    -- ^ Render a list of sub-values.+    -- ^ A list of sub-values.   | LambdaCaseF [(a, a)]-    -- ^ Render a lambda-case expression.+    -- ^ A lambda-case expression.   | RecordF !a [FactorPortrayal a]-    -- ^ Render a record construction/update syntax.+    -- ^ A record construction/update syntax.   | TyAppF !a !a-    -- ^ Render a TypeApplication.+    -- ^ A TypeApplication.   | TySigF !a !a-    -- ^ Render a term with explicit type signature.+    -- ^ A term with explicit type signature.   | QuotF !Text !a-    -- ^ Render a quasiquoter term with the given name.+    -- ^ A quasiquoter term with the given name.   | UnlinesF [a]-    -- ^ Render a collection of vertically-aligned lines+    -- ^ A collection of vertically-aligned lines   | NestF !Int !a-    -- ^ Indent the subdocument by the given number of columns.+    -- ^ A subdocument indented by the given number of columns.   deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable, Generic)   deriving Portray via Wrapped Generic (PortrayalF a) -instance IsString (PortrayalF a) where fromString = AtomF . T.pack- -- | A 'Portrayal' along with a field name; one piece of a record literal. data FactorPortrayal a = FactorPortrayal-  { _fpFieldName :: !Text+  { _fpFieldName :: !Ident   , _fpPortrayal :: !a   }   deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable, Generic)@@ -193,11 +226,9 @@   deriving stock (Eq, Generic)   deriving newtype (Portray, Show, Read) -instance IsString Portrayal where fromString = Atom . T.pack- {-# COMPLETE-      Atom, Apply, Binop, Tuple, List, LambdaCase,-      Record, TyApp, TySig, Quot, Unlines, Nest+      Name, LitInt, LitRat, LitStr, LitChar, Opaque, Apply, Binop, Tuple,+      List, LambdaCase, Record, TyApp, TySig, Quot, Unlines, Nest   #-}  -- An explicitly-bidirectional pattern synonym that makes it possible to write@@ -212,24 +243,40 @@ -- A collection of pattern synonyms to hide the fact that we're using Fix -- internally. --- | A single chunk of text included directly in the pretty-printed output.+-- | An identifier, including variable, constructor, and operator names. ----- This is used for things like literals and constructor names.-pattern Atom :: Text -> Portrayal-pattern Atom txt = Portrayal (Fix (AtomF txt))+-- The 'IdentKind' distinguishes constructors, operators, etc. to enable+-- backends to do things like syntax highlighting, without needing to engage in+-- text manipulation to figure out syntax classes.+pattern Name :: Ident -> Portrayal+pattern Name nm = Portrayal (Fix (NameF nm)) --- | Compatibility aid for portray-0.2.+-- | An integral literal.+pattern LitInt :: Integer -> Portrayal+pattern LitInt x = Portrayal (Fix (LitIntF x))+++-- | A rational / floating-point literal.+pattern LitRat :: Rational -> Portrayal+pattern LitRat x = Portrayal (Fix (LitRatF x))++-- | A string literal. ----- Use this as @Name "a_string_literal"@ or @Name (fromString s)@ to support--- both 0.1 and 0.2.-pattern Name :: Text -> Portrayal-pattern Name txt = Atom txt+-- Some backends may be capable of flowing these onto multiple lines+-- automatically, which they wouldn't be able to do with opaque text.+pattern LitStr :: Text -> Portrayal+pattern LitStr x = Portrayal (Fix (LitStrF x)) --- | Compatibility aid for portray-0.2.+-- | A character literal.+pattern LitChar :: Char -> Portrayal+pattern LitChar x = Portrayal (Fix (LitCharF x))++-- | An opaque chunk of text included directly in the pretty-printed output. ----- Use this with any Text argument to support both 0.1 and 0.2.+-- This is used by things like 'strAtom' that don't understand their contents,+-- and will miss out on any syntax-aware features provided by backends. pattern Opaque :: Text -> Portrayal-pattern Opaque txt = Atom txt+pattern Opaque txt = Portrayal (Fix (OpaqueF txt))  -- | A function or constructor application of arbitrary arity. --@@ -242,15 +289,15 @@ -- Given: -- -- @---     Apply \"These\" ["2", "4"]+-- Apply (Name \"These\") [LitInt 2, LitInt 4] -- @ -- -- We render something like @These 2 4@, or if line-wrapped: -- -- @---     These---       2---       4+-- These+--   2+--   4 -- @ pattern Apply :: Portrayal -> [Portrayal] -> Portrayal pattern Apply f xs = Portrayal (Fix (ApplyF (Coerced f) (Coerced xs)))@@ -263,14 +310,15 @@ -- Given: -- -- @---     Binop "+" (infixl_ 6)---       [ Binop "+" (infixl_ 6) ["2", "4"]---       , "6"---       ]+-- Binop (Name "+") (infixl_ 6)+--   [ Binop (Name "+") (infixl_ 6) [LitInt 2, LitInt 4]+--   , "6"+--   ] -- @ -- -- We render something like: @2 + 4 + 6@-pattern Binop :: Text -> Infixity -> Portrayal -> Portrayal -> Portrayal+pattern Binop+  :: Ident -> Infixity -> Portrayal -> Portrayal -> Portrayal pattern Binop nm inf x y =   Portrayal (Fix (BinopF nm inf (Coerced x) (Coerced y))) @@ -279,29 +327,32 @@ -- Given: -- -- @---     List [Apply \"These\" ["2", "4"], Apply \"That\" ["6"]]+-- List+--   [ Apply (Name \"These\") [LitInt 2, LitInt 4]+--   , Apply (Name \"That\") [LitInt 6]+--   ] -- @ -- -- We render something like: -- -- @---     [ These 2 4---     , That 6---     ]+-- [ These 2 4+-- , That 6+-- ] -- @ pattern List :: [Portrayal] -> Portrayal pattern List xs = Portrayal (Fix (ListF (Coerced xs)))  -- | A tuple. ----- Given @Tuple ["2", "4"]@, we render something like @(2, 4)@+-- Given @Tuple [LitInt 2, LitInt 4]@, we render something like @(2, 4)@ pattern Tuple :: [Portrayal] -> Portrayal pattern Tuple xs = Portrayal (Fix (TupleF (Coerced xs)))  -- | A lambda-case. ----- Given @LambdaCase [("0", "\"hi\""), ("1", "\"hello\"")]@, we render--- something like @\case 0 -> "hi"; 1 -> "hello"@.+-- Given @LambdaCase [(LitInt 0, LitStr "hi"), (LitInt 1, LitStr "hello")]@, we+-- render something like @\\case 0 -> "hi"; 1 -> "hello"@. -- -- This can be useful in cases where meaningful values effectively appear in -- negative position in a type, like in a total map or table with non-integral@@ -314,35 +365,43 @@ -- Given: -- -- @---     Record \"Identity\" [FactorPortrayal "runIdentity" "2"]+-- Record+--   (Name \"Identity\")+--   [FactorPortrayal (Name "runIdentity") (LitInt 2)] -- @ -- -- We render something like: -- -- @---     Identity---       { runIdentity = 2---       }+-- Identity+--   { runIdentity = 2+--   } -- @ pattern Record :: Portrayal -> [FactorPortrayal Portrayal] -> Portrayal pattern Record x xs = Portrayal (Fix (RecordF (Coerced x) (Coerced xs)))  -- | A type application. ----- Given @TyApp \"Proxy\" \"Int\"@, we render @Proxy \@Int@+-- Given @TyApp (Name \"Proxy\") (Name \"Int\")@, we render @Proxy \@Int@ pattern TyApp :: Portrayal -> Portrayal -> Portrayal pattern TyApp x t = Portrayal (Fix (TyAppF (Coerced x) (Coerced t)))  -- | An explicit type signature. ----- Given @TySig \"Proxy\" [Apply \"Proxy\" ["Int"]]@, we render--- @Proxy :: Proxy Int@+-- Given @TySig (Name \"Proxy\") [Apply (Name \"Proxy\") [Name \"Int\"]]@, we+-- render @Proxy :: Proxy Int@ pattern TySig :: Portrayal -> Portrayal -> Portrayal pattern TySig x t = Portrayal (Fix (TySigF (Coerced x) (Coerced t)))  -- | A quasiquoter expression. ----- Given @Quot \"expr\" (Binop "+" _ ["x", "!y"])@, we render @[expr| x + !y |]@+-- Given:+--+-- @+-- Quot (Opaque \"expr\") (Binop (Opaque "+") _ [Opaque "x", Opaque "!y"])+-- @+--+-- We render something like @[expr| x + !y |]@ pattern Quot :: Text -> Portrayal -> Portrayal pattern Quot t x = Portrayal (Fix (QuotF t (Coerced x))) @@ -382,23 +441,36 @@ class Portray a where   portray :: a -> Portrayal --- | Convenience for using a 'Show' instance and wrapping the result in 'Atom'.+  -- | Portray a list of the given element type+  --+  -- This is part of a Haskell98 mechanism for special-casing 'String' to print+  -- differently from other lists; clients of the library can largely ignore+  -- it.+  portrayList :: [a] -> Portrayal+  portrayList = List . map portray++-- | Convenience for using 'show' and wrapping the result in 'Opaque'.+--+-- Note this will be excluded from syntax highlighting and layout; see the+-- cautionary text on 'ShowAtom'. showAtom :: Show a => a -> Portrayal showAtom = strAtom . show --- | Convenience for building an 'Atom' from a 'String'.+-- | Convenience for building an 'Opaque' from a 'String'. ----- Note if you just want a string literal, @OverloadedStrings@ is supported.+-- Note this will be excluded from syntax highlighting for lack of semantic+-- information; consider using 'Name' instead. strAtom :: String -> Portrayal-strAtom = Atom . T.pack+strAtom = Opaque . T.pack  -- | Convenience for building a 'Quot' from a 'String'. strQuot :: String -> Portrayal -> Portrayal strQuot = Quot . T.pack  -- | Convenience for building a 'Binop' with a 'String' operator name.-strBinop :: String -> Infixity -> Portrayal -> Portrayal -> Portrayal-strBinop = Binop . T.pack+strBinop+  :: IdentKind -> String -> Infixity -> Portrayal -> Portrayal -> Portrayal+strBinop k = Binop . Ident k . T.pack  -- | Generics-based deriving of 'Portray' for product types. --@@ -411,9 +483,17 @@ instance GPortrayProduct U1 where   gportrayProduct U1 = id +-- | Turn a field selector name into an 'Ident'.+selIdent :: String -> Ident+selIdent nm = Ident k (T.pack nm)+ where+  k = case nm of+    (c:_) | isAlpha c || c == '_' -> VarIdent+    _                             -> OpIdent+ instance (Selector s, Portray a) => GPortrayProduct (S1 s (K1 i a)) where   gportrayProduct (M1 (K1 x)) =-    (FactorPortrayal (T.pack $ selName @s undefined) (portray x) :)+    (FactorPortrayal (selIdent $ selName @s undefined) (portray x) :)  instance (GPortrayProduct f, GPortrayProduct g)       => GPortrayProduct (f :*: g) where@@ -436,9 +516,12 @@   gportray (L1 f) = gportray f   gportray (R1 g) = gportray g --- Wrap operator constructor names (which must start with a colon) in parens,--- for use in function application context.  This arises in four scenarios:+-- Detect operator constructor names (which must start with a colon) vs.+-- alphanumeric constructor names. --+-- Operator constructor names in prefix application context arise in four+-- scenarios:+-- -- - The constructor has fewer than two arguments: @(:%) :: Int -> Thing@ gives -- e.g. "(:%) 42". -- - The constructor has more than two arguments:@@ -448,17 +531,19 @@ -- - The constructor is declared in record notation: -- @data Thing = (:%) { _x :: Int, _y :: Int }@ gives e.g. -- "(:%) { _x = 2, _y = 4 }".-formatPrefixCon :: String -> String-formatPrefixCon (':' : rest) = "(:" ++ rest ++ ")"-formatPrefixCon con = con+--+-- Alphanumeric constructor names in infix application context only arise from+-- datatypes with alphanumeric constructors declared in infix syntax, e.g.+-- "data Thing = Int `Thing` Int".+detectConKind :: String -> IdentKind+detectConKind = \case (':':_) -> OpConIdent; _ -> ConIdent --- Wrap alphanumeric constructor names in backquotes, for use in infix operator--- context.  This only arises from datatypes with alphanumeric constructors--- declared in infix syntax, e.g. "data Thing = Int `Thing` Int".-formatInfixCon :: String -> String-formatInfixCon (':' : rest) = ':' : rest-formatInfixCon con = '`' : con ++ "`"+conIdent :: String -> Ident+conIdent con = Ident (detectConKind con) (T.pack con) +prefixCon :: String -> Portrayal+prefixCon = Name . conIdent+ toAssoc :: Associativity -> Assoc toAssoc = \case   LeftAssociative -> AssocL@@ -468,7 +553,7 @@ instance (KnownSymbol n, GPortrayProduct f)       => GPortray (C1 ('MetaCons n fx 'True) f) where   gportray (M1 x) = Record-    (strAtom (formatPrefixCon $ symbolVal' @n proxy#))+    (prefixCon $ symbolVal' @n proxy#)     (gportrayProduct x [])  instance (Constructor ('MetaCons n fx 'False), GPortrayProduct f)@@ -477,12 +562,12 @@     case (nm, conFixity @('MetaCons n fx 'False) undefined, args) of       ('(' : ',' : _, _, _) -> Tuple args       (_, Infix lr p, [x, y]) -> Binop-        (T.pack $ formatInfixCon nm)+        (conIdent nm)         (Infixity (toAssoc lr) (toRational p))         x         y-      (_, _, []) -> strAtom (formatPrefixCon nm)-      _ -> Apply (strAtom (formatPrefixCon nm)) args+      (_, _, []) -> prefixCon nm+      _ -> Apply (prefixCon nm) args    where     args = _fpPortrayal <$> gportrayProduct x0 []     nm = conName @('MetaCons n fx 'False) undefined@@ -490,35 +575,55 @@ instance (Generic a, GPortray (Rep a)) => Portray (Wrapped Generic a) where   portray (Wrapped x) = gportray (from x) +-- | A newtype wrapper providing a 'Portray' instance via 'Integral'.+newtype PortrayIntLit a = PortrayIntLit a++instance Integral a => Portray (PortrayIntLit a) where+  portray (PortrayIntLit x) = LitInt (toInteger x)++deriving via PortrayIntLit Int       instance Portray Int+deriving via PortrayIntLit Int8      instance Portray Int8+deriving via PortrayIntLit Int16     instance Portray Int16+deriving via PortrayIntLit Int32     instance Portray Int32+deriving via PortrayIntLit Int64     instance Portray Int64+deriving via PortrayIntLit Integer   instance Portray Integer++deriving via PortrayIntLit Word      instance Portray Word+deriving via PortrayIntLit Word8     instance Portray Word8+deriving via PortrayIntLit Word16    instance Portray Word16+deriving via PortrayIntLit Word32    instance Portray Word32+deriving via PortrayIntLit Word64    instance Portray Word64+deriving via PortrayIntLit Natural   instance Portray Natural++-- | A newtype wrapper providing a 'Portray' instance via 'Real'.+newtype PortrayRatLit a = PortrayRatLit a++instance Real a => Portray (PortrayRatLit a) where+  portray (PortrayRatLit x) = LitRat (toRational x)++deriving via PortrayRatLit Float     instance Portray Float+deriving via PortrayRatLit Double    instance Portray Double+ -- | A newtype wrapper providing a 'Portray' instance via 'showAtom'.+--+-- Beware that instances made this way will not be subject to syntax+-- highlighting or layout, and will be shown as plain text all on one line.+-- It's recommended to derive instances via @'Wrapped' 'Generic'@ or hand-write+-- more detailed instances instead. newtype ShowAtom a = ShowAtom { unShowAtom :: a }  instance Show a => Portray (ShowAtom a) where   portray = showAtom . unShowAtom -deriving via ShowAtom Int       instance Portray Int-deriving via ShowAtom Int8      instance Portray Int8-deriving via ShowAtom Int16     instance Portray Int16-deriving via ShowAtom Int32     instance Portray Int32-deriving via ShowAtom Int64     instance Portray Int64-deriving via ShowAtom Integer   instance Portray Integer--deriving via ShowAtom Word      instance Portray Word-deriving via ShowAtom Word8     instance Portray Word8-deriving via ShowAtom Word16    instance Portray Word16-deriving via ShowAtom Word32    instance Portray Word32-deriving via ShowAtom Word64    instance Portray Word64-deriving via ShowAtom Natural   instance Portray Natural+instance Portray Char where+  portray = LitChar+  portrayList = LitStr . T.pack -deriving via ShowAtom Float     instance Portray Float-deriving via ShowAtom Double    instance Portray Double-deriving via ShowAtom Char      instance Portray Char-deriving via ShowAtom Text      instance Portray Text-deriving via ShowAtom Bool      instance Portray Bool-deriving via ShowAtom ()        instance Portray ()+instance Portray () where portray () = Tuple []+instance Portray Text where portray = LitStr  instance Portray a => Portray (Ratio a) where-  portray x = Binop "%" (infixl_ 7)+  portray x = Binop (Ident OpIdent "%") (infixl_ 7)     (portray $ numerator x)     (portray $ denominator x) @@ -529,28 +634,36 @@ deriving via Wrapped Generic (a, b, c, d)   instance (Portray a, Portray b, Portray c, Portray d) => Portray (a, b, c, d) deriving via Wrapped Generic (a, b, c, d, e)-  instance (Portray a, Portray b, Portray c, Portray d, Portray e) => Portray (a, b, c, d, e)+  instance (Portray a, Portray b, Portray c, Portray d, Portray e)+        => Portray (a, b, c, d, e) deriving via Wrapped Generic (Maybe a)   instance Portray a => Portray (Maybe a) deriving via Wrapped Generic (Either a b)   instance (Portray a, Portray b) => Portray (Either a b) deriving via Wrapped Generic Void instance Portray Void+deriving via Wrapped Generic Bool instance Portray Bool  -- Aesthetic choice: I'd rather pretend Identity and Const are not records, so -- don't derive them via Generic. instance Portray a => Portray (Identity a) where-  portray (Identity x) = Apply "Identity" [portray x]+  portray (Identity x) = Apply (Name $ Ident ConIdent "Identity") [portray x] instance Portray a => Portray (Const a b) where-  portray (Const x) = Apply "Const" [portray x]+  portray (Const x) = Apply (Name $ Ident ConIdent "Const") [portray x]  instance Portray a => Portray [a] where-  portray = List . map portray+  portray = portrayList  deriving via Wrapped Generic (Proxy a) instance Portray (Proxy a)   instance Portray TyCon where-  portray = strAtom . formatPrefixCon . tyConName+  portray tc = case nm of+    -- For now, don't try to parse DataKinds embedded in fake constructor+    -- names; just stick them in Opaque.+    (c:_) | isDigit c || c `elem` ['\'', '"'] -> Opaque (T.pack nm)+    _ -> prefixCon nm+   where+    nm = tyConName tc  portraySomeType :: SomeTypeRep -> Portrayal portraySomeType (SomeTypeRep ty) = portrayType ty@@ -561,28 +674,30 @@ -- syntax that would construct the `TypeRep`. portrayType :: TypeRep a -> Portrayal portrayType = \case-  special-    | SomeTypeRep special == SomeTypeRep (typeRep @Type) -> "Type"-  Fun a b -> Binop (T.pack "->") (infixr_ (-1)) (portrayType a) (portrayType b)+  special | SomeTypeRep special == SomeTypeRep (typeRep @Type) ->+    Name $ Ident ConIdent "Type"+  Fun a b ->+    Binop (Ident OpIdent "->") (infixr_ (-1)) (portrayType a) (portrayType b)   -- TODO(awpr); it'd be nice to coalesce the resulting nested 'Apply's.   App f x -> Apply (portrayType f) [portrayType x]   Con' con tys -> foldl (\x -> TyApp x . portraySomeType) (portray con) tys  instance Portray (TypeRep a) where-  portray = TyApp "typeRep" . portrayType+  portray = TyApp (Name $ Ident VarIdent "typeRep") . portrayType  instance Portray SomeTypeRep where   portray (SomeTypeRep ty) = Apply-    (TyApp "SomeTypeRep" (portrayType ty))-    ["typeRep"]+    (TyApp (Name $ Ident ConIdent "SomeTypeRep") (portrayType ty))+    [Name $ Ident VarIdent "typeRep"] -instance Portray (a :~: b) where portray Refl = "Refl"-instance Portray (Coercion a b) where portray Coercion = "Coercion"+instance Portray (a :~: b) where portray Refl = Name $ Ident ConIdent "Refl"+instance Portray (Coercion a b) where+  portray Coercion = Name $ Ident ConIdent "Coercion"  -- | Portray a list-like type as "fromList [...]".-instance (IsList a, Portray (Exts.Item a))-      => Portray (Wrapped IsList a) where-  portray = Apply "fromList" . pure . portray . Exts.toList+instance (IsList a, Portray (Exts.Item a)) => Portray (Wrapped IsList a) where+  portray =+    Apply (Name $ Ident VarIdent "fromList") . pure . portray . Exts.toList  deriving via Wrapped IsList (IntMap a)   instance Portray a => Portray (IntMap a)@@ -601,7 +716,7 @@ -- | Construct a 'Portrayal' of a 'CallStack' without the "callStack" prefix. portrayCallStack :: [(String, SrcLoc)] -> Portrayal portrayCallStack xs = Unlines-  [ "GHC.Stack.CallStack:"+  [ Opaque "GHC.Stack.CallStack:"   , Nest 2 $ Unlines       [ strAtom (func ++ ", called at " ++ prettySrcLoc loc)       | (func, loc) <- xs@@ -610,7 +725,7 @@  instance Portray CallStack where   portray cs = case getCallStack cs of-    [] -> "emptyCallStack"+    [] -> Name $ Ident VarIdent "emptyCallStack"     xs -> strQuot "callStack" $ portrayCallStack xs  -- | Fold a @Fix f@ to @a@ given a function to collapse each layer.

@@ -22,6 +22,7 @@  import Data.List.NonEmpty (NonEmpty(..)) import Data.Text (Text)+import qualified Data.Text as T (pack) import Data.Void (Void) import GHC.Generics (Generic) import Type.Reflection (typeRep)@@ -60,80 +61,129 @@   deriving Generic   deriving Portray via Wrapped Generic InfixCon +sel :: String -> Ident+sel = Ident VarIdent . T.pack+ main :: IO () main = defaultMain   [ testGroup "atoms"-      [ testCase "portray @Int" $ portray @Int 0 @?= "0"-      , testCase "portray @Bool" $ portray True @?= "True"-      , testCase "portray @Float" $ portray @Float 0.0 @?= "0.0"-      , testCase "portray @Char" $ portray 'a' @?= "'a'"-      , testCase "portray @Text" $ portray @Text "aoeu" @?= "\"aoeu\""-      , testCase "portray @()" $ portray () @?= "()"+      [ testCase "portray @Int" $ portray @Int 0 @?= LitInt 0+      , testCase "portray @Bool" $ portray True @?= Name (Ident ConIdent "True")+      , testCase "portray @Float" $ portray @Float 0.0 @?= LitRat 0+      , testCase "portray @Char" $ portray 'a' @?= LitChar 'a'+      , testCase "portray @Text" $ portray @Text "aoeu" @?= LitStr "aoeu"+      , testCase "portray @()" $ portray () @?= Tuple []       ]    , testGroup "Maybe"-      [ testCase "portray Nothing" $ portray (Nothing @Int) @?= "Nothing"-      , testCase "portray Just" $ portray (Just ()) @?= Apply "Just" ["()"]+      [ testCase "portray Nothing" $+          portray (Nothing @Int) @?= Name (Ident ConIdent "Nothing")+      , testCase "portray Just" $+          portray (Just ()) @?= Apply (Name (Ident ConIdent "Just")) [Tuple []]       ] +  , testCase "portray String" $ portray ("aoeu" :: String) @?= LitStr "aoeu"+   , testCase "portray Void" $ const () (\x -> portray @Void x) @?= ()    , testGroup "tuples"-      [ testCase "portray (,)" $ portray ('a', 'b') @?= Tuple ["'a'", "'b'"]+      [ testCase "portray (,)" $+          portray ('a', 'b') @?= Tuple [LitChar 'a', LitChar 'b']       , testCase "portray (,,)" $-          portray ('a', 'b', 'c') @?= Tuple ["'a'", "'b'", "'c'"]+          portray ('a', 'b', 'c') @?=+            Tuple [LitChar 'a', LitChar 'b', LitChar 'c']       ]    , testGroup "reflection"       [ testCase "portray Int" $-          portray (typeRep @Int) @?= TyApp "typeRep" "Int"+          portray (typeRep @Int) @?=+            TyApp+              (Name (Ident VarIdent "typeRep"))+              (Name (Ident ConIdent "Int"))       , testCase "portray ->" $           portray (typeRep @(Int -> Int)) @?=-            TyApp "typeRep" (Binop "->" (infixr_ (-1)) "Int" "Int")+            TyApp+              (Name (Ident VarIdent "typeRep"))+              (Binop+                (Ident OpIdent "->")+                (infixr_ (-1))+                (Name (Ident ConIdent "Int"))+                (Name (Ident ConIdent "Int")))       , testCase "portray Either" $           portray (typeRep @(Either Bool Int)) @?=-            TyApp "typeRep" (Apply (Apply "Either" ["Bool"]) ["Int"])+            TyApp+              (Name (Ident VarIdent "typeRep"))+              (Apply+                (Apply+                  (Name (Ident ConIdent "Either"))+                  [Name (Ident ConIdent "Bool")])+                [Name (Ident ConIdent "Int")])       , testCase "portray DataKinds" $-          portray (typeRep @'True) @?= TyApp "typeRep" "'True"+          portray (typeRep @'True) @?=+            TyApp+              (Name (Ident VarIdent "typeRep"))+              (Opaque "'True")       , testCase "portray TypeNats" $-          portray (typeRep @4) @?= TyApp "typeRep" "4"+          portray (typeRep @4) @?=+            TyApp (Name (Ident VarIdent "typeRep")) (Opaque "4")       , testCase "portray Symbol" $-          portray (typeRep @"hi") @?= TyApp "typeRep" "\"hi\""+          portray (typeRep @"hi") @?=+            TyApp (Name (Ident VarIdent "typeRep")) (Opaque "\"hi\"")       ]    , testGroup "lists"       [ testCase "portray []" $ portray @[()] [] @?= List []-      , testCase "portray [True]" $ portray [True] @?= List ["True"]+      , testCase "portray [True]" $+          portray [True] @?= List [Name (Ident ConIdent "True")]       ]    , testGroup "IsList"       [ testCase "portray NonEmpty" $           portray (True :| [False]) @?=-            Apply "fromList" [List ["True", "False"]]+            Apply (Name (Ident VarIdent "fromList"))+            [List+               [ Name (Ident ConIdent "True")+               , Name (Ident ConIdent "False")+               ]]       ]    , testGroup "Generic"       [ testCase "portray NormalCon" $-          portray (NormalCon 2 True) @?= Apply "NormalCon" ["2", "True"]+          portray (NormalCon 2 True) @?=+            Apply+              (Name (Ident ConIdent "NormalCon"))+              [LitInt 2, Name (Ident ConIdent "True")]       , testCase "portray InfixOperatorCon" $-          portray (2 :? True) @?= Binop ":?" (infixl_ 5) "2" "True"+          portray (2 :? True) @?=+            Binop+              (Ident OpConIdent ":?")+              (infixl_ 5)+              (LitInt 2)+              (Name (Ident ConIdent "True"))       , testCase "portray PrefixOperatorCon" $-          portray (2 :?? True) @?= Apply "(:??)" ["2", "True"]+          portray (2 :?? True) @?=+            Apply+              (Name (Ident OpConIdent ":??"))+              [LitInt 2, Name (Ident ConIdent "True")]       , testCase "portray RecordCon" $           portray (RecordCon 2 True) @?=-            Record "RecordCon"-              [ FactorPortrayal "_rcInt" "2"-              , FactorPortrayal "_rcBool" "True"+            Record (Name (Ident ConIdent "RecordCon"))+              [ FactorPortrayal (sel "_rcInt") (LitInt 2)+              , FactorPortrayal (sel "_rcBool") (Name (Ident ConIdent "True"))               ]       , testCase "portray OperatorRecordCon" $           portray (2 :??? True) @?=-            Record "(:???)"-              [ FactorPortrayal "_orcInt" "2"-              , FactorPortrayal "_orcBool" "True"+            Record (Name (Ident OpConIdent ":???"))+              [ FactorPortrayal (sel "_orcInt") (LitInt 2)+              , FactorPortrayal (sel "_orcBool") (Name (Ident ConIdent "True"))               ]       , testCase "portray InfixCon" $           portray (InfixCon 2 True) @?=-            Binop "`InfixCon`" (infixl_ 9) "2" "True"+            Binop+              (Ident ConIdent "InfixCon")+              (infixl_ 9)+              (LitInt 2)+              (Name (Ident ConIdent "True"))       -- Covered basic sum types and nullary constructors with Maybe and Void.       ]   ]