{-# LANGUAGE CPP #-}
{-# 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 RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Data.Portray
(
Portrayal
( Name
, LitInt, LitIntBase
, LitRat, LitFloat, SpecialFloat
, LitStr, LitChar, Opaque
, Apply, Binop, Tuple, List
, LambdaCase, Record, TyApp, TySig
, Quot, Unlines, Nest
, ..
)
, FactorPortrayal(..)
, IdentKind(..), Ident(..)
, Base(..), baseToInt, basePrefix, formatIntLit
, FloatLiteral(..), floatToLiteral, fixedToLiteral
, floatLiteralToRational, shouldUseScientific
, normalizeFloatLit, trimFloatLit, formatFloatLit
, SpecialFloatVal(..), formatSpecialFloat
, Assoc(..), Infixity(..), infix_, infixl_, infixr_
, PortrayalF(.., LitIntF, LitRatF)
, Portray(..)
, PortrayDataCons(..)
, genericPortray
, GPortray(..), gportray, GPortrayProduct(..)
, GPortrayConfig, defaultGPortrayConfig
, useRecordSyntax, suppressRecordSyntax
, AnLens
, PortrayIntLit(..), PortrayRatLit(..), PortrayFloatLit(..)
, ShowAtom(..)
, showAtom, strAtom, strQuot, strBinop
, Fix(..), cata, portrayCallStack, portrayType
, showIntInBase
) where
import Data.Bifunctor (second)
import qualified Data.ByteString as BS hiding (unpack)
import qualified Data.ByteString.Char8 as BS (unpack)
import qualified Data.ByteString.Lazy as BL hiding (unpack)
import qualified Data.ByteString.Lazy.Char8 as BL (unpack)
import qualified Data.ByteString.Short as SBS
import Data.Char (digitToInt, intToDigit, isAlpha, isDigit, isUpper)
import Data.Coerce (Coercible, coerce)
import Data.Fixed (Fixed(..), HasResolution(..))
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 (foldl')
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Proxy (Proxy(..))
import Data.Ratio (Ratio, (%), numerator, denominator)
import Data.Semigroup (Sum(..), Product(..))
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)
import qualified GHC.Exts as Exts
import GHC.Float (floatToDigits)
import GHC.Generics
( (:*:)(..), (:+:)(..)
, Generic(..), Rep
, U1(..), K1(..), M1(..), V1
, D1, C1, S1
, Constructor, conName, conFixity, conIsRecord
, Selector, selName
, Fixity(..), Associativity(..)
)
import GHC.Real (infinity, notANumber)
import GHC.Stack (CallStack, SrcLoc, getCallStack, prettySrcLoc)
import Numeric
( showOct, showInt, showHex
#if MIN_VERSION_base(4, 16, 0)
, showBin
#else
, showIntAtBase
#endif
)
import Numeric.Natural (Natural)
import Type.Reflection
( TyCon, TypeRep, SomeTypeRep(..)
, pattern App, pattern Con', pattern Fun
, tyConName, typeRep
)
import Data.Wrapped (Wrapped(..))
data Assoc = AssocL | AssocR | AssocNope
deriving (ReadPrec [Assoc]
ReadPrec Assoc
Int -> ReadS Assoc
ReadS [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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Assoc] -> ShowS
$cshowList :: [Assoc] -> ShowS
show :: Assoc -> [Char]
$cshow :: Assoc -> [Char]
showsPrec :: Int -> Assoc -> ShowS
$cshowsPrec :: Int -> Assoc -> ShowS
Show, Assoc -> Assoc -> Bool
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
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
Ord, 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
forall a. (a -> Portrayal) -> ([a] -> Portrayal) -> Portray a
portrayList :: [Assoc] -> Portrayal
$cportrayList :: [Assoc] -> Portrayal
portray :: Assoc -> Portrayal
$cportray :: Assoc -> Portrayal
Portray via Wrapped Generic Assoc
data Infixity = Infixity !Assoc !Rational
deriving (ReadPrec [Infixity]
ReadPrec Infixity
Int -> ReadS Infixity
ReadS [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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Infixity] -> ShowS
$cshowList :: [Infixity] -> ShowS
show :: Infixity -> [Char]
$cshow :: Infixity -> [Char]
showsPrec :: Int -> Infixity -> ShowS
$cshowsPrec :: Int -> Infixity -> ShowS
Show, Infixity -> Infixity -> Bool
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
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
Ord, 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
forall a. (a -> Portrayal) -> ([a] -> Portrayal) -> Portray a
portrayList :: [Infixity] -> Portrayal
$cportrayList :: [Infixity] -> Portrayal
portray :: Infixity -> Portrayal
$cportray :: Infixity -> Portrayal
Portray via Wrapped Generic Infixity
infix_ :: Rational -> Infixity
infix_ :: Rational -> Infixity
infix_ = Assoc -> Rational -> Infixity
Infixity Assoc
AssocNope
infixl_ :: Rational -> Infixity
infixl_ :: Rational -> Infixity
infixl_ = Assoc -> Rational -> Infixity
Infixity Assoc
AssocL
infixr_ :: Rational -> Infixity
infixr_ :: Rational -> Infixity
infixr_ = Assoc -> Rational -> Infixity
Infixity Assoc
AssocR
data IdentKind = VarIdent | ConIdent | OpIdent | OpConIdent
deriving (IdentKind -> IdentKind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdentKind -> IdentKind -> Bool
$c/= :: IdentKind -> IdentKind -> Bool
== :: IdentKind -> IdentKind -> Bool
$c== :: IdentKind -> IdentKind -> Bool
Eq, Eq IdentKind
IdentKind -> IdentKind -> Bool
IdentKind -> IdentKind -> Ordering
IdentKind -> IdentKind -> IdentKind
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 :: IdentKind -> IdentKind -> IdentKind
$cmin :: IdentKind -> IdentKind -> IdentKind
max :: IdentKind -> IdentKind -> IdentKind
$cmax :: IdentKind -> IdentKind -> IdentKind
>= :: IdentKind -> IdentKind -> Bool
$c>= :: IdentKind -> IdentKind -> Bool
> :: IdentKind -> IdentKind -> Bool
$c> :: IdentKind -> IdentKind -> Bool
<= :: IdentKind -> IdentKind -> Bool
$c<= :: IdentKind -> IdentKind -> Bool
< :: IdentKind -> IdentKind -> Bool
$c< :: IdentKind -> IdentKind -> Bool
compare :: IdentKind -> IdentKind -> Ordering
$ccompare :: IdentKind -> IdentKind -> Ordering
Ord, ReadPrec [IdentKind]
ReadPrec IdentKind
Int -> ReadS IdentKind
ReadS [IdentKind]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IdentKind]
$creadListPrec :: ReadPrec [IdentKind]
readPrec :: ReadPrec IdentKind
$creadPrec :: ReadPrec IdentKind
readList :: ReadS [IdentKind]
$creadList :: ReadS [IdentKind]
readsPrec :: Int -> ReadS IdentKind
$creadsPrec :: Int -> ReadS IdentKind
Read, Int -> IdentKind -> ShowS
[IdentKind] -> ShowS
IdentKind -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [IdentKind] -> ShowS
$cshowList :: [IdentKind] -> ShowS
show :: IdentKind -> [Char]
$cshow :: IdentKind -> [Char]
showsPrec :: Int -> IdentKind -> ShowS
$cshowsPrec :: Int -> IdentKind -> ShowS
Show, forall x. Rep IdentKind x -> IdentKind
forall x. IdentKind -> Rep IdentKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdentKind x -> IdentKind
$cfrom :: forall x. IdentKind -> Rep IdentKind x
Generic)
deriving [IdentKind] -> Portrayal
IdentKind -> Portrayal
forall a. (a -> Portrayal) -> ([a] -> Portrayal) -> Portray a
portrayList :: [IdentKind] -> Portrayal
$cportrayList :: [IdentKind] -> Portrayal
portray :: IdentKind -> Portrayal
$cportray :: IdentKind -> Portrayal
Portray via Wrapped Generic IdentKind
data Ident = Ident !IdentKind !Text
deriving (Ident -> Ident -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ident -> Ident -> Bool
$c/= :: Ident -> Ident -> Bool
== :: Ident -> Ident -> Bool
$c== :: Ident -> Ident -> Bool
Eq, Eq Ident
Ident -> Ident -> Bool
Ident -> Ident -> Ordering
Ident -> Ident -> Ident
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 :: Ident -> Ident -> Ident
$cmin :: Ident -> Ident -> Ident
max :: Ident -> Ident -> Ident
$cmax :: Ident -> Ident -> Ident
>= :: Ident -> Ident -> Bool
$c>= :: Ident -> Ident -> Bool
> :: Ident -> Ident -> Bool
$c> :: Ident -> Ident -> Bool
<= :: Ident -> Ident -> Bool
$c<= :: Ident -> Ident -> Bool
< :: Ident -> Ident -> Bool
$c< :: Ident -> Ident -> Bool
compare :: Ident -> Ident -> Ordering
$ccompare :: Ident -> Ident -> Ordering
Ord, ReadPrec [Ident]
ReadPrec Ident
Int -> ReadS Ident
ReadS [Ident]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Ident]
$creadListPrec :: ReadPrec [Ident]
readPrec :: ReadPrec Ident
$creadPrec :: ReadPrec Ident
readList :: ReadS [Ident]
$creadList :: ReadS [Ident]
readsPrec :: Int -> ReadS Ident
$creadsPrec :: Int -> ReadS Ident
Read, Int -> Ident -> ShowS
[Ident] -> ShowS
Ident -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Ident] -> ShowS
$cshowList :: [Ident] -> ShowS
show :: Ident -> [Char]
$cshow :: Ident -> [Char]
showsPrec :: Int -> Ident -> ShowS
$cshowsPrec :: Int -> Ident -> ShowS
Show, forall x. Rep Ident x -> Ident
forall x. Ident -> Rep Ident x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ident x -> Ident
$cfrom :: forall x. Ident -> Rep Ident x
Generic)
deriving [Ident] -> Portrayal
Ident -> Portrayal
forall a. (a -> Portrayal) -> ([a] -> Portrayal) -> Portray a
portrayList :: [Ident] -> Portrayal
$cportrayList :: [Ident] -> Portrayal
portray :: Ident -> Portrayal
$cportray :: Ident -> Portrayal
Portray via Wrapped Generic Ident
instance IsString Ident where
fromString :: [Char] -> Ident
fromString [Char]
nm = IdentKind -> Text -> Ident
Ident IdentKind
k ([Char] -> Text
T.pack [Char]
nm)
where
k :: IdentKind
k = case [Char]
nm of
(Char
':':[Char]
_) -> IdentKind
OpConIdent
(Char
'_':[Char]
_) -> IdentKind
VarIdent
(Char
c:[Char]
_)
| Char -> Bool
isUpper Char
c -> IdentKind
ConIdent
| Char -> Bool
isAlpha Char
c -> IdentKind
VarIdent
| Bool
otherwise -> IdentKind
OpIdent
[Char]
"" -> IdentKind
VarIdent
data Base = Binary | Octal | Decimal | Hex
deriving (Base -> Base -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Base -> Base -> Bool
$c/= :: Base -> Base -> Bool
== :: Base -> Base -> Bool
$c== :: Base -> Base -> Bool
Eq, Eq Base
Base -> Base -> Bool
Base -> Base -> Ordering
Base -> Base -> Base
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 :: Base -> Base -> Base
$cmin :: Base -> Base -> Base
max :: Base -> Base -> Base
$cmax :: Base -> Base -> Base
>= :: Base -> Base -> Bool
$c>= :: Base -> Base -> Bool
> :: Base -> Base -> Bool
$c> :: Base -> Base -> Bool
<= :: Base -> Base -> Bool
$c<= :: Base -> Base -> Bool
< :: Base -> Base -> Bool
$c< :: Base -> Base -> Bool
compare :: Base -> Base -> Ordering
$ccompare :: Base -> Base -> Ordering
Ord, ReadPrec [Base]
ReadPrec Base
Int -> ReadS Base
ReadS [Base]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Base]
$creadListPrec :: ReadPrec [Base]
readPrec :: ReadPrec Base
$creadPrec :: ReadPrec Base
readList :: ReadS [Base]
$creadList :: ReadS [Base]
readsPrec :: Int -> ReadS Base
$creadsPrec :: Int -> ReadS Base
Read, Int -> Base -> ShowS
[Base] -> ShowS
Base -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Base] -> ShowS
$cshowList :: [Base] -> ShowS
show :: Base -> [Char]
$cshow :: Base -> [Char]
showsPrec :: Int -> Base -> ShowS
$cshowsPrec :: Int -> Base -> ShowS
Show, forall x. Rep Base x -> Base
forall x. Base -> Rep Base x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Base x -> Base
$cfrom :: forall x. Base -> Rep Base x
Generic)
deriving [Base] -> Portrayal
Base -> Portrayal
forall a. (a -> Portrayal) -> ([a] -> Portrayal) -> Portray a
portrayList :: [Base] -> Portrayal
$cportrayList :: [Base] -> Portrayal
portray :: Base -> Portrayal
$cportray :: Base -> Portrayal
Portray via Wrapped Generic Base
baseToInt :: Base -> Int
baseToInt :: Base -> Int
baseToInt = \case { Base
Binary -> Int
2; Base
Octal -> Int
8; Base
Decimal -> Int
10; Base
Hex -> Int
16 }
#if !MIN_VERSION_base(4, 16, 0)
showBin :: (Show a, Integral a) => a -> ShowS
showBin = showIntAtBase 2 (\case 0 -> '0'; _ -> '1')
#endif
showIntInBase :: (Show a, Integral a) => Base -> a -> ShowS
showIntInBase :: forall a. (Show a, Integral a) => Base -> a -> ShowS
showIntInBase =
\case
Base
Binary -> forall a. (Integral a, Show a) => a -> ShowS
showBin
Base
Octal -> forall a. (Integral a, Show a) => a -> ShowS
showOct
Base
Decimal -> forall a. Integral a => a -> ShowS
showInt
Base
Hex -> forall a. (Integral a, Show a) => a -> ShowS
showHex
chunksR :: [Int] -> Text -> [Text]
chunksR :: [Int] -> Text -> [Text]
chunksR [Int]
ns0 Text
x0 = [Int] -> Text -> [Text] -> [Text]
go [Int]
ns0 Text
x0 []
where
go :: [Int] -> Text -> [Text] -> [Text]
go [Int]
_ Text
"" [Text]
tl = [Text]
tl
go [] Text
x [Text]
tl = Text
xforall a. a -> [a] -> [a]
:[Text]
tl
go (Int
n:[Int]
ns) Text
x [Text]
tl =
let (Text
rest, Text
chunk) = Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
T.length Text
x forall a. Num a => a -> a -> a
- Int
n) Text
x
in [Int] -> Text -> [Text] -> [Text]
go [Int]
ns Text
rest (Text
chunk forall a. a -> [a] -> [a]
: [Text]
tl)
insertSeparators :: [Int] -> Text -> Text
insertSeparators :: [Int] -> Text -> Text
insertSeparators [Int]
seps = Text -> [Text] -> Text
T.intercalate Text
"_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Text -> [Text]
chunksR [Int]
seps
formatIntLit :: (Show a, Integral a) => Base -> [Int] -> a -> Text
formatIntLit :: forall a. (Show a, Integral a) => Base -> [Int] -> a -> Text
formatIntLit Base
b [Int]
seps a
x =
Text
sign forall a. Semigroup a => a -> a -> a
<> Base -> Text
basePrefix Base
b forall a. Semigroup a => a -> a -> a
<>
[Int] -> Text -> Text
insertSeparators [Int]
seps ([Char] -> Text
T.pack (forall a. (Show a, Integral a) => Base -> a -> ShowS
showIntInBase Base
b (forall a. Num a => a -> a
abs a
x) [Char]
""))
where
sign :: Text
sign
| a
x forall a. Ord a => a -> a -> Bool
< a
0 = Text
"-"
| Bool
otherwise = Text
""
basePrefix :: Base -> Text
basePrefix :: Base -> Text
basePrefix =
\case { Base
Binary -> Text
"0b"; Base
Octal -> Text
"0o"; Base
Decimal -> Text
""; Base
Hex -> Text
"0x" }
data FloatLiteral = FloatLiteral
{ FloatLiteral -> Bool
flNegate :: !Bool
, FloatLiteral -> Text
flDigits :: !Text
, FloatLiteral -> Int
flExponent :: !Int
}
deriving (FloatLiteral -> FloatLiteral -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FloatLiteral -> FloatLiteral -> Bool
$c/= :: FloatLiteral -> FloatLiteral -> Bool
== :: FloatLiteral -> FloatLiteral -> Bool
$c== :: FloatLiteral -> FloatLiteral -> Bool
Eq, Eq FloatLiteral
FloatLiteral -> FloatLiteral -> Bool
FloatLiteral -> FloatLiteral -> Ordering
FloatLiteral -> FloatLiteral -> FloatLiteral
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 :: FloatLiteral -> FloatLiteral -> FloatLiteral
$cmin :: FloatLiteral -> FloatLiteral -> FloatLiteral
max :: FloatLiteral -> FloatLiteral -> FloatLiteral
$cmax :: FloatLiteral -> FloatLiteral -> FloatLiteral
>= :: FloatLiteral -> FloatLiteral -> Bool
$c>= :: FloatLiteral -> FloatLiteral -> Bool
> :: FloatLiteral -> FloatLiteral -> Bool
$c> :: FloatLiteral -> FloatLiteral -> Bool
<= :: FloatLiteral -> FloatLiteral -> Bool
$c<= :: FloatLiteral -> FloatLiteral -> Bool
< :: FloatLiteral -> FloatLiteral -> Bool
$c< :: FloatLiteral -> FloatLiteral -> Bool
compare :: FloatLiteral -> FloatLiteral -> Ordering
$ccompare :: FloatLiteral -> FloatLiteral -> Ordering
Ord, ReadPrec [FloatLiteral]
ReadPrec FloatLiteral
Int -> ReadS FloatLiteral
ReadS [FloatLiteral]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FloatLiteral]
$creadListPrec :: ReadPrec [FloatLiteral]
readPrec :: ReadPrec FloatLiteral
$creadPrec :: ReadPrec FloatLiteral
readList :: ReadS [FloatLiteral]
$creadList :: ReadS [FloatLiteral]
readsPrec :: Int -> ReadS FloatLiteral
$creadsPrec :: Int -> ReadS FloatLiteral
Read, Int -> FloatLiteral -> ShowS
[FloatLiteral] -> ShowS
FloatLiteral -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FloatLiteral] -> ShowS
$cshowList :: [FloatLiteral] -> ShowS
show :: FloatLiteral -> [Char]
$cshow :: FloatLiteral -> [Char]
showsPrec :: Int -> FloatLiteral -> ShowS
$cshowsPrec :: Int -> FloatLiteral -> ShowS
Show, forall x. Rep FloatLiteral x -> FloatLiteral
forall x. FloatLiteral -> Rep FloatLiteral x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FloatLiteral x -> FloatLiteral
$cfrom :: forall x. FloatLiteral -> Rep FloatLiteral x
Generic)
deriving [FloatLiteral] -> Portrayal
FloatLiteral -> Portrayal
forall a. (a -> Portrayal) -> ([a] -> Portrayal) -> Portray a
portrayList :: [FloatLiteral] -> Portrayal
$cportrayList :: [FloatLiteral] -> Portrayal
portray :: FloatLiteral -> Portrayal
$cportray :: FloatLiteral -> Portrayal
Portray via Wrapped Generic FloatLiteral
floatLiteralToRational :: FloatLiteral -> Rational
floatLiteralToRational :: FloatLiteral -> Rational
floatLiteralToRational FloatLiteral
x = Integer
num forall a. Integral a => a -> a -> Ratio a
% Integer
denom
where
applySign :: Integer -> Integer
applySign
| FloatLiteral -> Bool
flNegate FloatLiteral
x = forall a. Num a => a -> a
negate
| Bool
otherwise = forall a. a -> a
id
mantissa :: Integer
mantissa =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
(\Integer
d Integer
acc -> Integer
10forall a. Num a => a -> a -> a
*Integer
acc forall a. Num a => a -> a -> a
+ Integer
d)
Integer
0
(forall a b. (a -> b) -> [a] -> [b]
map (forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt) forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ FloatLiteral -> Text
flDigits FloatLiteral
x)
e :: Integer
e = forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ FloatLiteral -> Int
flExponent FloatLiteral
x
num :: Integer
num = Integer -> Integer
applySign Integer
mantissa forall a. Num a => a -> a -> a
* Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ forall a. Ord a => a -> a -> a
max Integer
0 Integer
e
denom :: Integer
denom = Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ forall a. Ord a => a -> a -> a
max Integer
0 (forall a. Num a => a -> a
negate Integer
e)
negativeZero :: FloatLiteral
negativeZero :: FloatLiteral
negativeZero = Bool -> Text -> Int -> FloatLiteral
FloatLiteral Bool
True Text
"0" Int
0
floatToLiteral :: RealFloat a => a -> FloatLiteral
floatToLiteral :: forall a. RealFloat a => a -> FloatLiteral
floatToLiteral a
x
| forall a. RealFloat a => a -> Bool
isNegativeZero a
x = FloatLiteral
negativeZero
| Bool
otherwise =
let ([Int]
digits, Int
e) = forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits Integer
10 a
x
in Bool -> Text -> Int -> FloatLiteral
FloatLiteral (a
x forall a. Ord a => a -> a -> Bool
< a
0) ([Char] -> Text
T.pack (forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
intToDigit [Int]
digits)) Int
e
normalizeFloatLit :: FloatLiteral -> FloatLiteral
normalizeFloatLit :: FloatLiteral -> FloatLiteral
normalizeFloatLit (FloatLiteral Bool
n Text
d Int
e)
| Text -> Bool
T.null Text
rest = Bool -> Text -> Int -> FloatLiteral
FloatLiteral Bool
n Text
d Int
e
| Bool
otherwise = Bool -> Text -> Int -> FloatLiteral
FloatLiteral Bool
n Text
rest (Int
e forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
zeros)
where
(Text
zeros, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span (forall a. Eq a => a -> a -> Bool
==Char
'0') Text
d
spanEnd :: (Char -> Bool) -> Text -> (Text, Text)
#if MIN_VERSION_text(2, 0, 1)
spanEnd f = runIdentity . T.spanEndM (Identity . f)
#else
spanEnd :: (Char -> Bool) -> Text -> (Text, Text)
spanEnd Char -> Bool
f Text
x =
let (Text
r, Text
l) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
f (Text -> Text
T.reverse Text
x)
in (Text -> Text
T.reverse Text
l, Text -> Text
T.reverse Text
r)
#endif
trimFloatLit :: FloatLiteral -> FloatLiteral
trimFloatLit :: FloatLiteral -> FloatLiteral
trimFloatLit (FloatLiteral Bool
n Text
d Int
e)
| Text -> Bool
T.null Text
rest = Bool -> Text -> Int -> FloatLiteral
FloatLiteral Bool
n Text
"0" Int
1
| Bool
otherwise = Bool -> Text -> Int -> FloatLiteral
FloatLiteral Bool
n Text
rest Int
e
where
(Text
rest, Text
_) = (Char -> Bool) -> Text -> (Text, Text)
spanEnd (forall a. Eq a => a -> a -> Bool
==Char
'0') Text
d
shouldUseScientific :: FloatLiteral -> Bool
shouldUseScientific :: FloatLiteral -> Bool
shouldUseScientific (FloatLiteral Bool
_ Text
d Int
e) = Int
e forall a. Ord a => a -> a -> Bool
< -Int
1 Bool -> Bool -> Bool
|| Int
e forall a. Ord a => a -> a -> Bool
> Text -> Int
T.length Text
d forall a. Num a => a -> a -> a
+ Int
1
formatFloatLit :: Bool -> [Int] -> FloatLiteral -> Text
formatFloatLit :: Bool -> [Int] -> FloatLiteral -> Text
formatFloatLit Bool
scientific [Int]
seps (FloatLiteral Bool
neg Text
digits Int
e) =
Text
sign forall a. Semigroup a => a -> a -> a
<> [Int] -> Text -> Text
insertSeparators [Int]
seps Text
whole forall a. Semigroup a => a -> a -> a
<> Text
frac forall a. Semigroup a => a -> a -> a
<> Text
ex
where
sign :: Text
sign = if Bool
neg then Text
"-" else Text
""
radixPoint :: Int
radixPoint
| Bool
scientific = Int
1
| Bool
otherwise = Int
e
n :: Int
n = Text -> Int
T.length Text
digits
(Text
whole, Text
frac)
| Int
radixPoint forall a. Ord a => a -> a -> Bool
<= Int
0 = (Text
"0", Text
"." forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (-Int
radixPoint) Text
"0" forall a. Semigroup a => a -> a -> a
<> Text
digits)
| Int
radixPoint forall a. Ord a => a -> a -> Bool
>= Int
n = (Text
digits forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
radixPoint forall a. Num a => a -> a -> a
- Int
n) Text
"0", Text
"")
| Bool
otherwise = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Text
"." forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ Int -> Text -> (Text, Text)
T.splitAt Int
radixPoint Text
digits
ex :: Text
ex
| Bool
scientific = Text
"e" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Int
e forall a. Num a => a -> a -> a
- Int
1))
| Bool
otherwise = Text
""
data SpecialFloatVal = NaN | Infinity { SpecialFloatVal -> Bool
infNegate :: !Bool }
deriving (SpecialFloatVal -> SpecialFloatVal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecialFloatVal -> SpecialFloatVal -> Bool
$c/= :: SpecialFloatVal -> SpecialFloatVal -> Bool
== :: SpecialFloatVal -> SpecialFloatVal -> Bool
$c== :: SpecialFloatVal -> SpecialFloatVal -> Bool
Eq, Eq SpecialFloatVal
SpecialFloatVal -> SpecialFloatVal -> Bool
SpecialFloatVal -> SpecialFloatVal -> Ordering
SpecialFloatVal -> SpecialFloatVal -> SpecialFloatVal
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 :: SpecialFloatVal -> SpecialFloatVal -> SpecialFloatVal
$cmin :: SpecialFloatVal -> SpecialFloatVal -> SpecialFloatVal
max :: SpecialFloatVal -> SpecialFloatVal -> SpecialFloatVal
$cmax :: SpecialFloatVal -> SpecialFloatVal -> SpecialFloatVal
>= :: SpecialFloatVal -> SpecialFloatVal -> Bool
$c>= :: SpecialFloatVal -> SpecialFloatVal -> Bool
> :: SpecialFloatVal -> SpecialFloatVal -> Bool
$c> :: SpecialFloatVal -> SpecialFloatVal -> Bool
<= :: SpecialFloatVal -> SpecialFloatVal -> Bool
$c<= :: SpecialFloatVal -> SpecialFloatVal -> Bool
< :: SpecialFloatVal -> SpecialFloatVal -> Bool
$c< :: SpecialFloatVal -> SpecialFloatVal -> Bool
compare :: SpecialFloatVal -> SpecialFloatVal -> Ordering
$ccompare :: SpecialFloatVal -> SpecialFloatVal -> Ordering
Ord, ReadPrec [SpecialFloatVal]
ReadPrec SpecialFloatVal
Int -> ReadS SpecialFloatVal
ReadS [SpecialFloatVal]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpecialFloatVal]
$creadListPrec :: ReadPrec [SpecialFloatVal]
readPrec :: ReadPrec SpecialFloatVal
$creadPrec :: ReadPrec SpecialFloatVal
readList :: ReadS [SpecialFloatVal]
$creadList :: ReadS [SpecialFloatVal]
readsPrec :: Int -> ReadS SpecialFloatVal
$creadsPrec :: Int -> ReadS SpecialFloatVal
Read, Int -> SpecialFloatVal -> ShowS
[SpecialFloatVal] -> ShowS
SpecialFloatVal -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SpecialFloatVal] -> ShowS
$cshowList :: [SpecialFloatVal] -> ShowS
show :: SpecialFloatVal -> [Char]
$cshow :: SpecialFloatVal -> [Char]
showsPrec :: Int -> SpecialFloatVal -> ShowS
$cshowsPrec :: Int -> SpecialFloatVal -> ShowS
Show, forall x. Rep SpecialFloatVal x -> SpecialFloatVal
forall x. SpecialFloatVal -> Rep SpecialFloatVal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpecialFloatVal x -> SpecialFloatVal
$cfrom :: forall x. SpecialFloatVal -> Rep SpecialFloatVal x
Generic)
deriving [SpecialFloatVal] -> Portrayal
SpecialFloatVal -> Portrayal
forall a. (a -> Portrayal) -> ([a] -> Portrayal) -> Portray a
portrayList :: [SpecialFloatVal] -> Portrayal
$cportrayList :: [SpecialFloatVal] -> Portrayal
portray :: SpecialFloatVal -> Portrayal
$cportray :: SpecialFloatVal -> Portrayal
Portray via Wrapped Generic SpecialFloatVal
formatSpecialFloat :: SpecialFloatVal -> Text
formatSpecialFloat :: SpecialFloatVal -> Text
formatSpecialFloat = \case
SpecialFloatVal
NaN -> Text
"NaN"
Infinity Bool
neg -> (if Bool
neg then Text
"-" else Text
"") forall a. Semigroup a => a -> a -> a
<> Text
"Infinity"
data PortrayalF a
= NameF {-# UNPACK #-} !Ident
| LitIntBaseF !Base !Integer
| LitFloatF {-# UNPACK #-} !FloatLiteral
| SpecialFloatF !SpecialFloatVal
| LitStrF !Text
| LitCharF !Char
| OpaqueF !Text
| ApplyF a [a]
| BinopF !Ident !Infixity a a
| TupleF [a]
| ListF [a]
| LambdaCaseF [(a, a)]
| RecordF a [FactorPortrayal a]
| TyAppF a a
| TySigF a a
| QuotF !Text a
| UnlinesF [a]
| NestF !Int a
deriving (PortrayalF a -> PortrayalF a -> Bool
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, PortrayalF a -> PortrayalF a -> Ordering
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
Ord, ReadPrec [PortrayalF a]
ReadPrec (PortrayalF a)
ReadS [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
forall a. Show a => Int -> PortrayalF a -> ShowS
forall a. Show a => [PortrayalF a] -> ShowS
forall a. Show a => PortrayalF a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PortrayalF a] -> ShowS
$cshowList :: forall a. Show a => [PortrayalF a] -> ShowS
show :: PortrayalF a -> [Char]
$cshow :: forall a. Show a => PortrayalF a -> [Char]
showsPrec :: Int -> PortrayalF a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PortrayalF a -> ShowS
Show, 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
<$ :: forall a b. a -> PortrayalF b -> PortrayalF a
$c<$ :: forall a b. a -> PortrayalF b -> PortrayalF a
fmap :: forall a b. (a -> b) -> PortrayalF a -> PortrayalF b
$cfmap :: forall a b. (a -> b) -> PortrayalF a -> PortrayalF b
Functor, 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 :: forall a. Num a => PortrayalF a -> a
$cproduct :: forall a. Num a => PortrayalF a -> a
sum :: forall a. Num a => PortrayalF a -> a
$csum :: forall a. Num a => PortrayalF a -> a
minimum :: forall a. Ord a => PortrayalF a -> a
$cminimum :: forall a. Ord a => PortrayalF a -> a
maximum :: forall a. Ord a => PortrayalF a -> a
$cmaximum :: forall a. Ord a => PortrayalF a -> a
elem :: forall a. Eq a => a -> PortrayalF a -> Bool
$celem :: forall a. Eq a => a -> PortrayalF a -> Bool
length :: forall a. PortrayalF a -> Int
$clength :: forall a. PortrayalF a -> Int
null :: forall a. PortrayalF a -> Bool
$cnull :: forall a. PortrayalF a -> Bool
toList :: forall a. PortrayalF a -> [a]
$ctoList :: forall a. PortrayalF a -> [a]
foldl1 :: forall a. (a -> a -> a) -> PortrayalF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PortrayalF a -> a
foldr1 :: forall a. (a -> a -> a) -> PortrayalF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> PortrayalF a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> PortrayalF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> PortrayalF a -> b
foldl :: forall b a. (b -> a -> b) -> b -> PortrayalF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> PortrayalF a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> PortrayalF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> PortrayalF a -> b
foldr :: forall a b. (a -> b -> b) -> b -> PortrayalF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> PortrayalF a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> PortrayalF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> PortrayalF a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> PortrayalF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> PortrayalF a -> m
fold :: forall m. Monoid m => PortrayalF m -> m
$cfold :: forall m. Monoid m => PortrayalF m -> m
Foldable, Functor PortrayalF
Foldable PortrayalF
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 :: forall (m :: * -> *) a.
Monad m =>
PortrayalF (m a) -> m (PortrayalF a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
PortrayalF (m a) -> m (PortrayalF a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PortrayalF a -> m (PortrayalF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PortrayalF a -> m (PortrayalF b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
PortrayalF (f a) -> f (PortrayalF a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PortrayalF (f a) -> f (PortrayalF a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PortrayalF a -> f (PortrayalF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PortrayalF a -> f (PortrayalF b)
Traversable, 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
forall a. Portray a => [PortrayalF a] -> Portrayal
forall a. Portray a => PortrayalF a -> Portrayal
forall a. (a -> Portrayal) -> ([a] -> Portrayal) -> Portray a
portrayList :: [PortrayalF a] -> Portrayal
$cportrayList :: forall a. Portray a => [PortrayalF a] -> Portrayal
portray :: PortrayalF a -> Portrayal
$cportray :: forall a. Portray a => PortrayalF a -> Portrayal
Portray via Wrapped Generic (PortrayalF a)
pattern LitIntF :: Integer -> PortrayalF a
pattern $bLitIntF :: forall a. Integer -> PortrayalF a
$mLitIntF :: forall {r} {a}. PortrayalF a -> (Integer -> r) -> ((# #) -> r) -> r
LitIntF x <- LitIntBaseF _ x
where LitIntF Integer
x = forall a. Base -> Integer -> PortrayalF a
LitIntBaseF Base
Decimal Integer
x
matchLitRat :: PortrayalF a -> Maybe Rational
matchLitRat :: forall a. PortrayalF a -> Maybe Rational
matchLitRat (LitFloatF FloatLiteral
x) = forall a. a -> Maybe a
Just (FloatLiteral -> Rational
floatLiteralToRational FloatLiteral
x)
matchLitRat (SpecialFloatF SpecialFloatVal
x) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case SpecialFloatVal
x of
SpecialFloatVal
NaN -> Rational
notANumber
Infinity Bool
neg -> (if Bool
neg then forall a. Num a => a -> a
negate else forall a. a -> a
id) Rational
infinity
matchLitRat PortrayalF a
_ = forall a. Maybe a
Nothing
buildLitRat :: Rational -> PortrayalF a
buildLitRat :: forall a. Rational -> PortrayalF a
buildLitRat Rational
x
| Rational
x forall a. Eq a => a -> a -> Bool
== Rational
infinity = forall a. SpecialFloatVal -> PortrayalF a
SpecialFloatF (Bool -> SpecialFloatVal
Infinity Bool
False)
| Rational
x forall a. Eq a => a -> a -> Bool
== -Rational
infinity = forall a. SpecialFloatVal -> PortrayalF a
SpecialFloatF (Bool -> SpecialFloatVal
Infinity Bool
True)
| Rational
x forall a. Eq a => a -> a -> Bool
== Rational
notANumber = forall a. SpecialFloatVal -> PortrayalF a
SpecialFloatF SpecialFloatVal
NaN
| Bool
otherwise = forall a. FloatLiteral -> PortrayalF a
LitFloatF forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> FloatLiteral
floatToLiteral (forall a. Fractional a => Rational -> a
fromRational Rational
x :: Double)
pattern LitRatF :: Rational -> PortrayalF a
pattern $bLitRatF :: forall a. Rational -> PortrayalF a
$mLitRatF :: forall {r} {a}.
PortrayalF a -> (Rational -> r) -> ((# #) -> r) -> r
LitRatF x <- (matchLitRat -> Just x)
where LitRatF Rational
x = forall a. Rational -> PortrayalF a
buildLitRat Rational
x
{-# COMPLETE
NameF, LitIntF, LitRatF, LitStrF, LitCharF,
OpaqueF, ApplyF, BinopF, TupleF, ListF,
LambdaCaseF, RecordF, TyAppF, TySigF, QuotF,
UnlinesF, NestF
#-}
data FactorPortrayal a = FactorPortrayal
{ forall a. FactorPortrayal a -> Ident
_fpFieldName :: !Ident
, forall a. FactorPortrayal a -> a
_fpPortrayal :: a
}
deriving (FactorPortrayal a -> FactorPortrayal a -> Bool
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, FactorPortrayal a -> FactorPortrayal a -> Bool
FactorPortrayal a -> FactorPortrayal a -> Ordering
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
Ord, ReadPrec [FactorPortrayal a]
ReadPrec (FactorPortrayal a)
ReadS [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
forall a. Show a => Int -> FactorPortrayal a -> ShowS
forall a. Show a => [FactorPortrayal a] -> ShowS
forall a. Show a => FactorPortrayal a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FactorPortrayal a] -> ShowS
$cshowList :: forall a. Show a => [FactorPortrayal a] -> ShowS
show :: FactorPortrayal a -> [Char]
$cshow :: forall a. Show a => FactorPortrayal a -> [Char]
showsPrec :: Int -> FactorPortrayal a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FactorPortrayal a -> ShowS
Show, 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
<$ :: forall a b. a -> FactorPortrayal b -> FactorPortrayal a
$c<$ :: forall a b. a -> FactorPortrayal b -> FactorPortrayal a
fmap :: forall a b. (a -> b) -> FactorPortrayal a -> FactorPortrayal b
$cfmap :: forall a b. (a -> b) -> FactorPortrayal a -> FactorPortrayal b
Functor, 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 :: forall a. Num a => FactorPortrayal a -> a
$cproduct :: forall a. Num a => FactorPortrayal a -> a
sum :: forall a. Num a => FactorPortrayal a -> a
$csum :: forall a. Num a => FactorPortrayal a -> a
minimum :: forall a. Ord a => FactorPortrayal a -> a
$cminimum :: forall a. Ord a => FactorPortrayal a -> a
maximum :: forall a. Ord a => FactorPortrayal a -> a
$cmaximum :: forall a. Ord a => FactorPortrayal a -> a
elem :: forall a. Eq a => a -> FactorPortrayal a -> Bool
$celem :: forall a. Eq a => a -> FactorPortrayal a -> Bool
length :: forall a. FactorPortrayal a -> Int
$clength :: forall a. FactorPortrayal a -> Int
null :: forall a. FactorPortrayal a -> Bool
$cnull :: forall a. FactorPortrayal a -> Bool
toList :: forall a. FactorPortrayal a -> [a]
$ctoList :: forall a. FactorPortrayal a -> [a]
foldl1 :: forall a. (a -> a -> a) -> FactorPortrayal a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> FactorPortrayal a -> a
foldr1 :: forall a. (a -> a -> a) -> FactorPortrayal a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> FactorPortrayal a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> FactorPortrayal a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> FactorPortrayal a -> b
foldl :: forall b a. (b -> a -> b) -> b -> FactorPortrayal a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> FactorPortrayal a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> FactorPortrayal a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> FactorPortrayal a -> b
foldr :: forall a b. (a -> b -> b) -> b -> FactorPortrayal a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> FactorPortrayal a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> FactorPortrayal a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> FactorPortrayal a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> FactorPortrayal a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> FactorPortrayal a -> m
fold :: forall m. Monoid m => FactorPortrayal m -> m
$cfold :: forall m. Monoid m => FactorPortrayal m -> m
Foldable, Functor FactorPortrayal
Foldable FactorPortrayal
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 :: forall (m :: * -> *) a.
Monad m =>
FactorPortrayal (m a) -> m (FactorPortrayal a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
FactorPortrayal (m a) -> m (FactorPortrayal a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FactorPortrayal a -> m (FactorPortrayal b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FactorPortrayal a -> m (FactorPortrayal b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
FactorPortrayal (f a) -> f (FactorPortrayal a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
FactorPortrayal (f a) -> f (FactorPortrayal a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FactorPortrayal a -> f (FactorPortrayal b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FactorPortrayal a -> f (FactorPortrayal b)
Traversable, 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
forall a. Portray a => [FactorPortrayal a] -> Portrayal
forall a. Portray a => FactorPortrayal a -> Portrayal
forall a. (a -> Portrayal) -> ([a] -> Portrayal) -> Portray a
portrayList :: [FactorPortrayal a] -> Portrayal
$cportrayList :: forall a. Portray a => [FactorPortrayal a] -> Portrayal
portray :: FactorPortrayal a -> Portrayal
$cportray :: forall a. Portray a => FactorPortrayal a -> Portrayal
Portray via Wrapped Generic (FactorPortrayal a)
newtype Fix f = Fix (f (Fix f))
deriving 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)
newtype Portrayal = Portrayal { Portrayal -> Fix PortrayalF
unPortrayal :: Fix PortrayalF }
deriving stock (Portrayal -> Portrayal -> Bool
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. 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
forall a. (a -> Portrayal) -> ([a] -> Portrayal) -> Portray a
portrayList :: [Portrayal] -> Portrayal
$cportrayList :: [Portrayal] -> Portrayal
portray :: Portrayal -> Portrayal
$cportray :: Portrayal -> Portrayal
Portray, Int -> Portrayal -> ShowS
[Portrayal] -> ShowS
Portrayal -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Portrayal] -> ShowS
$cshowList :: [Portrayal] -> ShowS
show :: Portrayal -> [Char]
$cshow :: Portrayal -> [Char]
showsPrec :: Int -> Portrayal -> ShowS
$cshowsPrec :: Int -> Portrayal -> ShowS
Show, ReadPrec [Portrayal]
ReadPrec Portrayal
Int -> ReadS Portrayal
ReadS [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)
{-# COMPLETE
Name, LitInt, LitRat, LitStr, LitChar, Opaque, Apply, Binop, Tuple,
List, LambdaCase, Record, TyApp, TySig, Quot, Unlines, Nest
#-}
{-# COMPLETE
Name, LitIntBase, LitFloat, SpecialFloat, LitStr, LitChar,
Opaque, Apply, Binop, Tuple, List,
LambdaCase, Record, TyApp, TySig, Quot, Unlines, Nest
#-}
pattern Coerced :: Coercible a b => a -> b
pattern $bCoerced :: forall a b. Coercible a b => a -> b
$mCoerced :: forall {r} {a} {b}.
Coercible a b =>
b -> (a -> r) -> ((# #) -> r) -> r
Coerced x <- (coerce -> x)
where
Coerced a
x = coerce :: forall a b. Coercible a b => a -> b
coerce a
x
pattern Name :: Ident -> Portrayal
pattern $bName :: Ident -> Portrayal
$mName :: forall {r}. Portrayal -> (Ident -> r) -> ((# #) -> r) -> r
Name nm = Portrayal (Fix (NameF nm))
pattern LitInt :: Integer -> Portrayal
pattern $bLitInt :: Integer -> Portrayal
$mLitInt :: forall {r}. Portrayal -> (Integer -> r) -> ((# #) -> r) -> r
LitInt x = Portrayal (Fix (LitIntF x))
pattern LitIntBase :: Base -> Integer -> Portrayal
pattern $bLitIntBase :: Base -> Integer -> Portrayal
$mLitIntBase :: forall {r}.
Portrayal -> (Base -> Integer -> r) -> ((# #) -> r) -> r
LitIntBase b x = Portrayal (Fix (LitIntBaseF b x))
pattern LitRat :: Rational -> Portrayal
pattern $bLitRat :: Rational -> Portrayal
$mLitRat :: forall {r}. Portrayal -> (Rational -> r) -> ((# #) -> r) -> r
LitRat x = Portrayal (Fix (LitRatF x))
pattern LitFloat :: FloatLiteral -> Portrayal
pattern $bLitFloat :: FloatLiteral -> Portrayal
$mLitFloat :: forall {r}. Portrayal -> (FloatLiteral -> r) -> ((# #) -> r) -> r
LitFloat x = Portrayal (Fix (LitFloatF x))
pattern SpecialFloat :: SpecialFloatVal -> Portrayal
pattern $bSpecialFloat :: SpecialFloatVal -> Portrayal
$mSpecialFloat :: forall {r}.
Portrayal -> (SpecialFloatVal -> r) -> ((# #) -> r) -> r
SpecialFloat x = Portrayal (Fix (SpecialFloatF x))
pattern LitStr :: Text -> Portrayal
pattern $bLitStr :: Text -> Portrayal
$mLitStr :: forall {r}. Portrayal -> (Text -> r) -> ((# #) -> r) -> r
LitStr x = Portrayal (Fix (LitStrF x))
pattern LitChar :: Char -> Portrayal
pattern $bLitChar :: Char -> Portrayal
$mLitChar :: forall {r}. Portrayal -> (Char -> r) -> ((# #) -> r) -> r
LitChar x = Portrayal (Fix (LitCharF x))
pattern Opaque :: Text -> Portrayal
pattern $bOpaque :: Text -> Portrayal
$mOpaque :: forall {r}. Portrayal -> (Text -> r) -> ((# #) -> r) -> r
Opaque txt = Portrayal (Fix (OpaqueF txt))
pattern Apply :: Portrayal -> [Portrayal] -> Portrayal
pattern $bApply :: Portrayal -> [Portrayal] -> Portrayal
$mApply :: forall {r}.
Portrayal -> (Portrayal -> [Portrayal] -> r) -> ((# #) -> r) -> r
Apply f xs = Portrayal (Fix (ApplyF (Coerced f) (Coerced xs)))
pattern Binop
:: Ident -> Infixity -> Portrayal -> Portrayal -> Portrayal
pattern $bBinop :: Ident -> Infixity -> Portrayal -> Portrayal -> Portrayal
$mBinop :: forall {r}.
Portrayal
-> (Ident -> Infixity -> Portrayal -> Portrayal -> r)
-> ((# #) -> r)
-> r
Binop nm inf x y =
Portrayal (Fix (BinopF nm inf (Coerced x) (Coerced y)))
pattern List :: [Portrayal] -> Portrayal
pattern $bList :: [Portrayal] -> Portrayal
$mList :: forall {r}. Portrayal -> ([Portrayal] -> r) -> ((# #) -> r) -> r
List xs = Portrayal (Fix (ListF (Coerced xs)))
pattern Tuple :: [Portrayal] -> Portrayal
pattern $bTuple :: [Portrayal] -> Portrayal
$mTuple :: forall {r}. Portrayal -> ([Portrayal] -> r) -> ((# #) -> r) -> r
Tuple xs = Portrayal (Fix (TupleF (Coerced xs)))
pattern LambdaCase :: [(Portrayal, Portrayal)] -> Portrayal
pattern $bLambdaCase :: [(Portrayal, Portrayal)] -> Portrayal
$mLambdaCase :: forall {r}.
Portrayal -> ([(Portrayal, Portrayal)] -> r) -> ((# #) -> r) -> r
LambdaCase xs = Portrayal (Fix (LambdaCaseF (Coerced xs)))
pattern Record :: Portrayal -> [FactorPortrayal Portrayal] -> Portrayal
pattern $bRecord :: Portrayal -> [FactorPortrayal Portrayal] -> Portrayal
$mRecord :: forall {r}.
Portrayal
-> (Portrayal -> [FactorPortrayal Portrayal] -> r)
-> ((# #) -> r)
-> r
Record x xs = Portrayal (Fix (RecordF (Coerced x) (Coerced xs)))
pattern TyApp :: Portrayal -> Portrayal -> Portrayal
pattern $bTyApp :: Portrayal -> Portrayal -> Portrayal
$mTyApp :: forall {r}.
Portrayal -> (Portrayal -> Portrayal -> r) -> ((# #) -> r) -> r
TyApp x t = Portrayal (Fix (TyAppF (Coerced x) (Coerced t)))
pattern TySig :: Portrayal -> Portrayal -> Portrayal
pattern $bTySig :: Portrayal -> Portrayal -> Portrayal
$mTySig :: forall {r}.
Portrayal -> (Portrayal -> Portrayal -> r) -> ((# #) -> r) -> r
TySig x t = Portrayal (Fix (TySigF (Coerced x) (Coerced t)))
pattern Quot :: Text -> Portrayal -> Portrayal
pattern $bQuot :: Text -> Portrayal -> Portrayal
$mQuot :: forall {r}.
Portrayal -> (Text -> Portrayal -> r) -> ((# #) -> r) -> r
Quot t x = Portrayal (Fix (QuotF t (Coerced x)))
pattern Unlines :: [Portrayal] -> Portrayal
pattern $bUnlines :: [Portrayal] -> Portrayal
$mUnlines :: forall {r}. Portrayal -> ([Portrayal] -> r) -> ((# #) -> r) -> r
Unlines xs = Portrayal (Fix (UnlinesF (Coerced xs)))
pattern Nest :: Int -> Portrayal -> Portrayal
pattern $bNest :: Int -> Portrayal -> Portrayal
$mNest :: forall {r}.
Portrayal -> (Int -> Portrayal -> r) -> ((# #) -> r) -> r
Nest n x = Portrayal (Fix (NestF n (Coerced x)))
class Portray a where
portray :: a -> Portrayal
portrayList :: [a] -> Portrayal
portrayList = [Portrayal] -> Portrayal
List forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Portray a => a -> Portrayal
portray
showAtom :: Show a => a -> Portrayal
showAtom :: forall a. Show a => a -> Portrayal
showAtom = [Char] -> Portrayal
strAtom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show
strAtom :: String -> Portrayal
strAtom :: [Char] -> Portrayal
strAtom = Text -> Portrayal
Opaque forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
strQuot :: String -> Portrayal -> Portrayal
strQuot :: [Char] -> Portrayal -> Portrayal
strQuot = Text -> Portrayal -> Portrayal
Quot forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
strBinop
:: IdentKind -> String -> Infixity -> Portrayal -> Portrayal -> Portrayal
strBinop :: IdentKind
-> [Char] -> Infixity -> Portrayal -> Portrayal -> Portrayal
strBinop IdentKind
k = Ident -> Infixity -> Portrayal -> Portrayal -> Portrayal
Binop forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentKind -> Text -> Ident
Ident IdentKind
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
class GPortrayProduct f where
gportrayProduct
:: f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
instance GPortrayProduct U1 where
gportrayProduct :: forall (a :: k).
U1 a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
gportrayProduct U1 a
U1 = forall a. a -> a
id
selIdent :: String -> Ident
selIdent :: [Char] -> Ident
selIdent [Char]
nm = IdentKind -> Text -> Ident
Ident IdentKind
k ([Char] -> Text
T.pack [Char]
nm)
where
k :: IdentKind
k = case [Char]
nm of
(Char
c:[Char]
_) | Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' -> IdentKind
VarIdent
[Char]
_ -> IdentKind
OpIdent
instance (Selector s, Portray a) => GPortrayProduct (S1 s (K1 i a)) where
gportrayProduct :: forall (a :: k).
S1 s (K1 i a) a
-> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
gportrayProduct (M1 (K1 a
x)) =
(forall a. Ident -> a -> FactorPortrayal a
FactorPortrayal ([Char] -> Ident
selIdent forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName @s forall a. HasCallStack => a
undefined) (forall a. Portray a => a -> Portrayal
portray a
x) forall a. a -> [a] -> [a]
:)
instance (GPortrayProduct f, GPortrayProduct g)
=> GPortrayProduct (f :*: g) where
gportrayProduct :: forall (a :: k).
(:*:) f g a
-> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
gportrayProduct (f a
f :*: g a
g) = forall {k} (f :: k -> *) (a :: k).
GPortrayProduct f =>
f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
gportrayProduct f a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k).
GPortrayProduct f =>
f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
gportrayProduct g a
g
data GPortrayConfig = GPortrayConfig
{ GPortrayConfig -> Bool
_cfgUseRecordSyntax :: Bool
}
defaultGPortrayConfig :: GPortrayConfig
defaultGPortrayConfig :: GPortrayConfig
defaultGPortrayConfig = Bool -> GPortrayConfig
GPortrayConfig Bool
True
type AnLens s a = forall f. Functor f => (a -> f a) -> s -> f s
useRecordSyntax :: AnLens GPortrayConfig Bool
useRecordSyntax :: AnLens GPortrayConfig Bool
useRecordSyntax Bool -> f Bool
f (GPortrayConfig Bool
rec) = Bool -> GPortrayConfig
GPortrayConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f Bool
rec
suppressRecordSyntax :: GPortrayConfig -> GPortrayConfig
suppressRecordSyntax :: GPortrayConfig -> GPortrayConfig
suppressRecordSyntax GPortrayConfig
_ = Bool -> GPortrayConfig
GPortrayConfig Bool
False
class GPortray f where
gportrayCfg :: GPortrayConfig -> f a -> Portrayal
instance GPortray f => GPortray (D1 d f) where
gportrayCfg :: forall (a :: k). GPortrayConfig -> D1 d f a -> Portrayal
gportrayCfg GPortrayConfig
rec (M1 f a
x) = forall {k} (f :: k -> *) (a :: k).
GPortray f =>
GPortrayConfig -> f a -> Portrayal
gportrayCfg GPortrayConfig
rec f a
x
instance GPortray V1 where
gportrayCfg :: forall (a :: k). GPortrayConfig -> V1 a -> Portrayal
gportrayCfg GPortrayConfig
_ V1 a
x = case V1 a
x of {}
instance (GPortray f, GPortray g) => GPortray (f :+: g) where
gportrayCfg :: forall (a :: k). GPortrayConfig -> (:+:) f g a -> Portrayal
gportrayCfg GPortrayConfig
rec (L1 f a
f) = forall {k} (f :: k -> *) (a :: k).
GPortray f =>
GPortrayConfig -> f a -> Portrayal
gportrayCfg GPortrayConfig
rec f a
f
gportrayCfg GPortrayConfig
rec (R1 g a
g) = forall {k} (f :: k -> *) (a :: k).
GPortray f =>
GPortrayConfig -> f a -> Portrayal
gportrayCfg GPortrayConfig
rec g a
g
detectConKind :: String -> IdentKind
detectConKind :: [Char] -> IdentKind
detectConKind = \case (Char
':':[Char]
_) -> IdentKind
OpConIdent; [Char]
_ -> IdentKind
ConIdent
conIdent :: String -> Ident
conIdent :: [Char] -> Ident
conIdent [Char]
con = IdentKind -> Text -> Ident
Ident ([Char] -> IdentKind
detectConKind [Char]
con) ([Char] -> Text
T.pack [Char]
con)
prefixCon :: String -> Portrayal
prefixCon :: [Char] -> Portrayal
prefixCon = Ident -> Portrayal
Name forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Ident
conIdent
toAssoc :: Associativity -> Assoc
toAssoc :: Associativity -> Assoc
toAssoc = \case
Associativity
LeftAssociative -> Assoc
AssocL
Associativity
RightAssociative -> Assoc
AssocR
Associativity
NotAssociative -> Assoc
AssocNope
instance (Constructor c, GPortrayProduct f) => GPortray (C1 c f) where
gportrayCfg :: forall (a :: k). GPortrayConfig -> C1 c f a -> Portrayal
gportrayCfg GPortrayConfig{Bool
_cfgUseRecordSyntax :: Bool
_cfgUseRecordSyntax :: GPortrayConfig -> Bool
..} (M1 f a
x0)
| Bool
_cfgUseRecordSyntax Bool -> Bool -> Bool
&& forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
conIsRecord @c forall a. HasCallStack => a
undefined =
Portrayal -> [FactorPortrayal Portrayal] -> Portrayal
Record
([Char] -> Portrayal
prefixCon forall a b. (a -> b) -> a -> b
$ forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName @c forall a. HasCallStack => a
undefined)
(forall {k} (f :: k -> *) (a :: k).
GPortrayProduct f =>
f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
gportrayProduct f a
x0 [])
| Bool
otherwise =
case ([Char]
nm, forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Fixity
conFixity @c forall a. HasCallStack => a
undefined, [Portrayal]
args) of
(Char
'(' : Char
',' : [Char]
_, Fixity
_, [Portrayal]
_) -> [Portrayal] -> Portrayal
Tuple [Portrayal]
args
([Char]
_, Infix Associativity
lr Int
p, [Portrayal
x, Portrayal
y]) -> Ident -> Infixity -> Portrayal -> Portrayal -> Portrayal
Binop
([Char] -> Ident
conIdent [Char]
nm)
(Assoc -> Rational -> Infixity
Infixity (Associativity -> Assoc
toAssoc Associativity
lr) (forall a. Real a => a -> Rational
toRational Int
p))
Portrayal
x
Portrayal
y
([Char]
_, Fixity
_, []) -> [Char] -> Portrayal
prefixCon [Char]
nm
([Char], Fixity, [Portrayal])
_ -> Portrayal -> [Portrayal] -> Portrayal
Apply ([Char] -> Portrayal
prefixCon [Char]
nm) [Portrayal]
args
where
args :: [Portrayal]
args = forall a. FactorPortrayal a -> a
_fpPortrayal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (f :: k -> *) (a :: k).
GPortrayProduct f =>
f a -> [FactorPortrayal Portrayal] -> [FactorPortrayal Portrayal]
gportrayProduct f a
x0 []
nm :: [Char]
nm = forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName @c forall a. HasCallStack => a
undefined
gportray :: GPortray f => f a -> Portrayal
gportray :: forall {k} (f :: k -> *) (a :: k). GPortray f => f a -> Portrayal
gportray = forall {k} (f :: k -> *) (a :: k).
GPortray f =>
GPortrayConfig -> f a -> Portrayal
gportrayCfg GPortrayConfig
defaultGPortrayConfig
genericPortray
:: (Generic a, GPortray (Rep a)) => GPortrayConfig -> a -> Portrayal
genericPortray :: forall a.
(Generic a, GPortray (Rep a)) =>
GPortrayConfig -> a -> Portrayal
genericPortray GPortrayConfig
cfg = forall {k} (f :: k -> *) (a :: k).
GPortray f =>
GPortrayConfig -> f a -> Portrayal
gportrayCfg GPortrayConfig
cfg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from
instance (Generic a, GPortray (Rep a)) => Portray (Wrapped Generic a) where
portray :: Wrapped Generic a -> Portrayal
portray (Wrapped a
x) = forall a.
(Generic a, GPortray (Rep a)) =>
GPortrayConfig -> a -> Portrayal
genericPortray GPortrayConfig
defaultGPortrayConfig a
x
newtype PortrayDataCons a = PortrayDataCons a
instance (Generic a, GPortray (Rep a)) => Portray (PortrayDataCons a) where
portray :: PortrayDataCons a -> Portrayal
portray (PortrayDataCons a
x) = forall a.
(Generic a, GPortray (Rep a)) =>
GPortrayConfig -> a -> Portrayal
genericPortray (Bool -> GPortrayConfig
GPortrayConfig Bool
False) a
x
newtype PortrayIntLit a = PortrayIntLit a
instance Integral a => Portray (PortrayIntLit a) where
portray :: PortrayIntLit a -> Portrayal
portray (PortrayIntLit a
x) = Integer -> Portrayal
LitInt (forall a. Integral a => a -> Integer
toInteger a
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
newtype PortrayRatLit a = PortrayRatLit a
instance Real a => Portray (PortrayRatLit a) where
portray :: PortrayRatLit a -> Portrayal
portray (PortrayRatLit a
x) = Rational -> Portrayal
LitRat (forall a. Real a => a -> Rational
toRational a
x)
newtype PortrayFloatLit a = PortrayFloatLit a
instance RealFloat a => Portray (PortrayFloatLit a) where
portray :: PortrayFloatLit a -> Portrayal
portray (PortrayFloatLit a
x)
| forall a. RealFloat a => a -> Bool
isInfinite a
x = SpecialFloatVal -> Portrayal
SpecialFloat (Bool -> SpecialFloatVal
Infinity (a
x forall a. Ord a => a -> a -> Bool
< a
0))
| forall a. RealFloat a => a -> Bool
isNaN a
x = SpecialFloatVal -> Portrayal
SpecialFloat SpecialFloatVal
NaN
| Bool
otherwise = FloatLiteral -> Portrayal
LitFloat (forall a. RealFloat a => a -> FloatLiteral
floatToLiteral a
x)
deriving via PortrayFloatLit Float instance Portray Float
deriving via PortrayFloatLit Double instance Portray Double
fixedToLiteral :: forall a. HasResolution a => Fixed a -> FloatLiteral
fixedToLiteral :: forall {k} (a :: k). HasResolution a => Fixed a -> FloatLiteral
fixedToLiteral it :: Fixed a
it@(MkFixed Integer
x) =
Bool -> Text -> Int -> FloatLiteral
FloatLiteral
(Integer
x forall a. Ord a => a -> a -> Bool
< Integer
0)
([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
wholePart forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
take Int
fracDigits ([Char]
fracPart forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Char
'0'))
(forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
wholePart)
where
denom :: Integer
denom = forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution Fixed a
it
(Integer
whole, Integer
frac) = forall a. Integral a => a -> a -> (a, a)
divMod (forall a. Num a => a -> a
abs Integer
x) Integer
denom
wholePart :: [Char]
wholePart = forall a. Show a => a -> [Char]
show Integer
whole
fracDigits :: Int
fracDigits :: Int
fracDigits = forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$ (forall a. Floating a => a -> a -> a
logBase Double
10 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
denom) :: Double)
fracPart :: [Char]
fracPart = forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ (Integer
frac forall a. Num a => a -> a -> a
* Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
fracDigits forall a. Num a => a -> a -> a
+ Integer
denom forall a. Num a => a -> a -> a
- Integer
1) forall a. Integral a => a -> a -> a
`div` Integer
denom
instance HasResolution a => Portray (Fixed a) where
portray :: Fixed a -> Portrayal
portray = FloatLiteral -> Portrayal
LitFloat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k). HasResolution a => Fixed a -> FloatLiteral
fixedToLiteral
newtype ShowAtom a = ShowAtom { forall a. ShowAtom a -> a
unShowAtom :: a }
instance Show a => Portray (ShowAtom a) where
portray :: ShowAtom a -> Portrayal
portray = forall a. Show a => a -> Portrayal
showAtom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ShowAtom a -> a
unShowAtom
instance Portray Char where
portray :: Char -> Portrayal
portray = Char -> Portrayal
LitChar
portrayList :: [Char] -> Portrayal
portrayList = Text -> Portrayal
LitStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
instance Portray () where portray :: () -> Portrayal
portray () = [Portrayal] -> Portrayal
Tuple []
instance Portray Text where portray :: Text -> Portrayal
portray = Text -> Portrayal
LitStr
instance Portray BS.ByteString where portray :: ByteString -> Portrayal
portray = Text -> Portrayal
LitStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BS.unpack
instance Portray BL.ByteString where portray :: ByteString -> Portrayal
portray = Text -> Portrayal
LitStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BL.unpack
instance Portray SBS.ShortByteString where
portray :: ShortByteString -> Portrayal
portray = Text -> Portrayal
LitStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
BS.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort
instance Portray a => Portray (Ratio a) where
portray :: Ratio a -> Portrayal
portray Ratio a
x = Ident -> Infixity -> Portrayal -> Portrayal -> Portrayal
Binop (IdentKind -> Text -> Ident
Ident IdentKind
OpIdent Text
"%") (Rational -> Infixity
infixl_ Rational
7)
(forall a. Portray a => a -> Portrayal
portray forall a b. (a -> b) -> a -> b
$ forall a. Ratio a -> a
numerator Ratio a
x)
(forall a. Portray a => a -> Portrayal
portray forall a b. (a -> b) -> a -> b
$ 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
deriving via Wrapped Generic Bool instance Portray Bool
instance Portray a => Portray (Identity a) where
portray :: Identity a -> Portrayal
portray (Identity a
x) = Portrayal -> [Portrayal] -> Portrayal
Apply (Ident -> Portrayal
Name forall a b. (a -> b) -> a -> b
$ IdentKind -> Text -> Ident
Ident IdentKind
ConIdent Text
"Identity") [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 (Ident -> Portrayal
Name forall a b. (a -> b) -> a -> b
$ IdentKind -> Text -> Ident
Ident IdentKind
ConIdent Text
"Const") [forall a. Portray a => a -> Portrayal
portray a
x]
instance Portray a => Portray [a] where
portray :: [a] -> Portrayal
portray = forall a. Portray a => [a] -> Portrayal
portrayList
deriving via Wrapped Generic (Proxy a) instance Portray (Proxy a)
instance Portray a => Portray (Sum a) where
portray :: Sum a -> Portrayal
portray (Sum a
x) = case forall a. Portray a => a -> Portrayal
portray a
x of
LitInt Integer
n -> Integer -> Portrayal
LitInt Integer
n
Portrayal
p -> Portrayal -> [Portrayal] -> Portrayal
Apply (Ident -> Portrayal
Name forall a b. (a -> b) -> a -> b
$ IdentKind -> Text -> Ident
Ident IdentKind
ConIdent Text
"Sum") [Portrayal
p]
instance Portray a => Portray (Product a) where
portray :: Product a -> Portrayal
portray (Product a
x) = case forall a. Portray a => a -> Portrayal
portray a
x of
LitInt Integer
n -> Integer -> Portrayal
LitInt Integer
n
Portrayal
p -> Portrayal -> [Portrayal] -> Portrayal
Apply (Ident -> Portrayal
Name forall a b. (a -> b) -> a -> b
$ IdentKind -> Text -> Ident
Ident IdentKind
ConIdent Text
"Product") [Portrayal
p]
instance Portray TyCon where
portray :: TyCon -> Portrayal
portray TyCon
tc = case [Char]
nm of
(Char
c:[Char]
_) | Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\'', Char
'"'] -> Text -> Portrayal
Opaque ([Char] -> Text
T.pack [Char]
nm)
[Char]
_ -> [Char] -> Portrayal
prefixCon [Char]
nm
where
nm :: [Char]
nm = TyCon -> [Char]
tyConName TyCon
tc
portraySomeType :: SomeTypeRep -> Portrayal
portraySomeType :: SomeTypeRep -> Portrayal
portraySomeType (SomeTypeRep TypeRep a
ty) = forall {k} (a :: k). TypeRep a -> Portrayal
portrayType TypeRep a
ty
portrayType :: TypeRep a -> Portrayal
portrayType :: forall {k} (a :: k). TypeRep a -> Portrayal
portrayType = \case
TypeRep a
special | forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep a
special forall a. Eq a => a -> a -> Bool
== forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Type) ->
Ident -> Portrayal
Name forall a b. (a -> b) -> a -> b
$ IdentKind -> Text -> Ident
Ident IdentKind
ConIdent Text
"Type"
Fun TypeRep arg
a TypeRep res
b ->
Ident -> Infixity -> Portrayal -> Portrayal -> Portrayal
Binop (IdentKind -> Text -> Ident
Ident IdentKind
OpIdent Text
"->") (Rational -> Infixity
infixr_ (-Rational
1)) (forall {k} (a :: k). TypeRep a -> Portrayal
portrayType TypeRep arg
a) (forall {k} (a :: k). TypeRep a -> Portrayal
portrayType TypeRep res
b)
App TypeRep a
f TypeRep b
x -> Portrayal -> [Portrayal] -> Portrayal
Apply (forall {k} (a :: k). TypeRep a -> Portrayal
portrayType TypeRep a
f) [forall {k} (a :: k). TypeRep a -> Portrayal
portrayType TypeRep b
x]
Con' TyCon
con [SomeTypeRep]
tys -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Portrayal
x -> Portrayal -> Portrayal -> Portrayal
TyApp Portrayal
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeTypeRep -> Portrayal
portraySomeType) (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 (Ident -> Portrayal
Name forall a b. (a -> b) -> a -> b
$ IdentKind -> Text -> Ident
Ident IdentKind
VarIdent Text
"typeRep") forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (Ident -> Portrayal
Name forall a b. (a -> b) -> a -> b
$ IdentKind -> Text -> Ident
Ident IdentKind
ConIdent Text
"SomeTypeRep") (forall {k} (a :: k). TypeRep a -> Portrayal
portrayType TypeRep a
ty))
[Ident -> Portrayal
Name forall a b. (a -> b) -> a -> b
$ IdentKind -> Text -> Ident
Ident IdentKind
VarIdent Text
"typeRep"]
instance Portray (a :~: b) where portray :: (a :~: b) -> Portrayal
portray a :~: b
Refl = Ident -> Portrayal
Name forall a b. (a -> b) -> a -> b
$ IdentKind -> Text -> Ident
Ident IdentKind
ConIdent Text
"Refl"
instance Portray (Coercion a b) where
portray :: Coercion a b -> Portrayal
portray Coercion a b
Coercion = Ident -> Portrayal
Name forall a b. (a -> b) -> a -> b
$ IdentKind -> Text -> Ident
Ident IdentKind
ConIdent Text
"Coercion"
instance (IsList a, Portray (Exts.Item a)) => Portray (Wrapped IsList a) where
portray :: Wrapped IsList a -> Portrayal
portray =
Portrayal -> [Portrayal] -> Portrayal
Apply (Ident -> Portrayal
Name forall a b. (a -> b) -> a -> b
$ IdentKind -> Text -> Ident
Ident IdentKind
VarIdent Text
"fromList") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Portray a => a -> Portrayal
portray forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
portrayCallStack :: [(String, SrcLoc)] -> Portrayal
portrayCallStack :: [([Char], SrcLoc)] -> Portrayal
portrayCallStack [([Char], SrcLoc)]
xs = [Portrayal] -> Portrayal
Unlines
[ Text -> Portrayal
Opaque Text
"GHC.Stack.CallStack:"
, Int -> Portrayal -> Portrayal
Nest Int
2 forall a b. (a -> b) -> a -> b
$ [Portrayal] -> Portrayal
Unlines
[ [Char] -> Portrayal
strAtom ([Char]
func forall a. [a] -> [a] -> [a]
++ [Char]
", called at " forall a. [a] -> [a] -> [a]
++ SrcLoc -> [Char]
prettySrcLoc SrcLoc
loc)
| ([Char]
func, SrcLoc
loc) <- [([Char], SrcLoc)]
xs
]
]
instance Portray CallStack where
portray :: CallStack -> Portrayal
portray CallStack
cs = case CallStack -> [([Char], SrcLoc)]
getCallStack CallStack
cs of
[] -> Ident -> Portrayal
Name forall a b. (a -> b) -> a -> b
$ IdentKind -> Text -> Ident
Ident IdentKind
VarIdent Text
"emptyCallStack"
[([Char], SrcLoc)]
xs -> [Char] -> Portrayal -> Portrayal
strQuot [Char]
"callStack" forall a b. (a -> b) -> a -> b
$ [([Char], SrcLoc)] -> Portrayal
portrayCallStack [([Char], SrcLoc)]
xs
cata :: Functor f => (f a -> a) -> Fix f -> a
cata :: forall (f :: * -> *) a. Functor f => (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 forall a b. (a -> b) -> a -> b
$ Fix f -> a
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Fix f)
fa