{-|
  Copyright   :  (C) 2012-2016, University of Twente,
                     2016     , Myrtle Software Ltd,
                     2021-2022, QBayLogic B.V.
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>

  PrettyPrec printing class and instances for CoreHW
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Clash.Core.Pretty
  ( PrettyPrec (..)
  , PrettyOptions (..)
  , ClashDoc
  , ClashAnnotation (..)
  , SyntaxElement (..)
  , ppr, ppr'
  , showPpr, showPpr'
  , tracePprId
  , tracePpr
  , fromPpr
  , unsafeLookupEnvBool
  )
where

import Data.Char                        (isSymbol, isUpper, ord)
import Data.Default                     (Default(..))
import Data.Text                        (Text)
import Control.Monad.Identity
import Data.Binary.IEEE754              (wordToDouble, wordToFloat)
import Data.List.Extra                  ((<:>))
import qualified Data.Text              as T
import Data.Maybe                       (fromMaybe)
#if MIN_VERSION_prettyprinter(1,7,0)
import Prettyprinter
import Prettyprinter.Internal
#else
import Data.Text.Prettyprint.Doc
import Data.Text.Prettyprint.Doc.Internal
#endif
import GHC.Show                         (showMultiLineString)
import GHC.Stack                        (HasCallStack)
#if MIN_VERSION_ghc(9,0,0)
import qualified GHC.Utils.Outputable   as GHC
#else
import qualified Outputable             as GHC
#endif
import System.Environment               (lookupEnv)
import System.IO.Unsafe                 (unsafePerformIO)
import Text.Read                        (readMaybe)

import Clash.Core.DataCon               (DataCon (..))
import Clash.Core.Literal               (Literal (..))
import Clash.Core.Name                  (Name (..))
import Clash.Core.Term
  (Pat (..), Term (..), TickInfo (..), NameMod (..), CoreContext (..), primArg, PrimInfo(primName),Bind(..))
import Clash.Core.TyCon                 (TyCon (..), TyConName, isTupleTyConLike, AlgTyConRhs(..))
import Clash.Core.Type                  (ConstTy (..), Kind, LitTy (..),
                                         Type (..), TypeView (..), tyView,mkTyConApp)
import Clash.Core.Var                   (Id, TyVar, Var (..), IdScope(..))
import Clash.Debug                      (trace)
import Clash.Util
import qualified Clash.Util.Interpolate as I
import Clash.Pretty

unsafeLookupEnvBool :: HasCallStack =>  String -> Bool -> Bool
unsafeLookupEnvBool :: HasCallStack => String -> Bool -> Bool
unsafeLookupEnvBool String
key Bool
dflt =
  case IO (Maybe String) -> Maybe String
forall a. IO a -> a
unsafePerformIO (String -> IO (Maybe String)
lookupEnv String
key) of
    Maybe String
Nothing -> Bool
dflt
    Just String
a -> (Bool -> Maybe Bool -> Bool) -> Maybe Bool -> Bool -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (String -> Maybe Bool
forall a. Read a => String -> Maybe a
readMaybe String
a) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall a. HasCallStack => String -> a
error [I.i|
      'unsafeLookupEnvBool' tried to lookup #{key} in the environment. It found
      it, but couldn't interpret it to as a Bool. Expected one of: True, False.
      But found:

        #{a}
    |]

-- | Options for the pretty-printer, controlling which elements to hide.
data PrettyOptions = PrettyOptions
  { PrettyOptions -> Bool
displayUniques    :: Bool
  -- ^ whether to display unique identifiers
  , PrettyOptions -> Bool
displayTypes      :: Bool
  -- ^ whether to display type information
  , PrettyOptions -> Bool
displayQualifiers :: Bool
  -- ^ whether to display module qualifiers
  , PrettyOptions -> Bool
displayTicks      :: Bool
  -- ^ whether to display ticks
  }

instance Default PrettyOptions where
  def :: PrettyOptions
def = PrettyOptions
    { displayUniques :: Bool
displayUniques    = HasCallStack => String -> Bool -> Bool
String -> Bool -> Bool
unsafeLookupEnvBool String
"CLASH_PPR_UNIQUES" Bool
True
    , displayTypes :: Bool
displayTypes      = HasCallStack => String -> Bool -> Bool
String -> Bool -> Bool
unsafeLookupEnvBool String
"CLASH_PPR_TYPES" Bool
True
    , displayQualifiers :: Bool
displayQualifiers = HasCallStack => String -> Bool -> Bool
String -> Bool -> Bool
unsafeLookupEnvBool String
"CLASH_PPR_QUALIFIERS" Bool
True
    , displayTicks :: Bool
displayTicks      = HasCallStack => String -> Bool -> Bool
String -> Bool -> Bool
unsafeLookupEnvBool String
"CLASH_PPR_TICKS" Bool
True
    }

-- | Annotations carried on pretty-printed code.
data ClashAnnotation
  = AnnContext CoreContext
  -- ^ marking navigation to a different context
  | AnnSyntax  SyntaxElement
  -- ^ marking a specific sort of syntax
  deriving ClashAnnotation -> ClashAnnotation -> Bool
(ClashAnnotation -> ClashAnnotation -> Bool)
-> (ClashAnnotation -> ClashAnnotation -> Bool)
-> Eq ClashAnnotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClashAnnotation -> ClashAnnotation -> Bool
== :: ClashAnnotation -> ClashAnnotation -> Bool
$c/= :: ClashAnnotation -> ClashAnnotation -> Bool
/= :: ClashAnnotation -> ClashAnnotation -> Bool
Eq

-- | Specific places in the program syntax.
data SyntaxElement = Keyword | LitS | Type | Unique | Qualifier | Ticky
  deriving (SyntaxElement -> SyntaxElement -> Bool
(SyntaxElement -> SyntaxElement -> Bool)
-> (SyntaxElement -> SyntaxElement -> Bool) -> Eq SyntaxElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SyntaxElement -> SyntaxElement -> Bool
== :: SyntaxElement -> SyntaxElement -> Bool
$c/= :: SyntaxElement -> SyntaxElement -> Bool
/= :: SyntaxElement -> SyntaxElement -> Bool
Eq, Int -> SyntaxElement -> String -> String
[SyntaxElement] -> String -> String
SyntaxElement -> String
(Int -> SyntaxElement -> String -> String)
-> (SyntaxElement -> String)
-> ([SyntaxElement] -> String -> String)
-> Show SyntaxElement
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SyntaxElement -> String -> String
showsPrec :: Int -> SyntaxElement -> String -> String
$cshow :: SyntaxElement -> String
show :: SyntaxElement -> String
$cshowList :: [SyntaxElement] -> String -> String
showList :: [SyntaxElement] -> String -> String
Show)

-- | Clash's specialized @Doc@ type holds metadata of type @ClashAnnotation@.
type ClashDoc = Doc ClashAnnotation

-- | PrettyPrec printing Show-like typeclass
class PrettyPrec p where

  -- default pretty-printing without hiding
  pprPrec :: Monad m => Rational -> p -> m ClashDoc

  -- pretty-printing with hiding options
  -- NB: we utilise the syntax annotations to hide the requested parts of syntax
  pprPrec' :: Monad m => PrettyOptions -> Rational -> p -> m ClashDoc
  pprPrec' PrettyOptions
opts Rational
p = (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc ClashAnnotation -> Doc ClashAnnotation
hide (m (Doc ClashAnnotation) -> m (Doc ClashAnnotation))
-> (p -> m (Doc ClashAnnotation)) -> p -> m (Doc ClashAnnotation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> p -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> p -> m (Doc ClashAnnotation)
pprPrec Rational
p
    where
      hide :: Doc ClashAnnotation -> Doc ClashAnnotation
hide = \case
        FlatAlt Doc ClashAnnotation
d Doc ClashAnnotation
d'         -> Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
FlatAlt (Doc ClashAnnotation -> Doc ClashAnnotation
hide Doc ClashAnnotation
d) (Doc ClashAnnotation -> Doc ClashAnnotation
hide Doc ClashAnnotation
d')
        Cat Doc ClashAnnotation
d Doc ClashAnnotation
d'             -> Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
Cat (Doc ClashAnnotation -> Doc ClashAnnotation
hide Doc ClashAnnotation
d) (Doc ClashAnnotation -> Doc ClashAnnotation
hide Doc ClashAnnotation
d')
        Nest Int
i Doc ClashAnnotation
d             -> Int -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Int -> Doc ann -> Doc ann
Nest Int
i (Doc ClashAnnotation -> Doc ClashAnnotation
hide Doc ClashAnnotation
d)
        Union Doc ClashAnnotation
d Doc ClashAnnotation
d'           -> Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
Union (Doc ClashAnnotation -> Doc ClashAnnotation
hide Doc ClashAnnotation
d) (Doc ClashAnnotation -> Doc ClashAnnotation
hide Doc ClashAnnotation
d')
        Column Int -> Doc ClashAnnotation
f             -> (Int -> Doc ClashAnnotation) -> Doc ClashAnnotation
forall ann. (Int -> Doc ann) -> Doc ann
Column (Doc ClashAnnotation -> Doc ClashAnnotation
hide (Doc ClashAnnotation -> Doc ClashAnnotation)
-> (Int -> Doc ClashAnnotation) -> Int -> Doc ClashAnnotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc ClashAnnotation
f)
        WithPageWidth PageWidth -> Doc ClashAnnotation
f      -> (PageWidth -> Doc ClashAnnotation) -> Doc ClashAnnotation
forall ann. (PageWidth -> Doc ann) -> Doc ann
WithPageWidth (Doc ClashAnnotation -> Doc ClashAnnotation
hide (Doc ClashAnnotation -> Doc ClashAnnotation)
-> (PageWidth -> Doc ClashAnnotation)
-> PageWidth
-> Doc ClashAnnotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageWidth -> Doc ClashAnnotation
f)
        Nesting Int -> Doc ClashAnnotation
f            -> (Int -> Doc ClashAnnotation) -> Doc ClashAnnotation
forall ann. (Int -> Doc ann) -> Doc ann
Nesting (Doc ClashAnnotation -> Doc ClashAnnotation
hide (Doc ClashAnnotation -> Doc ClashAnnotation)
-> (Int -> Doc ClashAnnotation) -> Int -> Doc ClashAnnotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc ClashAnnotation
f)
        Annotated ClashAnnotation
ann Doc ClashAnnotation
d'     ->
          if Bool -> Bool
not (PrettyOptions -> Bool
displayTypes PrettyOptions
opts)      Bool -> Bool -> Bool
&& ClashAnnotation
ann ClashAnnotation -> ClashAnnotation -> Bool
forall a. Eq a => a -> a -> Bool
== SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Type
          Bool -> Bool -> Bool
|| Bool -> Bool
not (PrettyOptions -> Bool
displayUniques PrettyOptions
opts)    Bool -> Bool -> Bool
&& ClashAnnotation
ann ClashAnnotation -> ClashAnnotation -> Bool
forall a. Eq a => a -> a -> Bool
== SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Unique
          Bool -> Bool -> Bool
|| Bool -> Bool
not (PrettyOptions -> Bool
displayQualifiers PrettyOptions
opts) Bool -> Bool -> Bool
&& ClashAnnotation
ann ClashAnnotation -> ClashAnnotation -> Bool
forall a. Eq a => a -> a -> Bool
== SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Qualifier
          Bool -> Bool -> Bool
|| Bool -> Bool
not (PrettyOptions -> Bool
displayTicks PrettyOptions
opts)      Bool -> Bool -> Bool
&& ClashAnnotation
ann ClashAnnotation -> ClashAnnotation -> Bool
forall a. Eq a => a -> a -> Bool
== SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Ticky
            then Doc ClashAnnotation
forall ann. Doc ann
Empty
            else ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
Annotated ClashAnnotation
ann (Doc ClashAnnotation -> Doc ClashAnnotation
hide Doc ClashAnnotation
d')
        Doc ClashAnnotation
d -> Doc ClashAnnotation
d

pprM :: (Monad m, PrettyPrec p) => p -> m ClashDoc
pprM :: forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM = Rational -> p -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> p -> m (Doc ClashAnnotation)
pprPrec Rational
0

pprM' :: (Monad m, PrettyPrec p) => PrettyOptions -> p -> m ClashDoc
pprM' :: forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
PrettyOptions -> p -> m (Doc ClashAnnotation)
pprM' PrettyOptions
opts = PrettyOptions -> Rational -> p -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
PrettyOptions -> Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
PrettyOptions -> Rational -> p -> m (Doc ClashAnnotation)
pprPrec' PrettyOptions
opts Rational
0

ppr :: PrettyPrec p => p -> ClashDoc
ppr :: forall p. PrettyPrec p => p -> Doc ClashAnnotation
ppr = Identity (Doc ClashAnnotation) -> Doc ClashAnnotation
forall a. Identity a -> a
runIdentity (Identity (Doc ClashAnnotation) -> Doc ClashAnnotation)
-> (p -> Identity (Doc ClashAnnotation))
-> p
-> Doc ClashAnnotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> Identity (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM

ppr' :: PrettyPrec p => PrettyOptions -> p -> ClashDoc
ppr' :: forall p. PrettyPrec p => PrettyOptions -> p -> Doc ClashAnnotation
ppr' PrettyOptions
opts = Identity (Doc ClashAnnotation) -> Doc ClashAnnotation
forall a. Identity a -> a
runIdentity (Identity (Doc ClashAnnotation) -> Doc ClashAnnotation)
-> (p -> Identity (Doc ClashAnnotation))
-> p
-> Doc ClashAnnotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyOptions -> p -> Identity (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
PrettyOptions -> p -> m (Doc ClashAnnotation)
pprM' PrettyOptions
opts

fromPpr :: PrettyPrec a => a -> Doc ()
fromPpr :: forall a. PrettyPrec a => a -> Doc ()
fromPpr = Doc ClashAnnotation -> Doc ()
forall ann. Doc ann -> Doc ()
removeAnnotations (Doc ClashAnnotation -> Doc ())
-> (a -> Doc ClashAnnotation) -> a -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc ClashAnnotation
forall p. PrettyPrec p => p -> Doc ClashAnnotation
ppr

noPrec, opPrec, appPrec :: Num a => a
noPrec :: forall a. Num a => a
noPrec = a
0
opPrec :: forall a. Num a => a
opPrec = a
1
appPrec :: forall a. Num a => a
appPrec = a
2

-- | Print a PrettyPrec thing to a String
showPpr :: PrettyPrec p => p -> String
showPpr :: forall p. PrettyPrec p => p -> String
showPpr = PrettyOptions -> p -> String
forall p. PrettyPrec p => PrettyOptions -> p -> String
showPpr' PrettyOptions
forall a. Default a => a
def

showPpr' :: PrettyPrec p => PrettyOptions -> p -> String
showPpr' :: forall p. PrettyPrec p => PrettyOptions -> p -> String
showPpr' PrettyOptions
opts = Doc ClashAnnotation -> String
forall ann. Doc ann -> String
showDoc (Doc ClashAnnotation -> String)
-> (p -> Doc ClashAnnotation) -> p -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyOptions -> p -> Doc ClashAnnotation
forall p. PrettyPrec p => PrettyOptions -> p -> Doc ClashAnnotation
ppr' PrettyOptions
opts

tracePprId :: PrettyPrec p => p -> p
tracePprId :: forall p. PrettyPrec p => p -> p
tracePprId p
p = String -> p -> p
forall a. String -> a -> a
trace (p -> String
forall p. PrettyPrec p => p -> String
showPpr p
p) p
p

tracePpr :: PrettyPrec p => p -> a -> a
tracePpr :: forall p a. PrettyPrec p => p -> a -> a
tracePpr p
p a
a = String -> a -> a
forall a. String -> a -> a
trace (p -> String
forall p. PrettyPrec p => p -> String
showPpr p
p) a
a

parensIf :: Bool -> ClashDoc -> ClashDoc
parensIf :: Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
parensIf Bool
False = Doc ClashAnnotation -> Doc ClashAnnotation
forall a. a -> a
id
parensIf Bool
True  = Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann
parens

tyParens :: ClashDoc -> ClashDoc
tyParens :: Doc ClashAnnotation -> Doc ClashAnnotation
tyParens = Doc ClashAnnotation
-> Doc ClashAnnotation
-> Doc ClashAnnotation
-> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose (ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Type) Doc ClashAnnotation
forall ann. Doc ann
lparen)
                   (ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Type) Doc ClashAnnotation
forall ann. Doc ann
rparen)

tyParensIf :: Bool -> ClashDoc -> ClashDoc
tyParensIf :: Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
tyParensIf Bool
False = Doc ClashAnnotation -> Doc ClashAnnotation
forall a. a -> a
id
tyParensIf Bool
True  = Doc ClashAnnotation -> Doc ClashAnnotation
tyParens

vsepHard :: [ClashDoc] -> ClashDoc
vsepHard :: [Doc ClashAnnotation] -> Doc ClashAnnotation
vsepHard = (Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation)
-> [Doc ClashAnnotation] -> Doc ClashAnnotation
forall (t :: Type -> Type) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (\Doc ClashAnnotation
x Doc ClashAnnotation
y -> Doc ClashAnnotation
x Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
forall ann. Doc ann
hardline Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
y)

viewName :: Name a -> (Text, Text, Text)
viewName :: forall a. Name a -> (Text, Text, Text)
viewName Name a
n = (Text
qual, Text
occ, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Unique -> String
forall a. Show a => a -> String
show (Unique -> String) -> Unique -> String
forall a b. (a -> b) -> a -> b
$ Name a -> Unique
forall a. Name a -> Unique
nameUniq Name a
n)
  where (Text
qual, Text
occ) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOnEnd Text
"." (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Name a -> Text
forall a. Name a -> Text
nameOcc Name a
n

instance PrettyPrec (Name a) where
  pprPrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> Name a -> m (Doc ClashAnnotation)
pprPrec Rational
p (Name a -> (Text, Text, Text)
forall a. Name a -> (Text, Text, Text)
viewName -> (Text
qual, Text
occ, Text
uniq)) = do
    Doc ClashAnnotation
qual' <- ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Qualifier) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Text -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Text -> m (Doc ClashAnnotation)
pprPrec Rational
p Text
qual
    Doc ClashAnnotation
occ'  <- Rational -> Text -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Text -> m (Doc ClashAnnotation)
pprPrec Rational
p Text
occ
    Doc ClashAnnotation
uniq' <- ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Unique) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation
-> Doc ClashAnnotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann
brackets (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rational -> Text -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Text -> m (Doc ClashAnnotation)
pprPrec Rational
p Text
uniq)
    Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Doc ClashAnnotation
qual' Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
occ' Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
uniq'

instance ClashPretty (Name a) where
  clashPretty :: Name a -> Doc ()
clashPretty = Name a -> Doc ()
forall a. PrettyPrec a => a -> Doc ()
fromPpr

instance PrettyPrec a => PrettyPrec [a] where
  pprPrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> [a] -> m (Doc ClashAnnotation)
pprPrec Rational
prec = ([Doc ClashAnnotation] -> Doc ClashAnnotation)
-> m [Doc ClashAnnotation] -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
vcat (m [Doc ClashAnnotation] -> m (Doc ClashAnnotation))
-> ([a] -> m [Doc ClashAnnotation])
-> [a]
-> m (Doc ClashAnnotation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m (Doc ClashAnnotation)) -> [a] -> m [Doc ClashAnnotation]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (Rational -> a -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> a -> m (Doc ClashAnnotation)
pprPrec Rational
prec)

instance PrettyPrec (Id, Term) where
  pprPrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> (Id, Term) -> m (Doc ClashAnnotation)
pprPrec Rational
_ = (Id, Term) -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
(Id, Term) -> m (Doc ClashAnnotation)
pprTopLevelBndr

pprTopLevelBndr :: Monad m => (Id,Term) -> m ClashDoc
pprTopLevelBndr :: forall (m :: Type -> Type).
Monad m =>
(Id, Term) -> m (Doc ClashAnnotation)
pprTopLevelBndr (Id
bndr,Term
expr) = do
  Doc ClashAnnotation
bndr'    <- Id -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM Id
bndr
  Doc ClashAnnotation
bndrName <- Name Term -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM (Id -> Name Term
forall a. Var a -> Name a
varName Id
bndr)
  Doc ClashAnnotation
expr'    <- Term -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM Term
expr
  Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Doc ClashAnnotation
bndr' Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
forall ann. Doc ann
line Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
sep [(Doc ClashAnnotation
bndrName Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
forall ann. Doc ann
equals), Doc ClashAnnotation
expr']) Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
forall ann. Doc ann
line

dcolon, rarrow, lam, tylam, at, cast, coerce, let_, letrec, in_, case_, of_, forall_,
  data_,newtype_,type_,family_,instance_
  :: ClashDoc
dcolon :: Doc ClashAnnotation
dcolon = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"::"
rarrow :: Doc ClashAnnotation
rarrow = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"->"
lam :: Doc ClashAnnotation
lam = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword)  Doc ClashAnnotation
"λ"
tylam :: Doc ClashAnnotation
tylam = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"Λ"
at :: Doc ClashAnnotation
at = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword)  Doc ClashAnnotation
"@"
cast :: Doc ClashAnnotation
cast = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"▷"
coerce :: Doc ClashAnnotation
coerce = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"~"
let_ :: Doc ClashAnnotation
let_ = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"let"
letrec :: Doc ClashAnnotation
letrec = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"letrec"
in_ :: Doc ClashAnnotation
in_ = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"in"
case_ :: Doc ClashAnnotation
case_ = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"case"
of_ :: Doc ClashAnnotation
of_ = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"of"
forall_ :: Doc ClashAnnotation
forall_ = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"forall"
data_ :: Doc ClashAnnotation
data_ = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"data"
newtype_ :: Doc ClashAnnotation
newtype_ = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"newtype"
type_ :: Doc ClashAnnotation
type_ = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"type"
family_ :: Doc ClashAnnotation
family_ = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"family"
instance_ :: Doc ClashAnnotation
instance_ = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Keyword) Doc ClashAnnotation
"instance"

instance PrettyPrec Text where
  pprPrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> Text -> m (Doc ClashAnnotation)
pprPrec Rational
_ = Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> (Text -> Doc ClashAnnotation) -> Text -> m (Doc ClashAnnotation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc ClashAnnotation
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

instance PrettyPrec Type where
  pprPrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> Type -> m (Doc ClashAnnotation)
pprPrec Rational
_ Type
t = ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Type) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprType Type
t

instance ClashPretty Type where
  clashPretty :: Type -> Doc ()
clashPretty = Type -> Doc ()
forall a. PrettyPrec a => a -> Doc ()
fromPpr

instance PrettyPrec TyCon where
  pprPrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> TyCon -> m (Doc ClashAnnotation)
pprPrec Rational
prec TyCon
t = case TyCon
t of
    AlgTyCon Unique
_ TyConName
nm Type
kn Int
_ (DataTyCon [DataCon]
dcs) Bool
_ -> do
      Doc ClashAnnotation
name <- Rational -> TyConName -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> TyConName -> m (Doc ClashAnnotation)
pprPrec Rational
prec TyConName
nm
      Doc ClashAnnotation
kind <- Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprKind Type
kn
      let decl :: Doc ClashAnnotation
decl = Doc ClashAnnotation
name Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Type) (Doc ClashAnnotation
forall ann. Doc ann
space Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
dcolon Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
kind)

      [Doc ClashAnnotation]
cons <- (DataCon -> m (Doc ClashAnnotation))
-> [DataCon] -> m [Doc ClashAnnotation]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse DataCon -> m (Doc ClashAnnotation)
forall {m :: Type -> Type}.
Monad m =>
DataCon -> m (Doc ClashAnnotation)
pprDataCon [DataCon]
dcs
      Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
vsep (Doc ClashAnnotation
data_ Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
decl Doc ClashAnnotation
-> [Doc ClashAnnotation] -> [Doc ClashAnnotation]
forall a. a -> [a] -> [a]
: [Doc ClashAnnotation]
cons))
     where
      pprDataCon :: DataCon -> m (Doc ClashAnnotation)
pprDataCon DataCon
dc = do
        Doc ClashAnnotation
name <- Rational -> DataCon -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> DataCon -> m (Doc ClashAnnotation)
pprPrec Rational
prec DataCon
dc
        Doc ClashAnnotation
ty <- Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprType (DataCon -> Type
dcType DataCon
dc)

        Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Doc ClashAnnotation
name Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
dcolon Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
ty)

    AlgTyCon Unique
_ TyConName
nm Type
kn Int
_ (NewTyCon DataCon
dc ([TyVar], Type)
_) Bool
_ -> do
      Doc ClashAnnotation
name <- Rational -> TyConName -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> TyConName -> m (Doc ClashAnnotation)
pprPrec Rational
prec TyConName
nm
      Doc ClashAnnotation
kind <- Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprKind Type
kn
      let decl :: Doc ClashAnnotation
decl = Doc ClashAnnotation
name Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Type) (Doc ClashAnnotation
forall ann. Doc ann
space Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
dcolon Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
kind)

      Doc ClashAnnotation
conName <- Rational -> DcName -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> DcName -> m (Doc ClashAnnotation)
pprPrec Rational
prec (DataCon -> DcName
dcName DataCon
dc)
      Doc ClashAnnotation
conType <- Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprType (DataCon -> Type
dcType DataCon
dc)

      Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
vsep [Doc ClashAnnotation
newtype_ Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
decl, Doc ClashAnnotation
conName Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
dcolon Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
conType])

    PromotedDataCon Unique
_ TyConName
_ Type
_ Int
_ DataCon
dc ->
      (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc ClashAnnotation
"promoted" <+>) (Rational -> DataCon -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> DataCon -> m (Doc ClashAnnotation)
pprPrec Rational
prec DataCon
dc)

    FunTyCon Unique
_ TyConName
nm Type
kn Int
_ [([Type], Type)]
ss -> do
      Doc ClashAnnotation
name <- Rational -> TyConName -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> TyConName -> m (Doc ClashAnnotation)
pprPrec Rational
prec TyConName
nm
      Doc ClashAnnotation
kind <- Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprKind Type
kn
      let decl :: Doc ClashAnnotation
decl = Doc ClashAnnotation
name Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Type) (Doc ClashAnnotation
forall ann. Doc ann
space Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
dcolon Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
kind)

      [Doc ClashAnnotation]
substs <- (([Type], Type) -> m (Doc ClashAnnotation))
-> [([Type], Type)] -> m [Doc ClashAnnotation]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ([Type], Type) -> m (Doc ClashAnnotation)
forall {m :: Type -> Type}.
Monad m =>
([Type], Type) -> m (Doc ClashAnnotation)
pprSubst [([Type], Type)]
ss
      Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
vsep (Doc ClashAnnotation
type_ Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
family_ Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
decl Doc ClashAnnotation
-> [Doc ClashAnnotation] -> [Doc ClashAnnotation]
forall a. a -> [a] -> [a]
: [Doc ClashAnnotation]
substs))
     where
      pprSubst :: ([Type], Type) -> m (Doc ClashAnnotation)
pprSubst ([Type]
xs, Type
y) = do
        Doc ClashAnnotation
lhs <- Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprType (TyConName -> [Type] -> Type
mkTyConApp (TyCon -> TyConName
tyConName TyCon
t) [Type]
xs)
        Doc ClashAnnotation
rhs <- Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprType Type
y

        Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Doc ClashAnnotation
type_ Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
instance_ Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
lhs Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
"=" Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
rhs)

    PrimTyCon Unique
_ TyConName
nm Type
kn Int
_ -> do
      Doc ClashAnnotation
name <- Rational -> TyConName -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> TyConName -> m (Doc ClashAnnotation)
pprPrec Rational
prec TyConName
nm
      Doc ClashAnnotation
kind <- Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprKind Type
kn

      Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Doc ClashAnnotation
name Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Type) (Doc ClashAnnotation
forall ann. Doc ann
space Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
dcolon Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
kind))

instance Pretty LitTy where
  pretty :: forall ann. LitTy -> Doc ann
pretty (NumTy Integer
i) = Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i
  pretty (SymTy String
s) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
s
  pretty (CharTy Char
c) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
squotes (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Char -> Doc ann
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
c

instance PrettyPrec LitTy where
  pprPrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> LitTy -> m (Doc ClashAnnotation)
pprPrec Rational
_ = Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> (LitTy -> Doc ClashAnnotation)
-> LitTy
-> m (Doc ClashAnnotation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
LitS) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> (LitTy -> Doc ClashAnnotation) -> LitTy -> Doc ClashAnnotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LitTy -> Doc ClashAnnotation
forall a ann. Pretty a => a -> Doc ann
forall ann. LitTy -> Doc ann
pretty

instance PrettyPrec Term where
  pprPrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> m (Doc ClashAnnotation)
pprPrec Rational
prec Term
e = case Term
e of
    Var Id
x           -> do
      Doc ClashAnnotation
v <- Rational -> Name Term -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Name Term -> m (Doc ClashAnnotation)
pprPrec Rational
prec (Id -> Name Term
forall a. Var a -> Name a
varName Id
x)
      Doc ClashAnnotation
s <- Id -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) a.
Monad m =>
Var a -> m (Doc ClashAnnotation)
pprPrecIdScope Id
x
      Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Doc ClashAnnotation
v Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann
brackets Doc ClashAnnotation
s)
    Data DataCon
dc         -> Rational -> DataCon -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> DataCon -> m (Doc ClashAnnotation)
pprPrec Rational
prec DataCon
dc
    Literal Literal
l       -> Rational -> Literal -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Literal -> m (Doc ClashAnnotation)
pprPrec Rational
prec Literal
l
    Prim PrimInfo
p          -> Rational -> Text -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Text -> m (Doc ClashAnnotation)
pprPrecPrim Rational
prec (PrimInfo -> Text
primName PrimInfo
p)
    Lam  Id
v Term
e1       -> ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (CoreContext -> ClashAnnotation
AnnContext (CoreContext -> ClashAnnotation) -> CoreContext -> ClashAnnotation
forall a b. (a -> b) -> a -> b
$ Id -> CoreContext
LamBody Id
v) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         Rational -> [Id] -> Term -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> [Id] -> Term -> m (Doc ClashAnnotation)
pprPrecLam Rational
prec [Id
v] Term
e1
    TyLam TyVar
tv Term
e1     -> ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (CoreContext -> ClashAnnotation
AnnContext (CoreContext -> ClashAnnotation) -> CoreContext -> ClashAnnotation
forall a b. (a -> b) -> a -> b
$ TyVar -> CoreContext
TyLamBody TyVar
tv) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         Rational -> [TyVar] -> Term -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> [TyVar] -> Term -> m (Doc ClashAnnotation)
pprPrecTyLam Rational
prec [TyVar
tv] Term
e1
    App Term
fun Term
arg     -> Rational -> Term -> Term -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> Term -> m (Doc ClashAnnotation)
pprPrecApp Rational
prec Term
fun Term
arg
    TyApp Term
e' Type
ty     -> ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (CoreContext -> ClashAnnotation
AnnContext CoreContext
TyAppC) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         Rational -> Term -> Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> Type -> m (Doc ClashAnnotation)
pprPrecTyApp Rational
prec Term
e' Type
ty
    Let (NonRec Id
i Term
x) Term
e1 -> Rational -> Bool -> [(Id, Term)] -> Term -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Bool -> [(Id, Term)] -> Term -> m (Doc ClashAnnotation)
pprPrecLetrec Rational
prec Bool
False [(Id
i,Term
x)] Term
e1
    Let (Rec [(Id, Term)]
xes) Term
e1   -> Rational -> Bool -> [(Id, Term)] -> Term -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Bool -> [(Id, Term)] -> Term -> m (Doc ClashAnnotation)
pprPrecLetrec Rational
prec Bool
True [(Id, Term)]
xes Term
e1
    Case Term
e' Type
_ [Alt]
alts  -> Rational -> Term -> [Alt] -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> [Alt] -> m (Doc ClashAnnotation)
pprPrecCase Rational
prec Term
e' [Alt]
alts
    Cast Term
e' Type
ty1 Type
ty2 -> Rational -> Term -> Type -> Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> Type -> Type -> m (Doc ClashAnnotation)
pprPrecCast Rational
prec Term
e' Type
ty1 Type
ty2
    Tick TickInfo
t Term
e'       -> do
      Doc ClashAnnotation
tDoc <- Rational -> TickInfo -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> TickInfo -> m (Doc ClashAnnotation)
pprPrec Rational
prec TickInfo
t
      Doc ClashAnnotation
eDoc <- Rational -> Term -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> m (Doc ClashAnnotation)
pprPrec Rational
prec Term
e'
      Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Ticky) (Doc ClashAnnotation
tDoc Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
forall ann. Doc ann
line') Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
eDoc)

instance PrettyPrec TickInfo where
  pprPrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> TickInfo -> m (Doc ClashAnnotation)
pprPrec Rational
prec (SrcSpan SrcSpan
sp)   = Rational -> SrcSpan -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> SrcSpan -> m (Doc ClashAnnotation)
pprPrec Rational
prec SrcSpan
sp
  pprPrec Rational
prec (NameMod NameMod
PrefixName Type
t) = (Doc ClashAnnotation
"<prefixName>" <>) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Type -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Type -> m (Doc ClashAnnotation)
pprPrec Rational
prec Type
t
  pprPrec Rational
prec (NameMod NameMod
SuffixName Type
t) = (Doc ClashAnnotation
"<suffixName>" <>) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Type -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Type -> m (Doc ClashAnnotation)
pprPrec Rational
prec Type
t
  pprPrec Rational
prec (NameMod NameMod
SuffixNameP Type
t) = (Doc ClashAnnotation
"<suffixNameP>" <>) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Type -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Type -> m (Doc ClashAnnotation)
pprPrec Rational
prec Type
t
  pprPrec Rational
prec (NameMod NameMod
SetName Type
t)    = (Doc ClashAnnotation
"<setName>" <>) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Type -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Type -> m (Doc ClashAnnotation)
pprPrec Rational
prec Type
t
  pprPrec Rational
_    TickInfo
DeDup                  = Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc ClashAnnotation
"<deDup>"
  pprPrec Rational
_    TickInfo
NoDeDup                = Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc ClashAnnotation
"<noDeDup>"

instance PrettyPrec SrcSpan where
  pprPrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> SrcSpan -> m (Doc ClashAnnotation)
pprPrec Rational
_ SrcSpan
sp = Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation
"<src>"Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<>String -> Doc ClashAnnotation
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (SDoc -> String
GHC.showSDocUnsafe (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr SrcSpan
sp)))

instance ClashPretty Term where
  clashPretty :: Term -> Doc ()
clashPretty = Term -> Doc ()
forall a. PrettyPrec a => a -> Doc ()
fromPpr

data BindingSite = LambdaBind | CaseBind | LetBind

instance PrettyPrec (Var a) where
  pprPrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> Var a -> m (Doc ClashAnnotation)
pprPrec Rational
_ v :: Var a
v@(TyVar {}) = Name a -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM (Name a -> m (Doc ClashAnnotation))
-> Name a -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Var a -> Name a
forall a. Var a -> Name a
varName Var a
v
  pprPrec Rational
_ v :: Var a
v@(Id {})    = do
    Doc ClashAnnotation
v'  <- Name a -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM (Var a -> Name a
forall a. Var a -> Name a
varName Var a
v)
    Doc ClashAnnotation
ty' <- Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM (Var a -> Type
forall a. Var a -> Type
varType Var a
v)
    Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Doc ClashAnnotation
v' Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> (ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Type) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann
align (Doc ClashAnnotation
forall ann. Doc ann
space Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
dcolon Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
ty'))

instance ClashPretty (Var a) where
  clashPretty :: Var a -> Doc ()
clashPretty = Var a -> Doc ()
forall a. PrettyPrec a => a -> Doc ()
fromPpr

instance PrettyPrec DataCon where
  pprPrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> DataCon -> m (Doc ClashAnnotation)
pprPrec Rational
_ = DcName -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM (DcName -> m (Doc ClashAnnotation))
-> (DataCon -> DcName) -> DataCon -> m (Doc ClashAnnotation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataCon -> DcName
dcName

instance PrettyPrec Literal where
  pprPrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> Literal -> m (Doc ClashAnnotation)
pprPrec Rational
_ Literal
l = Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
LitS) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ case Literal
l of
    IntegerLiteral Integer
i   -> Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
parensIf (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) (Integer -> Doc ClashAnnotation
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i)
    IntLiteral Integer
i       -> Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
parensIf (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) (Integer -> Doc ClashAnnotation
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
"#")
    Int64Literal Integer
i     -> Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
parensIf (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) (Integer -> Doc ClashAnnotation
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
"#64")
    WordLiteral Integer
w      -> Integer -> Doc ClashAnnotation
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
w Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
"##"
    Word64Literal Integer
w    -> Integer -> Doc ClashAnnotation
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
w Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
"##64"
    Int8Literal Integer
i      -> Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
parensIf (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) (Integer -> Doc ClashAnnotation
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
"#8")
    Int16Literal Integer
i     -> Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
parensIf (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) (Integer -> Doc ClashAnnotation
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
"#16")
    Int32Literal Integer
i     -> Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
parensIf (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) (Integer -> Doc ClashAnnotation
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
"#32")
    Word8Literal Integer
w     -> Integer -> Doc ClashAnnotation
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
w Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
"##8"
    Word16Literal Integer
w    -> Integer -> Doc ClashAnnotation
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
w Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
"##16"
    Word32Literal Integer
w    -> Integer -> Doc ClashAnnotation
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
w Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
"##32"
    FloatLiteral Word32
w     -> Float -> Doc ClashAnnotation
forall ann. Float -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Word32 -> Float
wordToFloat Word32
w) Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
"#"
    DoubleLiteral Unique
w    -> Double -> Doc ClashAnnotation
forall ann. Double -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Unique -> Double
wordToDouble Unique
w) Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
"##"
    CharLiteral Char
c      -> Char -> Doc ClashAnnotation
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
c Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
"#"
    StringLiteral String
s    -> [Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
vcat ([Doc ClashAnnotation] -> Doc ClashAnnotation)
-> [Doc ClashAnnotation] -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ (String -> Doc ClashAnnotation)
-> [String] -> [Doc ClashAnnotation]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc ClashAnnotation
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([String] -> [Doc ClashAnnotation])
-> [String] -> [Doc ClashAnnotation]
forall a b. (a -> b) -> a -> b
$ String -> [String]
showMultiLineString String
s
    NaturalLiteral Integer
n   -> Integer -> Doc ClashAnnotation
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
n
    ByteArrayLiteral ByteArray
s -> String -> Doc ClashAnnotation
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ClashAnnotation) -> String -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ ByteArray -> String
forall a. Show a => a -> String
show ByteArray
s

instance PrettyPrec Pat where
  pprPrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> Pat -> m (Doc ClashAnnotation)
pprPrec Rational
prec Pat
pat = case Pat
pat of
    DataPat DataCon
dc [TyVar]
txs [Id]
xs -> do
      Doc ClashAnnotation
dc'  <- DataCon -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM DataCon
dc
      [Doc ClashAnnotation]
txs' <- (TyVar -> m (Doc ClashAnnotation))
-> [TyVar] -> m [Doc ClashAnnotation]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (BindingSite -> TyVar -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) a.
(Monad m, PrettyPrec a) =>
BindingSite -> a -> m (Doc ClashAnnotation)
pprBndr BindingSite
LetBind) [TyVar]
txs
      [Doc ClashAnnotation]
xs'  <- (Id -> m (Doc ClashAnnotation)) -> [Id] -> m [Doc ClashAnnotation]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (BindingSite -> Id -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) a.
(Monad m, PrettyPrec a) =>
BindingSite -> a -> m (Doc ClashAnnotation)
pprBndr BindingSite
CaseBind) [Id]
xs
      Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
parensIf (Rational
prec Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
forall a. Num a => a
appPrec) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$
        [Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
sep [ [Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
hsep (Doc ClashAnnotation
dc'Doc ClashAnnotation
-> [Doc ClashAnnotation] -> [Doc ClashAnnotation]
forall a. a -> [a] -> [a]
:[Doc ClashAnnotation]
txs')
            , Int -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
sep [Doc ClashAnnotation]
xs') ]
    LitPat Literal
l   -> Literal -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM Literal
l
    Pat
DefaultPat -> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Doc ClashAnnotation
"_"

pprPrecIdScope :: Monad m => Var a -> m ClashDoc
pprPrecIdScope :: forall (m :: Type -> Type) a.
Monad m =>
Var a -> m (Doc ClashAnnotation)
pprPrecIdScope (TyVar {}) = Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc ClashAnnotation
"TyVar"
pprPrecIdScope (Id Name a
_ Unique
_ Type
_ IdScope
GlobalId) = Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc ClashAnnotation
"GlobalId"
pprPrecIdScope (Id Name a
_ Unique
_ Type
_ IdScope
LocalId) = Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc ClashAnnotation
"LocalId"

pprPrecPrim :: Monad m => Rational -> Text -> m ClashDoc
pprPrecPrim :: forall (m :: Type -> Type).
Monad m =>
Rational -> Text -> m (Doc ClashAnnotation)
pprPrecPrim Rational
prec Text
nm =
  Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
(<>) (Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation)
-> m (Doc ClashAnnotation -> Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Qualifier) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Text -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Text -> m (Doc ClashAnnotation)
pprPrec Rational
prec Text
qual)
       m (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall a b. m (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Rational -> Text -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Text -> m (Doc ClashAnnotation)
pprPrec Rational
prec Text
occ
  where (Text
qual, Text
occ) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOnEnd Text
"." Text
nm

pprPrecLam :: Monad m => Rational -> [Id] -> Term -> m ClashDoc
pprPrecLam :: forall (m :: Type -> Type).
Monad m =>
Rational -> [Id] -> Term -> m (Doc ClashAnnotation)
pprPrecLam Rational
prec [Id]
xs Term
e = do
  [Doc ClashAnnotation]
xs' <- (Id -> m (Doc ClashAnnotation)) -> [Id] -> m [Doc ClashAnnotation]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (BindingSite -> Id -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) a.
(Monad m, PrettyPrec a) =>
BindingSite -> a -> m (Doc ClashAnnotation)
pprBndr BindingSite
LambdaBind) [Id]
xs
  Doc ClashAnnotation
e'  <- Rational -> Term -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> m (Doc ClashAnnotation)
pprPrec Rational
forall a. Num a => a
noPrec Term
e
  Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
parensIf (Rational
prec Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
forall a. Num a => a
noPrec) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$
    Doc ClashAnnotation
lam Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> [Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
hsep [Doc ClashAnnotation]
xs' Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
rarrow Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
forall ann. Doc ann
line Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
e'

pprPrecTyLam :: Monad m => Rational -> [TyVar] -> Term -> m ClashDoc
pprPrecTyLam :: forall (m :: Type -> Type).
Monad m =>
Rational -> [TyVar] -> Term -> m (Doc ClashAnnotation)
pprPrecTyLam Rational
prec [TyVar]
tvs Term
e = do
  [Doc ClashAnnotation]
tvs' <- (TyVar -> m (Doc ClashAnnotation))
-> [TyVar] -> m [Doc ClashAnnotation]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM TyVar -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM [TyVar]
tvs
  Doc ClashAnnotation
e'   <- Rational -> Term -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> m (Doc ClashAnnotation)
pprPrec Rational
forall a. Num a => a
noPrec Term
e
  Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
tyParensIf (Rational
prec Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
forall a. Num a => a
noPrec) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$
    ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Type) (Doc ClashAnnotation
tylam Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> [Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
hsep [Doc ClashAnnotation]
tvs' Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
rarrow Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
forall ann. Doc ann
line) Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
e'

pprPrecApp :: Monad m => Rational -> Term -> Term -> m ClashDoc
pprPrecApp :: forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> Term -> m (Doc ClashAnnotation)
pprPrecApp Rational
prec Term
e1 Term
e2 = do
  Doc ClashAnnotation
e1' <- ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (CoreContext -> ClashAnnotation
AnnContext CoreContext
AppFun) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Term -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> m (Doc ClashAnnotation)
pprPrec Rational
forall a. Num a => a
opPrec Term
e1
  Doc ClashAnnotation
e2' <- ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (CoreContext -> ClashAnnotation
AnnContext (CoreContext -> ClashAnnotation) -> CoreContext -> ClashAnnotation
forall a b. (a -> b) -> a -> b
$ Maybe (Text, Int, Int) -> CoreContext
AppArg (Maybe (Text, Int, Int) -> CoreContext)
-> Maybe (Text, Int, Int) -> CoreContext
forall a b. (a -> b) -> a -> b
$ Term -> Maybe (Text, Int, Int)
primArg Term
e2) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Term -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> m (Doc ClashAnnotation)
pprPrec Rational
forall a. Num a => a
appPrec Term
e2
  Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
parensIf (Rational
prec Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
forall a. Num a => a
appPrec) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$
    Int -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
sep [Doc ClashAnnotation
e1',Doc ClashAnnotation
e2'])

pprPrecTyApp :: Monad m => Rational -> Term -> Type -> m ClashDoc
pprPrecTyApp :: forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> Type -> m (Doc ClashAnnotation)
pprPrecTyApp Rational
prec Term
e Type
ty = do
  Doc ClashAnnotation
e'  <- Rational -> Term -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> m (Doc ClashAnnotation)
pprPrec Rational
forall a. Num a => a
opPrec Term
e
  Doc ClashAnnotation
ty' <- Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprParendType Type
ty
  Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
tyParensIf (Rational
prec Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
forall a. Num a => a
appPrec) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$
    Int -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann
group (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$
      Doc ClashAnnotation
e' Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Type) (Doc ClashAnnotation
forall ann. Doc ann
line Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
at Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
ty')

pprPrecCast :: Monad m => Rational -> Term -> Type -> Type -> m ClashDoc
pprPrecCast :: forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> Type -> Type -> m (Doc ClashAnnotation)
pprPrecCast Rational
prec Term
e Type
ty1 Type
ty2 = do
  Doc ClashAnnotation
e'   <- ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (CoreContext -> ClashAnnotation
AnnContext CoreContext
CastBody) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Term -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> m (Doc ClashAnnotation)
pprPrec Rational
forall a. Num a => a
appPrec Term
e
  Doc ClashAnnotation
ty1' <- Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprType Type
ty1
  Doc ClashAnnotation
ty2' <- Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprType Type
ty2
  Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
tyParensIf (Rational
prec Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
forall a. Num a => a
appPrec) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$
    Doc ClashAnnotation
e' Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Type)
                   (Doc ClashAnnotation
forall ann. Doc ann
softline Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
vsep [Doc ClashAnnotation
cast, Doc ClashAnnotation
ty1', Doc ClashAnnotation
coerce, Doc ClashAnnotation
ty2']))

-- TODO Since Clash now keeps non-recursive let expressions separately, the
-- result of normalization will contain more nested let expressions as the old
-- Letrec-based definitions are replaced by Let. As this happens, it may be a
-- good idea to change pprPrecLetrec to encourage more compact forms such as
-- printing the entire binding on one line if possible.

pprPrecLetrec :: Monad m => Rational -> Bool -> [(Id, Term)] -> Term -> m ClashDoc
pprPrecLetrec :: forall (m :: Type -> Type).
Monad m =>
Rational -> Bool -> [(Id, Term)] -> Term -> m (Doc ClashAnnotation)
pprPrecLetrec Rational
prec Bool
isRec [(Id, Term)]
xes Term
body = do
  let bndrs :: [Id]
bndrs = (Id, Term) -> Id
forall a b. (a, b) -> a
fst ((Id, Term) -> Id) -> [(Id, Term)] -> [Id]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Id, Term)]
xes
  Doc ClashAnnotation
body' <- ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (CoreContext -> ClashAnnotation
AnnContext (CoreContext -> ClashAnnotation) -> CoreContext -> ClashAnnotation
forall a b. (a -> b) -> a -> b
$ [(Id, Term)] -> CoreContext
LetBody [(Id, Term)]
xes) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Term -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> m (Doc ClashAnnotation)
pprPrec Rational
forall a. Num a => a
noPrec Term
body
  [Doc ClashAnnotation]
xes'  <- ((Id, Term) -> m (Doc ClashAnnotation))
-> [(Id, Term)] -> m [Doc ClashAnnotation]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (\(Id
x,Term
e) -> do
                  Doc ClashAnnotation
x' <- BindingSite -> Id -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) a.
(Monad m, PrettyPrec a) =>
BindingSite -> a -> m (Doc ClashAnnotation)
pprBndr BindingSite
LetBind Id
x
                  Doc ClashAnnotation
e' <- Rational -> Term -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> m (Doc ClashAnnotation)
pprPrec Rational
forall a. Num a => a
noPrec Term
e
                  Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (CoreContext -> ClashAnnotation
AnnContext (CoreContext -> ClashAnnotation) -> CoreContext -> ClashAnnotation
forall a b. (a -> b) -> a -> b
$ Id -> [Id] -> CoreContext
LetBinding Id
x [Id]
bndrs) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$
                    [Doc ClashAnnotation] -> Doc ClashAnnotation
vsepHard [Doc ClashAnnotation
x', Doc ClashAnnotation
forall ann. Doc ann
equals Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
e']
                ) [(Id, Term)]
xes
  let xes'' :: [Doc ClashAnnotation]
xes'' = case [Doc ClashAnnotation]
xes' of { [] -> [Doc ClashAnnotation
"EmptyLetrec"]; [Doc ClashAnnotation]
_  -> [Doc ClashAnnotation]
xes' }
  let kw :: Doc ClashAnnotation
kw = if Bool
isRec then Doc ClashAnnotation
letrec else Doc ClashAnnotation
let_
  Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
parensIf (Rational
prec Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
forall a. Num a => a
noPrec) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$
    [Doc ClashAnnotation] -> Doc ClashAnnotation
vsepHard [Int -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc ClashAnnotation] -> Doc ClashAnnotation
vsepHard ([Doc ClashAnnotation] -> Doc ClashAnnotation)
-> [Doc ClashAnnotation] -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ Doc ClashAnnotation
kw Doc ClashAnnotation
-> [Doc ClashAnnotation] -> [Doc ClashAnnotation]
forall a. a -> [a] -> [a]
: [Doc ClashAnnotation]
xes''), Doc ClashAnnotation
in_ Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
body']

pprPrecCase :: Monad m => Rational -> Term -> [(Pat,Term)] -> m ClashDoc
pprPrecCase :: forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> [Alt] -> m (Doc ClashAnnotation)
pprPrecCase Rational
prec Term
e [Alt]
alts = do
  Doc ClashAnnotation
e'    <- ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (CoreContext -> ClashAnnotation
AnnContext CoreContext
CaseScrut) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> Term -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> m (Doc ClashAnnotation)
pprPrec Rational
prec Term
e
  [Doc ClashAnnotation]
alts' <- (Alt -> m (Doc ClashAnnotation))
-> [Alt] -> m [Doc ClashAnnotation]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (Rational -> Alt -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Alt -> m (Doc ClashAnnotation)
pprPrecAlt Rational
forall a. Num a => a
noPrec) [Alt]
alts
  Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
parensIf (Rational
prec Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
forall a. Num a => a
noPrec) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$
    Int -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ [Doc ClashAnnotation] -> Doc ClashAnnotation
vsepHard ([Doc ClashAnnotation] -> Doc ClashAnnotation)
-> [Doc ClashAnnotation] -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ (Doc ClashAnnotation
case_ Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
e' Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
of_) Doc ClashAnnotation
-> [Doc ClashAnnotation] -> [Doc ClashAnnotation]
forall a. a -> [a] -> [a]
: [Doc ClashAnnotation]
alts'

pprPrecAlt :: Monad m => Rational -> (Pat,Term) -> m ClashDoc
pprPrecAlt :: forall (m :: Type -> Type).
Monad m =>
Rational -> Alt -> m (Doc ClashAnnotation)
pprPrecAlt Rational
_ (Pat
altPat, Term
altE) = do
  Doc ClashAnnotation
altPat' <- Rational -> Pat -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Pat -> m (Doc ClashAnnotation)
pprPrec Rational
forall a. Num a => a
noPrec Pat
altPat
  Doc ClashAnnotation
altE'   <- Rational -> Term -> m (Doc ClashAnnotation)
forall p (m :: Type -> Type).
(PrettyPrec p, Monad m) =>
Rational -> p -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Rational -> Term -> m (Doc ClashAnnotation)
pprPrec Rational
forall a. Num a => a
noPrec Term
altE
  Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (CoreContext -> ClashAnnotation
AnnContext (CoreContext -> ClashAnnotation) -> CoreContext -> ClashAnnotation
forall a b. (a -> b) -> a -> b
$ Pat -> CoreContext
CaseAlt Pat
altPat) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$
    Int -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ [Doc ClashAnnotation] -> Doc ClashAnnotation
vsepHard [(Doc ClashAnnotation
altPat' Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
rarrow), Doc ClashAnnotation
altE']

pprBndr :: (Monad m, PrettyPrec a) => BindingSite -> a -> m ClashDoc
pprBndr :: forall (m :: Type -> Type) a.
(Monad m, PrettyPrec a) =>
BindingSite -> a -> m (Doc ClashAnnotation)
pprBndr BindingSite
LetBind = a -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM
pprBndr BindingSite
_       = (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc ClashAnnotation -> Doc ClashAnnotation
tyParens (m (Doc ClashAnnotation) -> m (Doc ClashAnnotation))
-> (a -> m (Doc ClashAnnotation)) -> a -> m (Doc ClashAnnotation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM

data TypePrec = TopPrec | FunPrec | TyConPrec deriving (TypePrec -> TypePrec -> Bool
(TypePrec -> TypePrec -> Bool)
-> (TypePrec -> TypePrec -> Bool) -> Eq TypePrec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypePrec -> TypePrec -> Bool
== :: TypePrec -> TypePrec -> Bool
$c/= :: TypePrec -> TypePrec -> Bool
/= :: TypePrec -> TypePrec -> Bool
Eq,Eq TypePrec
Eq TypePrec =>
(TypePrec -> TypePrec -> Ordering)
-> (TypePrec -> TypePrec -> Bool)
-> (TypePrec -> TypePrec -> Bool)
-> (TypePrec -> TypePrec -> Bool)
-> (TypePrec -> TypePrec -> Bool)
-> (TypePrec -> TypePrec -> TypePrec)
-> (TypePrec -> TypePrec -> TypePrec)
-> Ord TypePrec
TypePrec -> TypePrec -> Bool
TypePrec -> TypePrec -> Ordering
TypePrec -> TypePrec -> TypePrec
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
$ccompare :: TypePrec -> TypePrec -> Ordering
compare :: TypePrec -> TypePrec -> Ordering
$c< :: TypePrec -> TypePrec -> Bool
< :: TypePrec -> TypePrec -> Bool
$c<= :: TypePrec -> TypePrec -> Bool
<= :: TypePrec -> TypePrec -> Bool
$c> :: TypePrec -> TypePrec -> Bool
> :: TypePrec -> TypePrec -> Bool
$c>= :: TypePrec -> TypePrec -> Bool
>= :: TypePrec -> TypePrec -> Bool
$cmax :: TypePrec -> TypePrec -> TypePrec
max :: TypePrec -> TypePrec -> TypePrec
$cmin :: TypePrec -> TypePrec -> TypePrec
min :: TypePrec -> TypePrec -> TypePrec
Ord)

maybeParen :: TypePrec -> TypePrec -> ClashDoc -> ClashDoc
maybeParen :: TypePrec -> TypePrec -> Doc ClashAnnotation -> Doc ClashAnnotation
maybeParen TypePrec
ctxt_prec TypePrec
inner_prec = Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
parensIf (TypePrec
ctxt_prec TypePrec -> TypePrec -> Bool
forall a. Ord a => a -> a -> Bool
>= TypePrec
inner_prec)

pprType :: Monad m => Type -> m ClashDoc
pprType :: forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprType = TypePrec -> Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
TypePrec -> Type -> m (Doc ClashAnnotation)
ppr_type TypePrec
TopPrec

pprParendType :: Monad m => Type -> m ClashDoc
pprParendType :: forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprParendType = TypePrec -> Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
TypePrec -> Type -> m (Doc ClashAnnotation)
ppr_type TypePrec
TyConPrec

ppr_type :: Monad m => TypePrec -> Type -> m ClashDoc
ppr_type :: forall (m :: Type -> Type).
Monad m =>
TypePrec -> Type -> m (Doc ClashAnnotation)
ppr_type TypePrec
_ (VarTy TyVar
tv)                   = TyVar -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM TyVar
tv
ppr_type TypePrec
_ (LitTy LitTy
tyLit)                = LitTy -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM LitTy
tyLit
ppr_type TypePrec
p ty :: Type
ty@(ForAllTy {})             = TypePrec -> Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
TypePrec -> Type -> m (Doc ClashAnnotation)
pprForAllType TypePrec
p Type
ty
ppr_type TypePrec
p (ConstTy (TyCon TyConName
tc))         = TypePrec
-> (TypePrec -> Type -> m (Doc ClashAnnotation))
-> TyConName
-> [Type]
-> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
TypePrec
-> (TypePrec -> Type -> m (Doc ClashAnnotation))
-> TyConName
-> [Type]
-> m (Doc ClashAnnotation)
pprTcApp TypePrec
p TypePrec -> Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
TypePrec -> Type -> m (Doc ClashAnnotation)
ppr_type TyConName
tc []
ppr_type TypePrec
p (AnnType [Attr Text]
_ann Type
typ)           = TypePrec -> Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
TypePrec -> Type -> m (Doc ClashAnnotation)
ppr_type TypePrec
p Type
typ
ppr_type TypePrec
p (Type -> TypeView
tyView -> TyConApp TyConName
tc [Type]
args) = TypePrec
-> (TypePrec -> Type -> m (Doc ClashAnnotation))
-> TyConName
-> [Type]
-> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
TypePrec
-> (TypePrec -> Type -> m (Doc ClashAnnotation))
-> TyConName
-> [Type]
-> m (Doc ClashAnnotation)
pprTcApp TypePrec
p TypePrec -> Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
TypePrec -> Type -> m (Doc ClashAnnotation)
ppr_type TyConName
tc [Type]
args
ppr_type TypePrec
p (Type -> TypeView
tyView -> FunTy Type
ty1 Type
ty2)
  = [Doc ClashAnnotation] -> Doc ClashAnnotation
pprArrowChain ([Doc ClashAnnotation] -> Doc ClashAnnotation)
-> m [Doc ClashAnnotation] -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> TypePrec -> Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
TypePrec -> Type -> m (Doc ClashAnnotation)
ppr_type TypePrec
FunPrec Type
ty1 m (Doc ClashAnnotation)
-> m [Doc ClashAnnotation] -> m [Doc ClashAnnotation]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> Type -> m [Doc ClashAnnotation]
forall {f :: Type -> Type}.
Monad f =>
Type -> f [Doc ClashAnnotation]
pprFunTail Type
ty2
  where
    pprFunTail :: Type -> f [Doc ClashAnnotation]
pprFunTail (Type -> TypeView
tyView -> FunTy Type
ty1' Type
ty2')
      = TypePrec -> Type -> f (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
TypePrec -> Type -> m (Doc ClashAnnotation)
ppr_type TypePrec
FunPrec Type
ty1' f (Doc ClashAnnotation)
-> f [Doc ClashAnnotation] -> f [Doc ClashAnnotation]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> Type -> f [Doc ClashAnnotation]
pprFunTail Type
ty2'
    pprFunTail Type
otherTy
      = TypePrec -> Type -> f (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
TypePrec -> Type -> m (Doc ClashAnnotation)
ppr_type TypePrec
TopPrec Type
otherTy f (Doc ClashAnnotation)
-> f [Doc ClashAnnotation] -> f [Doc ClashAnnotation]
forall (f :: Type -> Type) a.
Applicative f =>
f a -> f [a] -> f [a]
<:> [Doc ClashAnnotation] -> f [Doc ClashAnnotation]
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure []

    pprArrowChain :: [Doc ClashAnnotation] -> Doc ClashAnnotation
pprArrowChain []
      = Doc ClashAnnotation
forall ann. Doc ann
emptyDoc
    pprArrowChain (Doc ClashAnnotation
arg:[Doc ClashAnnotation]
args)
      = TypePrec -> TypePrec -> Doc ClashAnnotation -> Doc ClashAnnotation
maybeParen TypePrec
p TypePrec
FunPrec (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ [Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
sep [Doc ClashAnnotation
arg, [Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
sep ((Doc ClashAnnotation -> Doc ClashAnnotation)
-> [Doc ClashAnnotation] -> [Doc ClashAnnotation]
forall a b. (a -> b) -> [a] -> [b]
map (Doc ClashAnnotation
rarrow <+>) [Doc ClashAnnotation]
args)]

ppr_type TypePrec
p (AppTy Type
ty1 Type
ty2) = TypePrec -> TypePrec -> Doc ClashAnnotation -> Doc ClashAnnotation
maybeParen TypePrec
p TypePrec
TyConPrec (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
(<+>) (Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation)
-> m (Doc ClashAnnotation -> Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprType Type
ty1
                                                               m (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall a b. m (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> TypePrec -> Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
TypePrec -> Type -> m (Doc ClashAnnotation)
ppr_type TypePrec
TyConPrec Type
ty2)
ppr_type TypePrec
_ (ConstTy ConstTy
Arrow) = Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann
parens Doc ClashAnnotation
rarrow)

pprForAllType :: Monad m => TypePrec -> Type -> m ClashDoc
pprForAllType :: forall (m :: Type -> Type).
Monad m =>
TypePrec -> Type -> m (Doc ClashAnnotation)
pprForAllType TypePrec
p Type
ty = TypePrec -> TypePrec -> Doc ClashAnnotation -> Doc ClashAnnotation
maybeParen TypePrec
p TypePrec
FunPrec (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Bool -> Type -> m (Doc ClashAnnotation)
pprSigmaType Bool
True Type
ty

pprSigmaType :: Monad m => Bool -> Type -> m ClashDoc
pprSigmaType :: forall (m :: Type -> Type).
Monad m =>
Bool -> Type -> m (Doc ClashAnnotation)
pprSigmaType Bool
showForalls Type
ty = do
    ([TyVar]
tvs, Type
rho)     <- [TyVar] -> Type -> m ([TyVar], Type)
forall {m :: Type -> Type}.
Monad m =>
[TyVar] -> Type -> m ([TyVar], Type)
split1 [] Type
ty
    [Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
sep ([Doc ClashAnnotation] -> Doc ClashAnnotation)
-> m [Doc ClashAnnotation] -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [m (Doc ClashAnnotation)] -> m [Doc ClashAnnotation]
forall (t :: Type -> Type) (f :: Type -> Type) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: Type -> Type) a. Applicative f => [f a] -> f [a]
sequenceA [ if Bool
showForalls then [TyVar] -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
[TyVar] -> m (Doc ClashAnnotation)
pprForAll [TyVar]
tvs else Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Doc ClashAnnotation
forall ann. Doc ann
emptyDoc
                      , Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprType Type
rho
                      ]
  where
    split1 :: [TyVar] -> Type -> m ([TyVar], Type)
split1 [TyVar]
tvs (ForAllTy TyVar
tv Type
resTy) = [TyVar] -> Type -> m ([TyVar], Type)
split1 (TyVar
tvTyVar -> [TyVar] -> [TyVar]
forall a. a -> [a] -> [a]
:[TyVar]
tvs) Type
resTy
    split1 [TyVar]
tvs Type
resTy               = ([TyVar], Type) -> m ([TyVar], Type)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([TyVar] -> [TyVar]
forall a. [a] -> [a]
reverse [TyVar]
tvs,Type
resTy)

pprForAll :: Monad m => [TyVar] -> m ClashDoc
pprForAll :: forall (m :: Type -> Type).
Monad m =>
[TyVar] -> m (Doc ClashAnnotation)
pprForAll []  = Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Doc ClashAnnotation
forall ann. Doc ann
emptyDoc
pprForAll [TyVar]
tvs = do
  [Doc ClashAnnotation]
tvs' <- (TyVar -> m (Doc ClashAnnotation))
-> [TyVar] -> m [Doc ClashAnnotation]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM TyVar -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
TyVar -> m (Doc ClashAnnotation)
pprTvBndr [TyVar]
tvs
  Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Doc ClashAnnotation
forall_ Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
sep [Doc ClashAnnotation]
tvs' Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
forall ann. Doc ann
dot

pprTvBndr :: Monad m => TyVar -> m ClashDoc
pprTvBndr :: forall (m :: Type -> Type).
Monad m =>
TyVar -> m (Doc ClashAnnotation)
pprTvBndr TyVar
tv = do
  Doc ClashAnnotation
tv'   <- TyVar -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM TyVar
tv
  Doc ClashAnnotation
kind' <- Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprKind (TyVar -> Type
forall a. Var a -> Type
varType TyVar
tv)
  Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Doc ClashAnnotation -> Doc ClashAnnotation
tyParens (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ Doc ClashAnnotation
tv' Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> (ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. ann -> Doc ann -> Doc ann
annotate (SyntaxElement -> ClashAnnotation
AnnSyntax SyntaxElement
Type) (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ Doc ClashAnnotation
forall ann. Doc ann
space Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall a. Semigroup a => a -> a -> a
<> Doc ClashAnnotation
dcolon Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
kind')

pprKind :: Monad m => Kind -> m ClashDoc
pprKind :: forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprKind = Type -> m (Doc ClashAnnotation)
forall (m :: Type -> Type).
Monad m =>
Type -> m (Doc ClashAnnotation)
pprType

pprTcApp :: Monad m => TypePrec -> (TypePrec -> Type -> m ClashDoc)
  -> TyConName -> [Type] -> m ClashDoc
pprTcApp :: forall (m :: Type -> Type).
Monad m =>
TypePrec
-> (TypePrec -> Type -> m (Doc ClashAnnotation))
-> TyConName
-> [Type]
-> m (Doc ClashAnnotation)
pprTcApp TypePrec
p TypePrec -> Type -> m (Doc ClashAnnotation)
pp TyConName
tc [Type]
tys
  | [Type] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Type]
tys
  = TyConName -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM TyConName
tc

  | TyConName -> Bool
isTupleTyConLike TyConName
tc
  = do [Doc ClashAnnotation]
tys' <- (Type -> m (Doc ClashAnnotation))
-> [Type] -> m [Doc ClashAnnotation]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (TypePrec -> Type -> m (Doc ClashAnnotation)
pp TypePrec
TopPrec) [Type]
tys
       Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann
parens (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ [Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
sep ([Doc ClashAnnotation] -> Doc ClashAnnotation)
-> [Doc ClashAnnotation] -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ Doc ClashAnnotation
-> [Doc ClashAnnotation] -> [Doc ClashAnnotation]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ClashAnnotation
forall ann. Doc ann
comma [Doc ClashAnnotation]
tys'

  | Bool
isSym
  , [Type
ty1, Type
ty2] <- [Type]
tys
  = do Doc ClashAnnotation
ty1' <- TypePrec -> Type -> m (Doc ClashAnnotation)
pp TypePrec
FunPrec Type
ty1
       Doc ClashAnnotation
ty2' <- TypePrec -> Type -> m (Doc ClashAnnotation)
pp TypePrec
FunPrec Type
ty2
       Doc ClashAnnotation
tc' <- TyConName -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM TyConName
tc
       Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ TypePrec -> TypePrec -> Doc ClashAnnotation -> Doc ClashAnnotation
maybeParen TypePrec
p TypePrec
FunPrec (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$
         [Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
sep [Doc ClashAnnotation
ty1', Doc ClashAnnotation
-> Doc ClashAnnotation
-> Doc ClashAnnotation
-> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose Doc ClashAnnotation
"`" Doc ClashAnnotation
"`" Doc ClashAnnotation
tc' Doc ClashAnnotation -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ClashAnnotation
ty2']

  | Bool
otherwise
  = do [Doc ClashAnnotation]
tys' <- (Type -> m (Doc ClashAnnotation))
-> [Type] -> m [Doc ClashAnnotation]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (TypePrec -> Type -> m (Doc ClashAnnotation)
pp TypePrec
TyConPrec) [Type]
tys
       Doc ClashAnnotation
tc' <- Bool -> Doc ClashAnnotation -> Doc ClashAnnotation
parensIf Bool
isSym (Doc ClashAnnotation -> Doc ClashAnnotation)
-> m (Doc ClashAnnotation) -> m (Doc ClashAnnotation)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> TyConName -> m (Doc ClashAnnotation)
forall (m :: Type -> Type) p.
(Monad m, PrettyPrec p) =>
p -> m (Doc ClashAnnotation)
pprM TyConName
tc
       Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc ClashAnnotation -> m (Doc ClashAnnotation))
-> Doc ClashAnnotation -> m (Doc ClashAnnotation)
forall a b. (a -> b) -> a -> b
$ TypePrec -> TypePrec -> Doc ClashAnnotation -> Doc ClashAnnotation
maybeParen TypePrec
p TypePrec
TyConPrec (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$
         Int -> Doc ClashAnnotation -> Doc ClashAnnotation
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (Doc ClashAnnotation -> Doc ClashAnnotation)
-> Doc ClashAnnotation -> Doc ClashAnnotation
forall a b. (a -> b) -> a -> b
$ [Doc ClashAnnotation] -> Doc ClashAnnotation
forall ann. [Doc ann] -> Doc ann
sep (Doc ClashAnnotation
tc'Doc ClashAnnotation
-> [Doc ClashAnnotation] -> [Doc ClashAnnotation]
forall a. a -> [a] -> [a]
:[Doc ClashAnnotation]
tys')

  where isSym :: Bool
isSym = TyConName -> Bool
forall a. Name a -> Bool
isSymName TyConName
tc

isSymName :: Name a -> Bool
isSymName :: forall a. Name a -> Bool
isSymName Name a
n = Text -> Bool
go (Name a -> Text
forall a. Name a -> Text
nameOcc Name a
n)
  where
    go :: Text -> Bool
go Text
s | Text -> Bool
T.null Text
s           = Bool
False
         | Char -> Bool
isUpper (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
T.head Text
s = Text -> Bool
isLexConSym Text
s
         | Bool
otherwise          = Text -> Bool
isLexSym Text
s

isLexSym :: Text -> Bool
isLexSym :: Text -> Bool
isLexSym Text
cs = Text -> Bool
isLexConSym Text
cs Bool -> Bool -> Bool
|| Text -> Bool
isLexVarSym Text
cs

isLexConSym :: Text -> Bool
isLexConSym :: Text -> Bool
isLexConSym Text
"->" = Bool
True
isLexConSym Text
cs   = Char -> Bool
startsConSym (HasCallStack => Text -> Char
Text -> Char
T.head Text
cs)

isLexVarSym :: Text -> Bool
isLexVarSym :: Text -> Bool
isLexVarSym Text
cs = Char -> Bool
startsVarSym (HasCallStack => Text -> Char
Text -> Char
T.head Text
cs)

startsConSym :: Char -> Bool
startsConSym :: Char -> Bool
startsConSym Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'

startsVarSym :: Char -> Bool
startsVarSym :: Char -> Bool
startsVarSym Char
c = Char -> Bool
isSymbolASCII Char
c Bool -> Bool -> Bool
|| (Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x7f Bool -> Bool -> Bool
&& Char -> Bool
isSymbol Char
c)

isSymbolASCII :: Char -> Bool
isSymbolASCII :: Char -> Bool
isSymbolASCII Char
c = Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` (String
"!#$%&*+./<=>?@\\^|~-" :: String)