-- Copyright 2020-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 a compatibility layer of Haskell-like terms for pretty-printers.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

module Data.Portray
         ( -- * Syntax Tree
           Portrayal
             ( Atom, Apply, Binop, Tuple, List
             , LambdaCase, Record, TyApp, TySig
             , Quot, Unlines, Nest
             , ..
             )
         , FactorPortrayal(..)
           -- ** Operator Fixity
         , Assoc(..), Infixity(..), infix_, infixl_, infixr_
           -- ** Base Functor
         , PortrayalF(..)
           -- * Class
         , Portray(..)
           -- ** Via Show
         , ShowAtom(..)
           -- ** Via Generic
         , GPortray(..), GPortrayProduct(..)
           -- * Convenience
         , showAtom, strAtom, strQuot, strBinop
           -- * Miscellaneous
         , Fix(..), cata, portrayCallStack, portrayType
         ) where

import Data.Coerce (Coercible, coerce)
import Data.Functor.Identity (Identity(..))
import Data.Functor.Const (Const(..))
import Data.Int (Int8, Int16, Int32, Int64)
import Data.IntMap (IntMap)
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Proxy (Proxy)
import Data.Ratio (Ratio, numerator, denominator)
import Data.Sequence (Seq)
import Data.Set (Set)
import Data.String (IsString(..))
import Data.Text (Text)
import Data.Type.Coercion (Coercion(..))
import Data.Type.Equality ((:~:)(..))
import Data.Void (Void)
import Data.Word (Word8, Word16, Word32, Word64)
import qualified Data.Text as T
import GHC.Exts (IsList, proxy#)
import qualified GHC.Exts as Exts
import GHC.Generics
         ( (:*:)(..), (:+:)(..)
         , Generic(..), Rep
         , U1(..), K1(..), M1(..), V1
         , Meta(..), D1, C1, S1
         , Constructor, conName, conFixity
         , Selector, selName
         , Fixity(..), Associativity(..)
         )
import GHC.Stack (CallStack, SrcLoc, getCallStack, prettySrcLoc)
import GHC.TypeLits (KnownSymbol, symbolVal')
import Numeric.Natural (Natural)
import Type.Reflection
         ( TyCon, TypeRep, SomeTypeRep(..)
         , pattern App, pattern Con', pattern Fun
         , tyConName, typeRep
         )

import Data.Wrapped (Wrapped(..))

-- | Associativity of an infix operator.
data Assoc = AssocL | AssocR | AssocNope
  deriving (ReadPrec [Assoc]
ReadPrec Assoc
Int -> ReadS Assoc
ReadS [Assoc]
(Int -> ReadS Assoc)
-> ReadS [Assoc]
-> ReadPrec Assoc
-> ReadPrec [Assoc]
-> Read Assoc
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Assoc]
$creadListPrec :: ReadPrec [Assoc]
readPrec :: ReadPrec Assoc
$creadPrec :: ReadPrec Assoc
readList :: ReadS [Assoc]
$creadList :: ReadS [Assoc]
readsPrec :: Int -> ReadS Assoc
$creadsPrec :: Int -> ReadS Assoc
Read, Int -> Assoc -> ShowS
[Assoc] -> ShowS
Assoc -> String
(Int -> Assoc -> ShowS)
-> (Assoc -> String) -> ([Assoc] -> ShowS) -> Show Assoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assoc] -> ShowS
$cshowList :: [Assoc] -> ShowS
show :: Assoc -> String
$cshow :: Assoc -> String
showsPrec :: Int -> Assoc -> ShowS
$cshowsPrec :: Int -> Assoc -> ShowS
Show, Assoc -> Assoc -> Bool
(Assoc -> Assoc -> Bool) -> (Assoc -> Assoc -> Bool) -> Eq Assoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assoc -> Assoc -> Bool
$c/= :: Assoc -> Assoc -> Bool
== :: Assoc -> Assoc -> Bool
$c== :: Assoc -> Assoc -> Bool
Eq, Eq Assoc
Eq Assoc
-> (Assoc -> Assoc -> Ordering)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Assoc)
-> (Assoc -> Assoc -> Assoc)
-> Ord Assoc
Assoc -> Assoc -> Bool
Assoc -> Assoc -> Ordering
Assoc -> Assoc -> Assoc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Assoc -> Assoc -> Assoc
$cmin :: Assoc -> Assoc -> Assoc
max :: Assoc -> Assoc -> Assoc
$cmax :: Assoc -> Assoc -> Assoc
>= :: Assoc -> Assoc -> Bool
$c>= :: Assoc -> Assoc -> Bool
> :: Assoc -> Assoc -> Bool
$c> :: Assoc -> Assoc -> Bool
<= :: Assoc -> Assoc -> Bool
$c<= :: Assoc -> Assoc -> Bool
< :: Assoc -> Assoc -> Bool
$c< :: Assoc -> Assoc -> Bool
compare :: Assoc -> Assoc -> Ordering
$ccompare :: Assoc -> Assoc -> Ordering
$cp1Ord :: Eq Assoc
Ord, (forall x. Assoc -> Rep Assoc x)
-> (forall x. Rep Assoc x -> Assoc) -> Generic Assoc
forall x. Rep Assoc x -> Assoc
forall x. Assoc -> Rep Assoc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Assoc x -> Assoc
$cfrom :: forall x. Assoc -> Rep Assoc x
Generic)
  deriving Assoc -> Portrayal
(Assoc -> Portrayal) -> Portray Assoc
forall a. (a -> Portrayal) -> Portray a
portray :: Assoc -> Portrayal
$cportray :: Assoc -> Portrayal
Portray via Wrapped Generic Assoc

-- | Associativity and binding precedence of an infix operator.
data Infixity = Infixity !Assoc !Rational
  deriving (ReadPrec [Infixity]
ReadPrec Infixity
Int -> ReadS Infixity
ReadS [Infixity]
(Int -> ReadS Infixity)
-> ReadS [Infixity]
-> ReadPrec Infixity
-> ReadPrec [Infixity]
-> Read Infixity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Infixity]
$creadListPrec :: ReadPrec [Infixity]
readPrec :: ReadPrec Infixity
$creadPrec :: ReadPrec Infixity
readList :: ReadS [Infixity]
$creadList :: ReadS [Infixity]
readsPrec :: Int -> ReadS Infixity
$creadsPrec :: Int -> ReadS Infixity
Read, Int -> Infixity -> ShowS
[Infixity] -> ShowS
Infixity -> String
(Int -> Infixity -> ShowS)
-> (Infixity -> String) -> ([Infixity] -> ShowS) -> Show Infixity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Infixity] -> ShowS
$cshowList :: [Infixity] -> ShowS
show :: Infixity -> String
$cshow :: Infixity -> String
showsPrec :: Int -> Infixity -> ShowS
$cshowsPrec :: Int -> Infixity -> ShowS
Show, Infixity -> Infixity -> Bool
(Infixity -> Infixity -> Bool)
-> (Infixity -> Infixity -> Bool) -> Eq Infixity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Infixity -> Infixity -> Bool
$c/= :: Infixity -> Infixity -> Bool
== :: Infixity -> Infixity -> Bool
$c== :: Infixity -> Infixity -> Bool
Eq, Eq Infixity
Eq Infixity
-> (Infixity -> Infixity -> Ordering)
-> (Infixity -> Infixity -> Bool)
-> (Infixity -> Infixity -> Bool)
-> (Infixity -> Infixity -> Bool)
-> (Infixity -> Infixity -> Bool)
-> (Infixity -> Infixity -> Infixity)
-> (Infixity -> Infixity -> Infixity)
-> Ord Infixity
Infixity -> Infixity -> Bool
Infixity -> Infixity -> Ordering
Infixity -> Infixity -> Infixity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Infixity -> Infixity -> Infixity
$cmin :: Infixity -> Infixity -> Infixity
max :: Infixity -> Infixity -> Infixity
$cmax :: Infixity -> Infixity -> Infixity
>= :: Infixity -> Infixity -> Bool
$c>= :: Infixity -> Infixity -> Bool
> :: Infixity -> Infixity -> Bool
$c> :: Infixity -> Infixity -> Bool
<= :: Infixity -> Infixity -> Bool
$c<= :: Infixity -> Infixity -> Bool
< :: Infixity -> Infixity -> Bool
$c< :: Infixity -> Infixity -> Bool
compare :: Infixity -> Infixity -> Ordering
$ccompare :: Infixity -> Infixity -> Ordering
$cp1Ord :: Eq Infixity
Ord, (forall x. Infixity -> Rep Infixity x)
-> (forall x. Rep Infixity x -> Infixity) -> Generic Infixity
forall x. Rep Infixity x -> Infixity
forall x. Infixity -> Rep Infixity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Infixity x -> Infixity
$cfrom :: forall x. Infixity -> Rep Infixity x
Generic)
  deriving Infixity -> Portrayal
(Infixity -> Portrayal) -> Portray Infixity
forall a. (a -> Portrayal) -> Portray a
portray :: Infixity -> Portrayal
$cportray :: Infixity -> Portrayal
Portray via Wrapped Generic Infixity

-- | Construct the 'Infixity' corresponding to e.g. @infix 6 +&&+*@
infix_ :: Rational -> Infixity
infix_ :: Rational -> Infixity
infix_ = Assoc -> Rational -> Infixity
Infixity Assoc
AssocNope

-- | Construct the 'Infixity' corresponding to e.g. @infixl 6 +&&+*@
infixl_ :: Rational -> Infixity
infixl_ :: Rational -> Infixity
infixl_ = Assoc -> Rational -> Infixity
Infixity Assoc
AssocL

-- | Construct the 'Infixity' corresponding to e.g. @infixr 6 +&&+*@
infixr_ :: Rational -> Infixity
infixr_ :: Rational -> Infixity
infixr_ = Assoc -> Rational -> Infixity
Infixity Assoc
AssocR

-- | A single level of pseudo-Haskell expression; used to define 'Portrayal'.
data PortrayalF a
  = AtomF !Text
    -- ^ Render this text directly.
  | ApplyF !a [a]
    -- ^ Render a function application to several arguments.
  | BinopF !Text !Infixity !a !a
    -- ^ Render a binary infix operator application to two arguments.
  | TupleF [a]
    -- ^ Render a tuple of sub-values.
  | ListF [a]
    -- ^ Render a list of sub-values.
  | LambdaCaseF [(a, a)]
    -- ^ Render a lambda-case expression.
  | RecordF !a [FactorPortrayal a]
    -- ^ Render a record construction/update syntax.
  | TyAppF !a !a
    -- ^ Render a TypeApplication.
  | TySigF !a !a
    -- ^ Render a term with explicit type signature.
  | QuotF !Text !a
    -- ^ Render a quasiquoter term with the given name.
  | UnlinesF [a]
    -- ^ Render a collection of vertically-aligned lines
  | NestF !Int !a
    -- ^ Indent the subdocument by the given number of columns.
  deriving (PortrayalF a -> PortrayalF a -> Bool
(PortrayalF a -> PortrayalF a -> Bool)
-> (PortrayalF a -> PortrayalF a -> Bool) -> Eq (PortrayalF a)
forall a. Eq a => PortrayalF a -> PortrayalF a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PortrayalF a -> PortrayalF a -> Bool
$c/= :: forall a. Eq a => PortrayalF a -> PortrayalF a -> Bool
== :: PortrayalF a -> PortrayalF a -> Bool
$c== :: forall a. Eq a => PortrayalF a -> PortrayalF a -> Bool
Eq, Eq (PortrayalF a)
Eq (PortrayalF a)
-> (PortrayalF a -> PortrayalF a -> Ordering)
-> (PortrayalF a -> PortrayalF a -> Bool)
-> (PortrayalF a -> PortrayalF a -> Bool)
-> (PortrayalF a -> PortrayalF a -> Bool)
-> (PortrayalF a -> PortrayalF a -> Bool)
-> (PortrayalF a -> PortrayalF a -> PortrayalF a)
-> (PortrayalF a -> PortrayalF a -> PortrayalF a)
-> Ord (PortrayalF a)
PortrayalF a -> PortrayalF a -> Bool
PortrayalF a -> PortrayalF a -> Ordering
PortrayalF a -> PortrayalF a -> PortrayalF a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (PortrayalF a)
forall a. Ord a => PortrayalF a -> PortrayalF a -> Bool
forall a. Ord a => PortrayalF a -> PortrayalF a -> Ordering
forall a. Ord a => PortrayalF a -> PortrayalF a -> PortrayalF a
min :: PortrayalF a -> PortrayalF a -> PortrayalF a
$cmin :: forall a. Ord a => PortrayalF a -> PortrayalF a -> PortrayalF a
max :: PortrayalF a -> PortrayalF a -> PortrayalF a
$cmax :: forall a. Ord a => PortrayalF a -> PortrayalF a -> PortrayalF a
>= :: PortrayalF a -> PortrayalF a -> Bool
$c>= :: forall a. Ord a => PortrayalF a -> PortrayalF a -> Bool
> :: PortrayalF a -> PortrayalF a -> Bool
$c> :: forall a. Ord a => PortrayalF a -> PortrayalF a -> Bool
<= :: PortrayalF a -> PortrayalF a -> Bool
$c<= :: forall a. Ord a => PortrayalF a -> PortrayalF a -> Bool
< :: PortrayalF a -> PortrayalF a -> Bool
$c< :: forall a. Ord a => PortrayalF a -> PortrayalF a -> Bool
compare :: PortrayalF a -> PortrayalF a -> Ordering
$ccompare :: forall a. Ord a => PortrayalF a -> PortrayalF a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (PortrayalF a)
Ord, ReadPrec [PortrayalF a]
ReadPrec (PortrayalF a)
Int -> ReadS (PortrayalF a)
ReadS [PortrayalF a]
(Int -> ReadS (PortrayalF a))
-> ReadS [PortrayalF a]
-> ReadPrec (PortrayalF a)
-> ReadPrec [PortrayalF a]
-> Read (PortrayalF a)
forall a. Read a => ReadPrec [PortrayalF a]
forall a. Read a => ReadPrec (PortrayalF a)
forall a. Read a => Int -> ReadS (PortrayalF a)
forall a. Read a => ReadS [PortrayalF a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PortrayalF a]
$creadListPrec :: forall a. Read a => ReadPrec [PortrayalF a]
readPrec :: ReadPrec (PortrayalF a)
$creadPrec :: forall a. Read a => ReadPrec (PortrayalF a)
readList :: ReadS [PortrayalF a]
$creadList :: forall a. Read a => ReadS [PortrayalF a]
readsPrec :: Int -> ReadS (PortrayalF a)
$creadsPrec :: forall a. Read a => Int -> ReadS (PortrayalF a)
Read, Int -> PortrayalF a -> ShowS
[PortrayalF a] -> ShowS
PortrayalF a -> String
(Int -> PortrayalF a -> ShowS)
-> (PortrayalF a -> String)
-> ([PortrayalF a] -> ShowS)
-> Show (PortrayalF a)
forall a. Show a => Int -> PortrayalF a -> ShowS
forall a. Show a => [PortrayalF a] -> ShowS
forall a. Show a => PortrayalF a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PortrayalF a] -> ShowS
$cshowList :: forall a. Show a => [PortrayalF a] -> ShowS
show :: PortrayalF a -> String
$cshow :: forall a. Show a => PortrayalF a -> String
showsPrec :: Int -> PortrayalF a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PortrayalF a -> ShowS
Show, a -> PortrayalF b -> PortrayalF a
(a -> b) -> PortrayalF a -> PortrayalF b
(forall a b. (a -> b) -> PortrayalF a -> PortrayalF b)
-> (forall a b. a -> PortrayalF b -> PortrayalF a)
-> Functor PortrayalF
forall a b. a -> PortrayalF b -> PortrayalF a
forall a b. (a -> b) -> PortrayalF a -> PortrayalF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PortrayalF b -> PortrayalF a
$c<$ :: forall a b. a -> PortrayalF b -> PortrayalF a
fmap :: (a -> b) -> PortrayalF a -> PortrayalF b
$cfmap :: forall a b. (a -> b) -> PortrayalF a -> PortrayalF b
Functor, PortrayalF a -> Bool
(a -> m) -> PortrayalF a -> m
(a -> b -> b) -> b -> PortrayalF a -> b
(forall m. Monoid m => PortrayalF m -> m)
-> (forall m a. Monoid m => (a -> m) -> PortrayalF a -> m)
-> (forall m a. Monoid m => (a -> m) -> PortrayalF a -> m)
-> (forall a b. (a -> b -> b) -> b -> PortrayalF a -> b)
-> (forall a b. (a -> b -> b) -> b -> PortrayalF a -> b)
-> (forall b a. (b -> a -> b) -> b -> PortrayalF a -> b)
-> (forall b a. (b -> a -> b) -> b -> PortrayalF a -> b)
-> (forall a. (a -> a -> a) -> PortrayalF a -> a)
-> (forall a. (a -> a -> a) -> PortrayalF a -> a)
-> (forall a. PortrayalF a -> [a])
-> (forall a. PortrayalF a -> Bool)
-> (forall a. PortrayalF a -> Int)
-> (forall a. Eq a => a -> PortrayalF a -> Bool)
-> (forall a. Ord a => PortrayalF a -> a)
-> (forall a. Ord a => PortrayalF a -> a)
-> (forall a. Num a => PortrayalF a -> a)
-> (forall a. Num a => PortrayalF a -> a)
-> Foldable PortrayalF
forall a. Eq a => a -> PortrayalF a -> Bool
forall a. Num a => PortrayalF a -> a
forall a. Ord a => PortrayalF a -> a
forall m. Monoid m => PortrayalF m -> m
forall a. PortrayalF a -> Bool
forall a. PortrayalF a -> Int
forall a. PortrayalF a -> [a]
forall a. (a -> a -> a) -> PortrayalF a -> a
forall m a. Monoid m => (a -> m) -> PortrayalF a -> m
forall b a. (b -> a -> b) -> b -> PortrayalF a -> b
forall a b. (a -> b -> b) -> b -> PortrayalF a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: PortrayalF a -> a
$cproduct :: forall a. Num a => PortrayalF a -> a
sum :: PortrayalF a -> a
$csum :: forall a. Num a => PortrayalF a -> a
minimum :: PortrayalF a -> a
$cminimum :: forall a. Ord a => PortrayalF a -> a
maximum :: PortrayalF a -> a
$cmaximum :: forall a. Ord a => PortrayalF a -> a
elem :: a -> PortrayalF a -> Bool
$celem :: forall a. Eq a => a -> PortrayalF a -> Bool
length :: PortrayalF a -> Int
$clength :: forall a. PortrayalF a -> Int
null :: PortrayalF a -> Bool
$cnull :: forall a. PortrayalF a -> Bool
toList :: PortrayalF a -> [a]
$ctoList :: forall a. PortrayalF a -> [a]
foldl1 :: (a -> a -> a) -> PortrayalF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PortrayalF a -> a
foldr1 :: (a -> a -> a) -> PortrayalF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> PortrayalF a -> a
foldl' :: (b -> a -> b) -> b -> PortrayalF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> PortrayalF a -> b
foldl :: (b -> a -> b) -> b -> PortrayalF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> PortrayalF a -> b
foldr' :: (a -> b -> b) -> b -> PortrayalF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> PortrayalF a -> b
foldr :: (a -> b -> b) -> b -> PortrayalF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> PortrayalF a -> b
foldMap' :: (a -> m) -> PortrayalF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> PortrayalF a -> m
foldMap :: (a -> m) -> PortrayalF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> PortrayalF a -> m
fold :: PortrayalF m -> m
$cfold :: forall m. Monoid m => PortrayalF m -> m
Foldable, Functor PortrayalF
Foldable PortrayalF
Functor PortrayalF
-> Foldable PortrayalF
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> PortrayalF a -> f (PortrayalF b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    PortrayalF (f a) -> f (PortrayalF a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> PortrayalF a -> m (PortrayalF b))
-> (forall (m :: * -> *) a.
    Monad m =>
    PortrayalF (m a) -> m (PortrayalF a))
-> Traversable PortrayalF
(a -> f b) -> PortrayalF a -> f (PortrayalF b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
PortrayalF (m a) -> m (PortrayalF a)
forall (f :: * -> *) a.
Applicative f =>
PortrayalF (f a) -> f (PortrayalF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PortrayalF a -> m (PortrayalF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PortrayalF a -> f (PortrayalF b)
sequence :: PortrayalF (m a) -> m (PortrayalF a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
PortrayalF (m a) -> m (PortrayalF a)
mapM :: (a -> m b) -> PortrayalF a -> m (PortrayalF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PortrayalF a -> m (PortrayalF b)
sequenceA :: PortrayalF (f a) -> f (PortrayalF a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PortrayalF (f a) -> f (PortrayalF a)
traverse :: (a -> f b) -> PortrayalF a -> f (PortrayalF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PortrayalF a -> f (PortrayalF b)
$cp2Traversable :: Foldable PortrayalF
$cp1Traversable :: Functor PortrayalF
Traversable, (forall x. PortrayalF a -> Rep (PortrayalF a) x)
-> (forall x. Rep (PortrayalF a) x -> PortrayalF a)
-> Generic (PortrayalF a)
forall x. Rep (PortrayalF a) x -> PortrayalF a
forall x. PortrayalF a -> Rep (PortrayalF a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PortrayalF a) x -> PortrayalF a
forall a x. PortrayalF a -> Rep (PortrayalF a) x
$cto :: forall a x. Rep (PortrayalF a) x -> PortrayalF a
$cfrom :: forall a x. PortrayalF a -> Rep (PortrayalF a) x
Generic)
  deriving PortrayalF a -> Portrayal
(PortrayalF a -> Portrayal) -> Portray (PortrayalF a)
forall a. Portray a => PortrayalF a -> Portrayal
forall a. (a -> Portrayal) -> Portray a
portray :: PortrayalF a -> Portrayal
$cportray :: forall a. Portray a => PortrayalF a -> Portrayal
Portray via Wrapped Generic (PortrayalF a)

instance IsString (PortrayalF a) where fromString :: String -> PortrayalF a
fromString = Text -> PortrayalF a
forall a. Text -> PortrayalF a
AtomF (Text -> PortrayalF a)
-> (String -> Text) -> String -> PortrayalF a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | A 'Portrayal' along with a field name; one piece of a record literal.
data FactorPortrayal a = FactorPortrayal
  { FactorPortrayal a -> Text
_fpFieldName :: !Text
  , FactorPortrayal a -> a
_fpPortrayal :: !a
  }
  deriving (FactorPortrayal a -> FactorPortrayal a -> Bool
(FactorPortrayal a -> FactorPortrayal a -> Bool)
-> (FactorPortrayal a -> FactorPortrayal a -> Bool)
-> Eq (FactorPortrayal a)
forall a. Eq a => FactorPortrayal a -> FactorPortrayal a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FactorPortrayal a -> FactorPortrayal a -> Bool
$c/= :: forall a. Eq a => FactorPortrayal a -> FactorPortrayal a -> Bool
== :: FactorPortrayal a -> FactorPortrayal a -> Bool
$c== :: forall a. Eq a => FactorPortrayal a -> FactorPortrayal a -> Bool
Eq, Eq (FactorPortrayal a)
Eq (FactorPortrayal a)
-> (FactorPortrayal a -> FactorPortrayal a -> Ordering)
-> (FactorPortrayal a -> FactorPortrayal a -> Bool)
-> (FactorPortrayal a -> FactorPortrayal a -> Bool)
-> (FactorPortrayal a -> FactorPortrayal a -> Bool)
-> (FactorPortrayal a -> FactorPortrayal a -> Bool)
-> (FactorPortrayal a -> FactorPortrayal a -> FactorPortrayal a)
-> (FactorPortrayal a -> FactorPortrayal a -> FactorPortrayal a)
-> Ord (FactorPortrayal a)
FactorPortrayal a -> FactorPortrayal a -> Bool
FactorPortrayal a -> FactorPortrayal a -> Ordering
FactorPortrayal a -> FactorPortrayal a -> FactorPortrayal a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (FactorPortrayal a)
forall a. Ord a => FactorPortrayal a -> FactorPortrayal a -> Bool
forall a.
Ord a =>
FactorPortrayal a -> FactorPortrayal a -> Ordering
forall a.
Ord a =>
FactorPortrayal a -> FactorPortrayal a -> FactorPortrayal a
min :: FactorPortrayal a -> FactorPortrayal a -> FactorPortrayal a
$cmin :: forall a.
Ord a =>
FactorPortrayal a -> FactorPortrayal a -> FactorPortrayal a
max :: FactorPortrayal a -> FactorPortrayal a -> FactorPortrayal a
$cmax :: forall a.
Ord a =>
FactorPortrayal a -> FactorPortrayal a -> FactorPortrayal a
>= :: FactorPortrayal a -> FactorPortrayal a -> Bool
$c>= :: forall a. Ord a => FactorPortrayal a -> FactorPortrayal a -> Bool
> :: FactorPortrayal a -> FactorPortrayal a -> Bool
$c> :: forall a. Ord a => FactorPortrayal a -> FactorPortrayal a -> Bool
<= :: FactorPortrayal a -> FactorPortrayal a -> Bool
$c<= :: forall a. Ord a => FactorPortrayal a -> FactorPortrayal a -> Bool
< :: FactorPortrayal a -> FactorPortrayal a -> Bool
$c< :: forall a. Ord a => FactorPortrayal a -> FactorPortrayal a -> Bool
compare :: FactorPortrayal a -> FactorPortrayal a -> Ordering
$ccompare :: forall a.
Ord a =>
FactorPortrayal a -> FactorPortrayal a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (FactorPortrayal a)
Ord, ReadPrec [FactorPortrayal a]
ReadPrec (FactorPortrayal a)
Int -> ReadS (FactorPortrayal a)
ReadS [FactorPortrayal a]
(Int -> ReadS (FactorPortrayal a))
-> ReadS [FactorPortrayal a]
-> ReadPrec (FactorPortrayal a)
-> ReadPrec [FactorPortrayal a]
-> Read (FactorPortrayal a)
forall a. Read a => ReadPrec [FactorPortrayal a]
forall a. Read a => ReadPrec (FactorPortrayal a)
forall a. Read a => Int -> ReadS (FactorPortrayal a)
forall a. Read a => ReadS [FactorPortrayal a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FactorPortrayal a]
$creadListPrec :: forall a. Read a => ReadPrec [FactorPortrayal a]
readPrec :: ReadPrec (FactorPortrayal a)
$creadPrec :: forall a. Read a => ReadPrec (FactorPortrayal a)
readList :: ReadS [FactorPortrayal a]
$creadList :: forall a. Read a => ReadS [FactorPortrayal a]
readsPrec :: Int -> ReadS (FactorPortrayal a)
$creadsPrec :: forall a. Read a => Int -> ReadS (FactorPortrayal a)
Read, Int -> FactorPortrayal a -> ShowS
[FactorPortrayal a] -> ShowS
FactorPortrayal a -> String
(Int -> FactorPortrayal a -> ShowS)
-> (FactorPortrayal a -> String)
-> ([FactorPortrayal a] -> ShowS)
-> Show (FactorPortrayal a)
forall a. Show a => Int -> FactorPortrayal a -> ShowS
forall a. Show a => [FactorPortrayal a] -> ShowS
forall a. Show a => FactorPortrayal a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FactorPortrayal a] -> ShowS
$cshowList :: forall a. Show a => [FactorPortrayal a] -> ShowS
show :: FactorPortrayal a -> String
$cshow :: forall a. Show a => FactorPortrayal a -> String
showsPrec :: Int -> FactorPortrayal a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FactorPortrayal a -> ShowS
Show, a -> FactorPortrayal b -> FactorPortrayal a
(a -> b) -> FactorPortrayal a -> FactorPortrayal b
(forall a b. (a -> b) -> FactorPortrayal a -> FactorPortrayal b)
-> (forall a b. a -> FactorPortrayal b -> FactorPortrayal a)
-> Functor FactorPortrayal
forall a b. a -> FactorPortrayal b -> FactorPortrayal a
forall a b. (a -> b) -> FactorPortrayal a -> FactorPortrayal b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FactorPortrayal b -> FactorPortrayal a
$c<$ :: forall a b. a -> FactorPortrayal b -> FactorPortrayal a
fmap :: (a -> b) -> FactorPortrayal a -> FactorPortrayal b
$cfmap :: forall a b. (a -> b) -> FactorPortrayal a -> FactorPortrayal b
Functor, FactorPortrayal a -> Bool
(a -> m) -> FactorPortrayal a -> m
(a -> b -> b) -> b -> FactorPortrayal a -> b
(forall m. Monoid m => FactorPortrayal m -> m)
-> (forall m a. Monoid m => (a -> m) -> FactorPortrayal a -> m)
-> (forall m a. Monoid m => (a -> m) -> FactorPortrayal a -> m)
-> (forall a b. (a -> b -> b) -> b -> FactorPortrayal a -> b)
-> (forall a b. (a -> b -> b) -> b -> FactorPortrayal a -> b)
-> (forall b a. (b -> a -> b) -> b -> FactorPortrayal a -> b)
-> (forall b a. (b -> a -> b) -> b -> FactorPortrayal a -> b)
-> (forall a. (a -> a -> a) -> FactorPortrayal a -> a)
-> (forall a. (a -> a -> a) -> FactorPortrayal a -> a)
-> (forall a. FactorPortrayal a -> [a])
-> (forall a. FactorPortrayal a -> Bool)
-> (forall a. FactorPortrayal a -> Int)
-> (forall a. Eq a => a -> FactorPortrayal a -> Bool)
-> (forall a. Ord a => FactorPortrayal a -> a)
-> (forall a. Ord a => FactorPortrayal a -> a)
-> (forall a. Num a => FactorPortrayal a -> a)
-> (forall a. Num a => FactorPortrayal a -> a)
-> Foldable FactorPortrayal
forall a. Eq a => a -> FactorPortrayal a -> Bool
forall a. Num a => FactorPortrayal a -> a
forall a. Ord a => FactorPortrayal a -> a
forall m. Monoid m => FactorPortrayal m -> m
forall a. FactorPortrayal a -> Bool
forall a. FactorPortrayal a -> Int
forall a. FactorPortrayal a -> [a]
forall a. (a -> a -> a) -> FactorPortrayal a -> a
forall m a. Monoid m => (a -> m) -> FactorPortrayal a -> m
forall b a. (b -> a -> b) -> b -> FactorPortrayal a -> b
forall a b. (a -> b -> b) -> b -> FactorPortrayal a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: FactorPortrayal a -> a
$cproduct :: forall a. Num a => FactorPortrayal a -> a
sum :: FactorPortrayal a -> a
$csum :: forall a. Num a => FactorPortrayal a -> a
minimum :: FactorPortrayal a -> a
$cminimum :: forall a. Ord a => FactorPortrayal a -> a
maximum :: FactorPortrayal a -> a
$cmaximum :: forall a. Ord a => FactorPortrayal a -> a
elem :: a -> FactorPortrayal a -> Bool
$celem :: forall a. Eq a => a -> FactorPortrayal a -> Bool
length :: FactorPortrayal a -> Int
$clength :: forall a. FactorPortrayal a -> Int
null :: FactorPortrayal a -> Bool
$cnull :: forall a. FactorPortrayal a -> Bool
toList :: FactorPortrayal a -> [a]
$ctoList :: forall a. FactorPortrayal a -> [a]
foldl1 :: (a -> a -> a) -> FactorPortrayal a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> FactorPortrayal a -> a
foldr1 :: (a -> a -> a) -> FactorPortrayal a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> FactorPortrayal a -> a
foldl' :: (b -> a -> b) -> b -> FactorPortrayal a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> FactorPortrayal a -> b
foldl :: (b -> a -> b) -> b -> FactorPortrayal a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> FactorPortrayal a -> b
foldr' :: (a -> b -> b) -> b -> FactorPortrayal a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> FactorPortrayal a -> b
foldr :: (a -> b -> b) -> b -> FactorPortrayal a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> FactorPortrayal a -> b
foldMap' :: (a -> m) -> FactorPortrayal a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> FactorPortrayal a -> m
foldMap :: (a -> m) -> FactorPortrayal a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> FactorPortrayal a -> m
fold :: FactorPortrayal m -> m
$cfold :: forall m. Monoid m => FactorPortrayal m -> m
Foldable, Functor FactorPortrayal
Foldable FactorPortrayal
Functor FactorPortrayal
-> Foldable FactorPortrayal
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> FactorPortrayal a -> f (FactorPortrayal b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    FactorPortrayal (f a) -> f (FactorPortrayal a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> FactorPortrayal a -> m (FactorPortrayal b))
-> (forall (m :: * -> *) a.
    Monad m =>
    FactorPortrayal (m a) -> m (FactorPortrayal a))
-> Traversable FactorPortrayal
(a -> f b) -> FactorPortrayal a -> f (FactorPortrayal b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
FactorPortrayal (m a) -> m (FactorPortrayal a)
forall (f :: * -> *) a.
Applicative f =>
FactorPortrayal (f a) -> f (FactorPortrayal a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FactorPortrayal a -> m (FactorPortrayal b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FactorPortrayal a -> f (FactorPortrayal b)
sequence :: FactorPortrayal (m a) -> m (FactorPortrayal a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
FactorPortrayal (m a) -> m (FactorPortrayal a)
mapM :: (a -> m b) -> FactorPortrayal a -> m (FactorPortrayal b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FactorPortrayal a -> m (FactorPortrayal b)
sequenceA :: FactorPortrayal (f a) -> f (FactorPortrayal a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
FactorPortrayal (f a) -> f (FactorPortrayal a)
traverse :: (a -> f b) -> FactorPortrayal a -> f (FactorPortrayal b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FactorPortrayal a -> f (FactorPortrayal b)
$cp2Traversable :: Foldable FactorPortrayal
$cp1Traversable :: Functor FactorPortrayal
Traversable, (forall x. FactorPortrayal a -> Rep (FactorPortrayal a) x)
-> (forall x. Rep (FactorPortrayal a) x -> FactorPortrayal a)
-> Generic (FactorPortrayal a)
forall x. Rep (FactorPortrayal a) x -> FactorPortrayal a
forall x. FactorPortrayal a -> Rep (FactorPortrayal a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FactorPortrayal a) x -> FactorPortrayal a
forall a x. FactorPortrayal a -> Rep (FactorPortrayal a) x
$cto :: forall a x. Rep (FactorPortrayal a) x -> FactorPortrayal a
$cfrom :: forall a x. FactorPortrayal a -> Rep (FactorPortrayal a) x
Generic)
  deriving FactorPortrayal a -> Portrayal
(FactorPortrayal a -> Portrayal) -> Portray (FactorPortrayal a)
forall a. Portray a => FactorPortrayal a -> Portrayal
forall a. (a -> Portrayal) -> Portray a
portray :: FactorPortrayal a -> Portrayal
$cportray :: forall a. Portray a => FactorPortrayal a -> Portrayal
Portray via Wrapped Generic (FactorPortrayal a)


-- | Fixed-point of a functor.
--
-- There are many packages that provide equivalent things, but we need almost
-- nothing but the type itself, so we may as well just define one locally.
newtype Fix f = Fix (f (Fix f))
  deriving (forall x. Fix f -> Rep (Fix f) x)
-> (forall x. Rep (Fix f) x -> Fix f) -> Generic (Fix f)
forall x. Rep (Fix f) x -> Fix f
forall x. Fix f -> Rep (Fix f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (Fix f) x -> Fix f
forall (f :: * -> *) x. Fix f -> Rep (Fix f) x
$cto :: forall (f :: * -> *) x. Rep (Fix f) x -> Fix f
$cfrom :: forall (f :: * -> *) x. Fix f -> Rep (Fix f) x
Generic

deriving newtype
  instance (forall a. Portray a => Portray (f a)) => Portray (Fix f)

deriving stock
  instance (forall a. Read a => Read (f a)) => Read (Fix f)

deriving stock
  instance (forall a. Show a => Show (f a)) => Show (Fix f)

deriving stock
  instance (forall a. Eq a => Eq (f a)) => Eq (Fix f)

-- | The portrayal of a Haskell runtime value as a pseudo-Haskell syntax tree.
--
-- This can be rendered to various pretty-printing libraries' document types
-- relatively easily; as such, it provides a /lingua franca/ for integrating
-- with pretty-printers, without incurring heavyweight dependencies.
newtype Portrayal = Portrayal { Portrayal -> Fix PortrayalF
unPortrayal :: Fix PortrayalF }
  deriving stock (Portrayal -> Portrayal -> Bool
(Portrayal -> Portrayal -> Bool)
-> (Portrayal -> Portrayal -> Bool) -> Eq Portrayal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Portrayal -> Portrayal -> Bool
$c/= :: Portrayal -> Portrayal -> Bool
== :: Portrayal -> Portrayal -> Bool
$c== :: Portrayal -> Portrayal -> Bool
Eq, (forall x. Portrayal -> Rep Portrayal x)
-> (forall x. Rep Portrayal x -> Portrayal) -> Generic Portrayal
forall x. Rep Portrayal x -> Portrayal
forall x. Portrayal -> Rep Portrayal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Portrayal x -> Portrayal
$cfrom :: forall x. Portrayal -> Rep Portrayal x
Generic)
  deriving newtype (Portrayal -> Portrayal
(Portrayal -> Portrayal) -> Portray Portrayal
forall a. (a -> Portrayal) -> Portray a
portray :: Portrayal -> Portrayal
$cportray :: Portrayal -> Portrayal
Portray, Int -> Portrayal -> ShowS
[Portrayal] -> ShowS
Portrayal -> String
(Int -> Portrayal -> ShowS)
-> (Portrayal -> String)
-> ([Portrayal] -> ShowS)
-> Show Portrayal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Portrayal] -> ShowS
$cshowList :: [Portrayal] -> ShowS
show :: Portrayal -> String
$cshow :: Portrayal -> String
showsPrec :: Int -> Portrayal -> ShowS
$cshowsPrec :: Int -> Portrayal -> ShowS
Show, ReadPrec [Portrayal]
ReadPrec Portrayal
Int -> ReadS Portrayal
ReadS [Portrayal]
(Int -> ReadS Portrayal)
-> ReadS [Portrayal]
-> ReadPrec Portrayal
-> ReadPrec [Portrayal]
-> Read Portrayal
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Portrayal]
$creadListPrec :: ReadPrec [Portrayal]
readPrec :: ReadPrec Portrayal
$creadPrec :: ReadPrec Portrayal
readList :: ReadS [Portrayal]
$creadList :: ReadS [Portrayal]
readsPrec :: Int -> ReadS Portrayal
$creadsPrec :: Int -> ReadS Portrayal
Read)

instance IsString Portrayal where fromString :: String -> Portrayal
fromString = Text -> Portrayal
Atom (Text -> Portrayal) -> (String -> Text) -> String -> Portrayal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

{-# COMPLETE
      Atom, Apply, Binop, Tuple, List, LambdaCase,
      Record, TyApp, TySig, Quot, Unlines, Nest
  #-}

-- An explicitly-bidirectional pattern synonym that makes it possible to write
-- simply-bidirectional pattern synonyms involving coercions.
--
-- N.B.: lol, I did not expect this to work.
pattern Coerced :: Coercible a b => a -> b
pattern $bCoerced :: a -> b
$mCoerced :: forall r a b. Coercible a b => b -> (a -> r) -> (Void# -> r) -> r
Coerced x <- (coerce -> x)
 where
  Coerced a
x = a -> b
coerce a
x

-- 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.
--
-- This is used for things like literals and constructor names.
pattern Atom :: Text -> Portrayal
pattern $bAtom :: Text -> Portrayal
$mAtom :: forall r. Portrayal -> (Text -> r) -> (Void# -> r) -> r
Atom txt = Portrayal (Fix (AtomF txt))

-- | A function or constructor application of arbitrary arity.
--
-- Although we could have just unary function application, this gives backends
-- a hint about how to format the result: for example, the "pretty" backend
-- prints the function (parenthesized if non-atomic) followed by the arguments
-- indented by two spaces; a chain of unary applications would be needlessly
-- parenthesized.
--
-- Given:
--
-- @
--     Apply \"These\" ["2", "4"]
-- @
--
-- We render something like @These 2 4@, or if line-wrapped:
--
-- @
--     These
--       2
--       4
-- @
pattern Apply :: Portrayal -> [Portrayal] -> Portrayal
pattern $bApply :: Portrayal -> [Portrayal] -> Portrayal
$mApply :: forall r.
Portrayal -> (Portrayal -> [Portrayal] -> r) -> (Void# -> r) -> r
Apply f xs = Portrayal (Fix (ApplyF (Coerced f) (Coerced xs)))

-- | A binary operator application.
--
-- The fixity is used to avoid unnecessary parentheses, even in chains of
-- operators of the same precedence.
--
-- Given:
--
-- @
--     Binop "+" (infixl_ 6)
--       [ Binop "+" (infixl_ 6) ["2", "4"]
--       , "6"
--       ]
-- @
--
-- We render something like: @2 + 4 + 6@
pattern Binop :: Text -> Infixity -> Portrayal -> Portrayal -> Portrayal
pattern $bBinop :: Text -> Infixity -> Portrayal -> Portrayal -> Portrayal
$mBinop :: forall r.
Portrayal
-> (Text -> Infixity -> Portrayal -> Portrayal -> r)
-> (Void# -> r)
-> r
Binop nm inf x y =
  Portrayal (Fix (BinopF nm inf (Coerced x) (Coerced y)))

-- | A list literal.
--
-- Given:
--
-- @
--     List [Apply \"These\" ["2", "4"], Apply \"That\" ["6"]]
-- @
--
-- We render something like:
--
-- @
--     [ These 2 4
--     , That 6
--     ]
-- @
pattern List :: [Portrayal] -> Portrayal
pattern $bList :: [Portrayal] -> Portrayal
$mList :: forall r. Portrayal -> ([Portrayal] -> r) -> (Void# -> r) -> r
List xs = Portrayal (Fix (ListF (Coerced xs)))

-- | A tuple.
--
-- Given @Tuple ["2", "4"]@, we render something like @(2, 4)@
pattern Tuple :: [Portrayal] -> Portrayal
pattern $bTuple :: [Portrayal] -> Portrayal
$mTuple :: forall r. Portrayal -> ([Portrayal] -> r) -> (Void# -> r) -> r
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"@.
--
-- 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
-- indices.
pattern LambdaCase :: [(Portrayal, Portrayal)] -> Portrayal
pattern $bLambdaCase :: [(Portrayal, Portrayal)] -> Portrayal
$mLambdaCase :: forall r.
Portrayal -> ([(Portrayal, Portrayal)] -> r) -> (Void# -> r) -> r
LambdaCase xs = Portrayal (Fix (LambdaCaseF (Coerced xs)))

-- | A record literal.
--
-- Given:
--
-- @
--     Record \"Identity\" [FactorPortrayal "runIdentity" "2"]
-- @
--
-- We render something like:
--
-- @
--     Identity
--       { runIdentity = 2
--       }
-- @
pattern Record :: Portrayal -> [FactorPortrayal Portrayal] -> Portrayal
pattern $bRecord :: Portrayal -> [FactorPortrayal Portrayal] -> Portrayal
$mRecord :: forall r.
Portrayal
-> (Portrayal -> [FactorPortrayal Portrayal] -> r)
-> (Void# -> r)
-> r
Record x xs = Portrayal (Fix (RecordF (Coerced x) (Coerced xs)))

-- | A type application.
--
-- Given @TyApp \"Proxy\" \"Int\"@, we render @Proxy \@Int@
pattern TyApp :: Portrayal -> Portrayal -> Portrayal
pattern $bTyApp :: Portrayal -> Portrayal -> Portrayal
$mTyApp :: forall r.
Portrayal -> (Portrayal -> Portrayal -> r) -> (Void# -> r) -> r
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@
pattern TySig :: Portrayal -> Portrayal -> Portrayal
pattern $bTySig :: Portrayal -> Portrayal -> Portrayal
$mTySig :: forall r.
Portrayal -> (Portrayal -> Portrayal -> r) -> (Void# -> r) -> r
TySig x t = Portrayal (Fix (TySigF (Coerced x) (Coerced t)))

-- | A quasiquoter expression.
--
-- Given @Quot \"expr\" (Binop "+" _ ["x", "!y"])@, we render @[expr| x + !y |]@
pattern Quot :: Text -> Portrayal -> Portrayal
pattern $bQuot :: Text -> Portrayal -> Portrayal
$mQuot :: forall r.
Portrayal -> (Text -> Portrayal -> r) -> (Void# -> r) -> r
Quot t x = Portrayal (Fix (QuotF t (Coerced x)))

-- | A series of lines arranged vertically, if supported.
--
-- This is meant for use inside 'Quot', where it makes sense to use non-Haskell
-- syntax.
pattern Unlines :: [Portrayal] -> Portrayal
pattern $bUnlines :: [Portrayal] -> Portrayal
$mUnlines :: forall r. Portrayal -> ([Portrayal] -> r) -> (Void# -> r) -> r
Unlines xs = Portrayal (Fix (UnlinesF (Coerced xs)))

-- | Indent a sub-expression by the given number of spaces.
--
-- This is meant for use inside 'Quot', where it makes sense to use non-Haskell
-- syntax.
pattern Nest :: Int -> Portrayal -> Portrayal
pattern $bNest :: Int -> Portrayal -> Portrayal
$mNest :: forall r. Portrayal -> (Int -> Portrayal -> r) -> (Void# -> r) -> r
Nest n x = Portrayal (Fix (NestF n (Coerced x)))

-- | A class providing rendering to pseudo-Haskell syntax.
--
-- Instances should guarantee that they produce output that could, in
-- principle, be parsed as Haskell source that evaluates to a value equal to
-- the one being printed, provided the right functions, quasiquoters, plugins,
-- extensions, etc. are available.  Note this doesn't require you to /actually
-- implement/ these functions, quasiquoters, etc; just that it would be
-- feasible to do so.
--
-- Most of the time, this requirement is dispatched simply by portraying the
-- datum as its actual tree of data constructors.  However, since this can
-- sometimes be unwieldy, you might wish to have more stylized portrayals.
--
-- The most basic form of stylized portrayal is to retract the datum through a
-- function, e.g. portraying @4 :| [2] :: NonEmpty a@ as @fromList [4, 2]@.
--
-- For cases where you actually want to escape the Haskell syntax, you can use
-- (or pretend to use) quasiquoter syntax, e.g. portray
-- @EAdd (ELit 2) (EVar a)@ as @[expr| 2 + a |]@.
class Portray a where
  portray :: a -> Portrayal

-- | Convenience for using a 'Show' instance and wrapping the result in 'Atom'.
showAtom :: Show a => a -> Portrayal
showAtom :: a -> Portrayal
showAtom = String -> Portrayal
strAtom (String -> Portrayal) -> (a -> String) -> a -> Portrayal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Convenience for building an 'Atom' from a 'String'.
--
-- Note if you just want a string literal, @OverloadedStrings@ is supported.
strAtom :: String -> Portrayal
strAtom :: String -> Portrayal
strAtom = Text -> Portrayal
Atom (Text -> Portrayal) -> (String -> Text) -> String -> Portrayal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Convenience for building a 'Quot' from a 'String'.
strQuot :: String -> Portrayal -> Portrayal
strQuot :: String -> Portrayal -> Portrayal
strQuot = Text -> Portrayal -> Portrayal
Quot (Text -> Portrayal -> Portrayal)
-> (String -> Text) -> String -> Portrayal -> Portrayal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Convenience for building a 'Binop' with a 'String' operator name.
strBinop :: String -> Infixity -> Portrayal -> Portrayal -> Portrayal
strBinop :: String -> Infixity -> Portrayal -> Portrayal -> Portrayal
strBinop = Text -> Infixity -> Portrayal -> Portrayal -> Portrayal
Binop (Text -> Infixity -> Portrayal -> Portrayal -> Portrayal)
-> (String -> Text)
-> String
-> Infixity
-> Portrayal
-> Portrayal
-> Portrayal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Generics-based deriving of 'Portray' for product types.
--
-- Exported mostly to give Haddock something to link to; use
-- @deriving Portray via Wrapped Generic MyType@.
class GPortrayProduct f where
  gportrayProduct
    :: f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]

instance GPortrayProduct U1 where
  gportrayProduct :: U1 a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
gportrayProduct U1 a
U1 = [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
forall a. a -> a
id

instance (Selector s, Portray a) => GPortrayProduct (S1 s (K1 i a)) where
  gportrayProduct :: S1 s (K1 i a) a
-> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
gportrayProduct (M1 (K1 a
x)) =
    (Text -> Portrayal -> FactorPortrayal Portrayal
forall a. Text -> a -> FactorPortrayal a
FactorPortrayal (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Any s Any Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName @s Any s Any Any
forall a. HasCallStack => a
undefined) (a -> Portrayal
forall a. Portray a => a -> Portrayal
portray a
x) FactorPortrayal Portrayal
-> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
forall a. a -> [a] -> [a]
:)

instance (GPortrayProduct f, GPortrayProduct g)
      => GPortrayProduct (f :*: g) where
  gportrayProduct :: (:*:) f g a
-> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
gportrayProduct (f a
f :*: g a
g) = f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
forall k (f :: k -> *) (a :: k).
GPortrayProduct f =>
f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
gportrayProduct f a
f ([FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal])
-> ([FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal])
-> [FactorPortrayal Portrayal]
-> [FactorPortrayal Portrayal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
forall k (f :: k -> *) (a :: k).
GPortrayProduct f =>
f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
gportrayProduct g a
g

-- | Generics-based deriving of 'Portray'.
--
-- Exported mostly to give Haddock something to link to; use
-- @deriving Portray via Wrapped Generic MyType@.
class GPortray f where
  gportray :: f a -> Portrayal

instance GPortray f => GPortray (D1 d f) where
  gportray :: D1 d f a -> Portrayal
gportray (M1 f a
x) = f a -> Portrayal
forall k (f :: k -> *) (a :: k). GPortray f => f a -> Portrayal
gportray f a
x

instance GPortray V1 where
  gportray :: V1 a -> Portrayal
gportray V1 a
x = case V1 a
x of {}

instance (GPortray f, GPortray g) => GPortray (f :+: g) where
  gportray :: (:+:) f g a -> Portrayal
gportray (L1 f a
f) = f a -> Portrayal
forall k (f :: k -> *) (a :: k). GPortray f => f a -> Portrayal
gportray f a
f
  gportray (R1 g a
g) = g a -> Portrayal
forall k (f :: k -> *) (a :: k). GPortray f => f a -> Portrayal
gportray g a
g

-- Wrap operator constructor names (which must start with a colon) in parens,
-- for use in function application context.  This arises in four scenarios:
--
-- - The constructor has fewer than two arguments: @(:%) :: Int -> Thing@ gives
-- e.g. "(:%) 42".
-- - The constructor has more than two arguments:
-- @(:%) :: Int -> Int -> Int -> Thing@ gives e.g. "(:%) 2 4 6".
-- - The constructor is declared in prefix form or GADT syntax and has no
-- fixity declaration: @data Thing = (:%) Int Int@ gives e.g. "(:%) 2 4".
-- - The constructor is declared in record notation:
-- @data Thing = (:%) { _x :: Int, _y :: Int }@ gives e.g.
-- "(:%) { _x = 2, _y = 4 }".
formatPrefixCon :: String -> String
formatPrefixCon :: ShowS
formatPrefixCon (Char
':' : String
rest) = String
"(:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
formatPrefixCon String
con = String
con

-- 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 :: ShowS
formatInfixCon (Char
':' : String
rest) = Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: String
rest
formatInfixCon String
con = Char
'`' Char -> ShowS
forall a. a -> [a] -> [a]
: String
con String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"`"

toAssoc :: Associativity -> Assoc
toAssoc :: Associativity -> Assoc
toAssoc = \case
  Associativity
LeftAssociative -> Assoc
AssocL
  Associativity
RightAssociative -> Assoc
AssocR
  Associativity
NotAssociative -> Assoc
AssocNope

instance (KnownSymbol n, GPortrayProduct f)
      => GPortray (C1 ('MetaCons n fx 'True) f) where
  gportray :: C1 ('MetaCons n fx 'True) f a -> Portrayal
gportray (M1 f a
x) = Portrayal -> [FactorPortrayal Portrayal] -> Portrayal
Record
    (String -> Portrayal
strAtom (ShowS
formatPrefixCon ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Proxy# n -> String
forall (n :: Symbol). KnownSymbol n => Proxy# n -> String
symbolVal' @n Proxy# n
forall k (a :: k). Proxy# a
proxy#))
    (f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
forall k (f :: k -> *) (a :: k).
GPortrayProduct f =>
f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
gportrayProduct f a
x [])

instance (Constructor ('MetaCons n fx 'False), GPortrayProduct f)
      => GPortray (C1 ('MetaCons n fx 'False) f) where
  gportray :: C1 ('MetaCons n fx 'False) f a -> Portrayal
gportray (M1 f a
x0) =
    case (String
nm, Any ('MetaCons n fx 'False) Any Any -> Fixity
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Fixity
conFixity @('MetaCons n fx 'False) Any ('MetaCons n fx 'False) Any Any
forall a. HasCallStack => a
undefined, [Portrayal]
args) of
      (Char
'(' : Char
',' : String
_, Fixity
_, [Portrayal]
_) -> [Portrayal] -> Portrayal
Tuple [Portrayal]
args
      (String
_, Infix Associativity
lr Int
p, [Portrayal
x, Portrayal
y]) -> Text -> Infixity -> Portrayal -> Portrayal -> Portrayal
Binop
        (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
formatInfixCon String
nm)
        (Assoc -> Rational -> Infixity
Infixity (Associativity -> Assoc
toAssoc Associativity
lr) (Int -> Rational
forall a. Real a => a -> Rational
toRational Int
p))
        Portrayal
x
        Portrayal
y
      (String
_, Fixity
_, []) -> String -> Portrayal
strAtom (ShowS
formatPrefixCon String
nm)
      (String, Fixity, [Portrayal])
_ -> Portrayal -> [Portrayal] -> Portrayal
Apply (String -> Portrayal
strAtom (ShowS
formatPrefixCon String
nm)) [Portrayal]
args
   where
    args :: [Portrayal]
args = FactorPortrayal Portrayal -> Portrayal
forall a. FactorPortrayal a -> a
_fpPortrayal (FactorPortrayal Portrayal -> Portrayal)
-> [FactorPortrayal Portrayal] -> [Portrayal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
forall k (f :: k -> *) (a :: k).
GPortrayProduct f =>
f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
gportrayProduct f a
x0 []
    nm :: String
nm = Any ('MetaCons n fx 'False) Any Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName @('MetaCons n fx 'False) Any ('MetaCons n fx 'False) Any Any
forall a. HasCallStack => a
undefined

instance (Generic a, GPortray (Rep a)) => Portray (Wrapped Generic a) where
  portray :: Wrapped Generic a -> Portrayal
portray (Wrapped a
x) = Rep a Any -> Portrayal
forall k (f :: k -> *) (a :: k). GPortray f => f a -> Portrayal
gportray (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
x)

-- | A newtype wrapper providing a 'Portray' instance via 'showAtom'.
newtype ShowAtom a = ShowAtom { ShowAtom a -> a
unShowAtom :: a }

instance Show a => Portray (ShowAtom a) where
  portray :: ShowAtom a -> Portrayal
portray = a -> Portrayal
forall a. Show a => a -> Portrayal
showAtom (a -> Portrayal) -> (ShowAtom a -> a) -> ShowAtom a -> Portrayal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowAtom a -> a
forall a. ShowAtom a -> a
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

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 a => Portray (Ratio a) where
  portray :: Ratio a -> Portrayal
portray Ratio a
x = Text -> Infixity -> Portrayal -> Portrayal -> Portrayal
Binop Text
"%" (Rational -> Infixity
infixl_ Rational
7)
    (a -> Portrayal
forall a. Portray a => a -> Portrayal
portray (a -> Portrayal) -> a -> Portrayal
forall a b. (a -> b) -> a -> b
$ Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
x)
    (a -> Portrayal
forall a. Portray a => a -> Portrayal
portray (a -> Portrayal) -> a -> Portrayal
forall a b. (a -> b) -> a -> b
$ Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
x)

deriving via Wrapped Generic (a, b)
  instance (Portray a, Portray b) => Portray (a, b)
deriving via Wrapped Generic (a, b, c)
  instance (Portray a, Portray b, Portray c) => Portray (a, b, c)
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)
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

-- 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 a -> Portrayal
portray (Identity a
x) = Portrayal -> [Portrayal] -> Portrayal
Apply Portrayal
"Identity" [a -> Portrayal
forall a. Portray a => a -> Portrayal
portray a
x]
instance Portray a => Portray (Const a b) where
  portray :: Const a b -> Portrayal
portray (Const a
x) = Portrayal -> [Portrayal] -> Portrayal
Apply Portrayal
"Const" [a -> Portrayal
forall a. Portray a => a -> Portrayal
portray a
x]

instance Portray a => Portray [a] where
  portray :: [a] -> Portrayal
portray = [Portrayal] -> Portrayal
List ([Portrayal] -> Portrayal)
-> ([a] -> [Portrayal]) -> [a] -> Portrayal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Portrayal) -> [a] -> [Portrayal]
forall a b. (a -> b) -> [a] -> [b]
map a -> Portrayal
forall a. Portray a => a -> Portrayal
portray

deriving via Wrapped Generic (Proxy a) instance Portray (Proxy a)


instance Portray TyCon where
  portray :: TyCon -> Portrayal
portray = String -> Portrayal
strAtom (String -> Portrayal) -> (TyCon -> String) -> TyCon -> Portrayal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
formatPrefixCon ShowS -> (TyCon -> String) -> TyCon -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> String
tyConName

portraySomeType :: SomeTypeRep -> Portrayal
portraySomeType :: SomeTypeRep -> Portrayal
portraySomeType (SomeTypeRep TypeRep a
ty) = TypeRep a -> Portrayal
forall k (a :: k). TypeRep a -> Portrayal
portrayType TypeRep a
ty

-- | Portray the type described by the given 'TypeRep'.
--
-- This gives the type-level syntax for the type, as opposed to value-level
-- syntax that would construct the `TypeRep`.
portrayType :: TypeRep a -> Portrayal
portrayType :: TypeRep a -> Portrayal
portrayType = \case
  TypeRep a
special
    | TypeRep a -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep a
special SomeTypeRep -> SomeTypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep * -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (Typeable * => TypeRep *
forall k (a :: k). Typeable a => TypeRep a
typeRep @Type) -> Portrayal
"Type"
  Fun TypeRep arg
a TypeRep res
b -> Text -> Infixity -> Portrayal -> Portrayal -> Portrayal
Binop (String -> Text
T.pack String
"->") (Rational -> Infixity
infixr_ (-Rational
1)) (TypeRep arg -> Portrayal
forall k (a :: k). TypeRep a -> Portrayal
portrayType TypeRep arg
a) (TypeRep res -> Portrayal
forall k (a :: k). TypeRep a -> Portrayal
portrayType TypeRep res
b)
  -- TODO(awpr); it'd be nice to coalesce the resulting nested 'Apply's.
  App TypeRep a
f TypeRep b
x -> Portrayal -> [Portrayal] -> Portrayal
Apply (TypeRep a -> Portrayal
forall k (a :: k). TypeRep a -> Portrayal
portrayType TypeRep a
f) [TypeRep b -> Portrayal
forall k (a :: k). TypeRep a -> Portrayal
portrayType TypeRep b
x]
  Con' TyCon
con [SomeTypeRep]
tys -> (Portrayal -> SomeTypeRep -> Portrayal)
-> Portrayal -> [SomeTypeRep] -> Portrayal
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Portrayal
x -> Portrayal -> Portrayal -> Portrayal
TyApp Portrayal
x (Portrayal -> Portrayal)
-> (SomeTypeRep -> Portrayal) -> SomeTypeRep -> Portrayal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeTypeRep -> Portrayal
portraySomeType) (TyCon -> Portrayal
forall a. Portray a => a -> Portrayal
portray TyCon
con) [SomeTypeRep]
tys

instance Portray (TypeRep a) where
  portray :: TypeRep a -> Portrayal
portray = Portrayal -> Portrayal -> Portrayal
TyApp Portrayal
"typeRep" (Portrayal -> Portrayal)
-> (TypeRep a -> Portrayal) -> TypeRep a -> Portrayal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep a -> Portrayal
forall k (a :: k). TypeRep a -> Portrayal
portrayType

instance Portray SomeTypeRep where
  portray :: SomeTypeRep -> Portrayal
portray (SomeTypeRep TypeRep a
ty) = Portrayal -> [Portrayal] -> Portrayal
Apply
    (Portrayal -> Portrayal -> Portrayal
TyApp Portrayal
"SomeTypeRep" (TypeRep a -> Portrayal
forall k (a :: k). TypeRep a -> Portrayal
portrayType TypeRep a
ty))
    [Portrayal
"typeRep"]

instance Portray (a :~: b) where portray :: (a :~: b) -> Portrayal
portray a :~: b
Refl = Portrayal
"Refl"
instance Portray (Coercion a b) where portray :: Coercion a b -> Portrayal
portray Coercion a b
Coercion = Portrayal
"Coercion"

-- | Portray a list-like type as "fromList [...]".
instance (IsList a, Portray (Exts.Item a))
      => Portray (Wrapped IsList a) where
  portray :: Wrapped IsList a -> Portrayal
portray = Portrayal -> [Portrayal] -> Portrayal
Apply Portrayal
"fromList" ([Portrayal] -> Portrayal)
-> (Wrapped IsList a -> [Portrayal])
-> Wrapped IsList a
-> Portrayal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Portrayal -> [Portrayal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Portrayal -> [Portrayal])
-> (Wrapped IsList a -> Portrayal)
-> Wrapped IsList a
-> [Portrayal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item a] -> Portrayal
forall a. Portray a => a -> Portrayal
portray ([Item a] -> Portrayal)
-> (Wrapped IsList a -> [Item a]) -> Wrapped IsList a -> Portrayal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrapped IsList a -> [Item a]
forall l. IsList l => l -> [Item l]
Exts.toList

deriving via Wrapped IsList (IntMap a)
  instance Portray a => Portray (IntMap a)
deriving via Wrapped IsList (Map k a)
  instance (Ord k, Portray k, Portray a) => Portray (Map k a)
deriving via Wrapped IsList (Set a)
  instance (Ord a, Portray a) => Portray (Set a)
deriving via Wrapped IsList (Seq a)
  instance Portray a => Portray (Seq a)
deriving via Wrapped IsList (NonEmpty a)
  instance Portray a => Portray (NonEmpty a)

-- Note: intentionally no instance for @'Wrapped1' 'Foldable'@, since that
-- doesn't ensure that 'fromList' is actually a valid way to construct @f a@.

-- | Construct a 'Portrayal' of a 'CallStack' without the "callStack" prefix.
portrayCallStack :: [(String, SrcLoc)] -> Portrayal
portrayCallStack :: [(String, SrcLoc)] -> Portrayal
portrayCallStack [(String, SrcLoc)]
xs = [Portrayal] -> Portrayal
Unlines
  [ Portrayal
"GHC.Stack.CallStack:"
  , Int -> Portrayal -> Portrayal
Nest Int
2 (Portrayal -> Portrayal) -> Portrayal -> Portrayal
forall a b. (a -> b) -> a -> b
$ [Portrayal] -> Portrayal
Unlines
      [ String -> Portrayal
strAtom (String
func String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", called at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
prettySrcLoc SrcLoc
loc)
      | (String
func, SrcLoc
loc) <- [(String, SrcLoc)]
xs
      ]
  ]

instance Portray CallStack where
  portray :: CallStack -> Portrayal
portray CallStack
cs = case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of
    [] -> Portrayal
"emptyCallStack"
    [(String, SrcLoc)]
xs -> String -> Portrayal -> Portrayal
strQuot String
"callStack" (Portrayal -> Portrayal) -> Portrayal -> Portrayal
forall a b. (a -> b) -> a -> b
$ [(String, SrcLoc)] -> Portrayal
portrayCallStack [(String, SrcLoc)]
xs

-- | Fold a @Fix f@ to @a@ given a function to collapse each layer.
cata :: Functor f => (f a -> a) -> Fix f -> a
cata :: (f a -> a) -> Fix f -> a
cata f a -> a
f = Fix f -> a
go
 where
  go :: Fix f -> a
go (Fix f (Fix f)
fa) = f a -> a
f (f a -> a) -> f a -> a
forall a b. (a -> b) -> a -> b
$ Fix f -> a
go (Fix f -> a) -> f (Fix f) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Fix f)
fa