{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DerivingStrategies  #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving  #-}

-- ghc-8.8.4 requires -Wno-redundant-constraints
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module GhcTags.Tag
  ( -- * Tag
    TAG_KIND (..)
  , SingTagKind (..)
  , Tag (..)
  , ETag
  , CTag
    -- ** Tag fields
  , TagName (..)
  , TagFilePath (..)
  , ExCommand (..)
  , TagAddress (..)
  , CTagAddress
  , ETagAddress
  , TagKind (..)
  , CTagKind
  , ETagKind
  , TagDefinition (..)
  , TagFields (..)
  , CTagFields
  , ETagFields
  , TagField (..)
    -- ** Ordering and combining tags
  , compareTags
  , combineTags

  -- * Create 'Tag' from a 'GhcTag'
  , ghcTagToTag
  ) where

import           Data.Function (on)
#if   __GLASGOW_HASKELL__ < 810
import           Data.ByteString (ByteString)
#endif
import qualified Data.ByteString as BS
import           Data.Text   (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import           System.FilePath.ByteString (RawFilePath)

-- GHC imports
#if   __GLASGOW_HASKELL__ >= 900
import           GHC.Driver.Session (DynFlags)
#else
import           DynFlags           (DynFlags (pprUserLength))
#endif
#if   __GLASGOW_HASKELL__ >= 900
import           GHC.Data.FastString (bytesFS)
#elif __GLASGOW_HASKELL__ >= 810
import           FastString          (bytesFS)
#else
import           FastString          (FastString (fs_bs))
#endif

#if   __GLASGOW_HASKELL__ >= 900
import           GHC.Types.SrcLoc
                              ( SrcSpan (..)
                              , srcSpanFile
                              , srcSpanStartLine
                              , srcSpanStartCol
                              )
#else
import           SrcLoc       ( SrcSpan (..)
                              , srcSpanFile
                              , srcSpanStartLine
                              , srcSpanStartCol
                              )
#endif

import           GhcTags.Ghc  ( GhcTag (..)
                              , GhcTagKind (..)
                              )
#if   __GLASGOW_HASKELL__ >= 900
import qualified GHC.Utils.Outputable as Out
#else
import qualified Outputable as Out
#endif

#if   __GLASGOW_HASKELL__ < 810
bytesFS :: FastString -> ByteString
bytesFS = fs_bs
#endif

--
-- Tag
--

-- | Promoted data type used to disntinguish 'CTAG's from 'ETAG's.
--
data TAG_KIND = CTAG | ETAG


-- | Singletons for promoted types.
--
data SingTagKind (tk :: TAG_KIND) where
    SingCTag :: SingTagKind CTAG
    SingETag :: SingTagKind ETAG


-- | 'ByteString' which encodes a tag name.
--
newtype TagName = TagName { TagName -> Text
getTagName :: Text }
  deriving (TagName -> TagName -> Bool
(TagName -> TagName -> Bool)
-> (TagName -> TagName -> Bool) -> Eq TagName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagName -> TagName -> Bool
$c/= :: TagName -> TagName -> Bool
== :: TagName -> TagName -> Bool
$c== :: TagName -> TagName -> Bool
Eq, Eq TagName
Eq TagName
-> (TagName -> TagName -> Ordering)
-> (TagName -> TagName -> Bool)
-> (TagName -> TagName -> Bool)
-> (TagName -> TagName -> Bool)
-> (TagName -> TagName -> Bool)
-> (TagName -> TagName -> TagName)
-> (TagName -> TagName -> TagName)
-> Ord TagName
TagName -> TagName -> Bool
TagName -> TagName -> Ordering
TagName -> TagName -> TagName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TagName -> TagName -> TagName
$cmin :: TagName -> TagName -> TagName
max :: TagName -> TagName -> TagName
$cmax :: TagName -> TagName -> TagName
>= :: TagName -> TagName -> Bool
$c>= :: TagName -> TagName -> Bool
> :: TagName -> TagName -> Bool
$c> :: TagName -> TagName -> Bool
<= :: TagName -> TagName -> Bool
$c<= :: TagName -> TagName -> Bool
< :: TagName -> TagName -> Bool
$c< :: TagName -> TagName -> Bool
compare :: TagName -> TagName -> Ordering
$ccompare :: TagName -> TagName -> Ordering
$cp1Ord :: Eq TagName
Ord, Int -> TagName -> ShowS
[TagName] -> ShowS
TagName -> String
(Int -> TagName -> ShowS)
-> (TagName -> String) -> ([TagName] -> ShowS) -> Show TagName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagName] -> ShowS
$cshowList :: [TagName] -> ShowS
show :: TagName -> String
$cshow :: TagName -> String
showsPrec :: Int -> TagName -> ShowS
$cshowsPrec :: Int -> TagName -> ShowS
Show)


-- | When we parse a `tags` file we can eithera find no kind or recognize the
-- kind of GhcTagKind or we store the found character kind.  This allows us to
-- preserve information from parsed tags files which were not created by
-- `ghc-tags-plugin'
--
-- * 'TkTerm' - @`@
-- * 'TkFunction' - @λ@
-- * 'TkTypeConstructor' - @Λ@
-- * 'TkDataConstructor' - @c@
-- * 'TkGADTConstructor' - @g@
-- * 'TkRecordField' - @r@
-- * 'TkTypeSynonym' - @≡@
-- * 'TkTypeSignature' - @⊢@
-- * 'TkPatternSynonym' - @p@
-- * 'TkTypeClass' - @C@
-- * 'TkTypeClassMember' - @m@
-- * 'TkTypeClassInstance' - @i@
-- * 'TkTypeFamily' - @f@
-- * 'TkTypeFamilyInstance' - @F@
-- * 'TkDataTypeFamily' - @d@
-- * 'TkDataTypeFamilyInstance' - @D@
-- * 'TkForeignImport' - @I@
-- * 'TkForeignExport' - @E@
--
data TagKind (tk :: TAG_KIND) where
    TkTerm                   :: TagKind CTAG
    TkFunction               :: TagKind CTAG
    TkTypeConstructor        :: TagKind CTAG
    TkDataConstructor        :: TagKind CTAG
    TkGADTConstructor        :: TagKind CTAG
    TkRecordField            :: TagKind CTAG
    TkTypeSynonym            :: TagKind CTAG
    TkTypeSignature          :: TagKind CTAG
    TkPatternSynonym         :: TagKind CTAG
    TkTypeClass              :: TagKind CTAG
    TkTypeClassMember        :: TagKind CTAG
    TkTypeClassInstance      :: TagKind CTAG
    TkTypeFamily             :: TagKind CTAG
    TkTypeFamilyInstance     :: TagKind CTAG
    TkDataTypeFamily         :: TagKind CTAG
    TkDataTypeFamilyInstance :: TagKind CTAG
    TkForeignImport          :: TagKind CTAG
    TkForeignExport          :: TagKind CTAG
    CharKind                 :: !Char -> TagKind CTAG
    NoKind                   :: TagKind tk

type CTagKind = TagKind CTAG
type ETagKind = TagKind ETAG

deriving instance Eq   (TagKind tk)
deriving instance Ord  (TagKind tk)
deriving instance Show (TagKind tk)


newtype ExCommand = ExCommand { ExCommand -> Text
getExCommand :: Text }
  deriving (ExCommand -> ExCommand -> Bool
(ExCommand -> ExCommand -> Bool)
-> (ExCommand -> ExCommand -> Bool) -> Eq ExCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExCommand -> ExCommand -> Bool
$c/= :: ExCommand -> ExCommand -> Bool
== :: ExCommand -> ExCommand -> Bool
$c== :: ExCommand -> ExCommand -> Bool
Eq, Eq ExCommand
Eq ExCommand
-> (ExCommand -> ExCommand -> Ordering)
-> (ExCommand -> ExCommand -> Bool)
-> (ExCommand -> ExCommand -> Bool)
-> (ExCommand -> ExCommand -> Bool)
-> (ExCommand -> ExCommand -> Bool)
-> (ExCommand -> ExCommand -> ExCommand)
-> (ExCommand -> ExCommand -> ExCommand)
-> Ord ExCommand
ExCommand -> ExCommand -> Bool
ExCommand -> ExCommand -> Ordering
ExCommand -> ExCommand -> ExCommand
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExCommand -> ExCommand -> ExCommand
$cmin :: ExCommand -> ExCommand -> ExCommand
max :: ExCommand -> ExCommand -> ExCommand
$cmax :: ExCommand -> ExCommand -> ExCommand
>= :: ExCommand -> ExCommand -> Bool
$c>= :: ExCommand -> ExCommand -> Bool
> :: ExCommand -> ExCommand -> Bool
$c> :: ExCommand -> ExCommand -> Bool
<= :: ExCommand -> ExCommand -> Bool
$c<= :: ExCommand -> ExCommand -> Bool
< :: ExCommand -> ExCommand -> Bool
$c< :: ExCommand -> ExCommand -> Bool
compare :: ExCommand -> ExCommand -> Ordering
$ccompare :: ExCommand -> ExCommand -> Ordering
$cp1Ord :: Eq ExCommand
Ord, Int -> ExCommand -> ShowS
[ExCommand] -> ShowS
ExCommand -> String
(Int -> ExCommand -> ShowS)
-> (ExCommand -> String)
-> ([ExCommand] -> ShowS)
-> Show ExCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExCommand] -> ShowS
$cshowList :: [ExCommand] -> ShowS
show :: ExCommand -> String
$cshow :: ExCommand -> String
showsPrec :: Int -> ExCommand -> ShowS
$cshowsPrec :: Int -> ExCommand -> ShowS
Show)


-- | Tag address, either from a parsed file or from Haskell's AST>
--
data TagAddress (tk :: TAG_KIND) where
      -- | Precise addres: line and column.  This is what we infer from @GHC@
      -- AST.
      --
      -- The two arguments are line number and either column number or offset
      -- from the begining of the file.
      --
      TagLineCol :: !Int -> !Int -> TagAddress tk

      -- | ctags can only use range ex-commands as an address (or a sequence of
      -- them separated by `;`). We parse line number specifically, since they
      -- are useful for ordering tags.
      --
      TagLine :: !Int -> TagAddress tk

      -- | A tag address can be just an ex command.
      --
      TagCommand :: !ExCommand -> TagAddress CTAG

      -- | etags file format allows to discard the address
      --
      NoAddress :: TagAddress ETAG


-- | 'CTag' addresses.
--
type CTagAddress = TagAddress CTAG

-- | 'ETag' addresses.
--
type ETagAddress = TagAddress ETAG


deriving instance Eq   (TagAddress tk)
deriving instance Ord  (TagAddress tk)
deriving instance Show (TagAddress tk)


-- | Emacs tags specific field.
--
data TagDefinition (tk :: TAG_KIND) where
      TagDefinition   :: !Text -> TagDefinition ETAG
      NoTagDefinition :: TagDefinition tk

deriving instance Show (TagDefinition tk)
deriving instance Eq   (TagDefinition tk)

-- | Unit of data associated with a tag.  Vim natively supports `file:` and
-- `kind:` tags but it can display any other tags too.
--
data TagField = TagField {
      TagField -> Text
fieldName  :: Text,
      TagField -> Text
fieldValue :: Text
    }
  deriving (TagField -> TagField -> Bool
(TagField -> TagField -> Bool)
-> (TagField -> TagField -> Bool) -> Eq TagField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagField -> TagField -> Bool
$c/= :: TagField -> TagField -> Bool
== :: TagField -> TagField -> Bool
$c== :: TagField -> TagField -> Bool
Eq, Eq TagField
Eq TagField
-> (TagField -> TagField -> Ordering)
-> (TagField -> TagField -> Bool)
-> (TagField -> TagField -> Bool)
-> (TagField -> TagField -> Bool)
-> (TagField -> TagField -> Bool)
-> (TagField -> TagField -> TagField)
-> (TagField -> TagField -> TagField)
-> Ord TagField
TagField -> TagField -> Bool
TagField -> TagField -> Ordering
TagField -> TagField -> TagField
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TagField -> TagField -> TagField
$cmin :: TagField -> TagField -> TagField
max :: TagField -> TagField -> TagField
$cmax :: TagField -> TagField -> TagField
>= :: TagField -> TagField -> Bool
$c>= :: TagField -> TagField -> Bool
> :: TagField -> TagField -> Bool
$c> :: TagField -> TagField -> Bool
<= :: TagField -> TagField -> Bool
$c<= :: TagField -> TagField -> Bool
< :: TagField -> TagField -> Bool
$c< :: TagField -> TagField -> Bool
compare :: TagField -> TagField -> Ordering
$ccompare :: TagField -> TagField -> Ordering
$cp1Ord :: Eq TagField
Ord, Int -> TagField -> ShowS
[TagField] -> ShowS
TagField -> String
(Int -> TagField -> ShowS)
-> (TagField -> String) -> ([TagField] -> ShowS) -> Show TagField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagField] -> ShowS
$cshowList :: [TagField] -> ShowS
show :: TagField -> String
$cshow :: TagField -> String
showsPrec :: Int -> TagField -> ShowS
$cshowsPrec :: Int -> TagField -> ShowS
Show)


-- | File field; tags which contain 'fileField' are called static (aka static
-- in @C@), such tags are only visible in the current file)
--
fileField :: TagField
fileField :: TagField
fileField = TagField :: Text -> Text -> TagField
TagField { fieldName :: Text
fieldName = Text
"file", fieldValue :: Text
fieldValue = Text
"" }


-- | Ctags specific list of 'TagField's.
--
data TagFields (tk :: TAG_KIND) where
    NoTagFields :: TagFields ETAG

    TagFields   :: ![TagField]
                -> TagFields CTAG

deriving instance Show (TagFields tk)
deriving instance Eq   (TagFields tk)
instance Semigroup (TagFields tk) where
    TagFields tk
NoTagFields   <> :: TagFields tk -> TagFields tk -> TagFields tk
<> TagFields tk
NoTagFields   = TagFields tk
TagFields 'ETAG
NoTagFields
    (TagFields [TagField]
a) <> (TagFields [TagField]
b) = [TagField] -> TagFields 'CTAG
TagFields ([TagField]
a [TagField] -> [TagField] -> [TagField]
forall a. [a] -> [a] -> [a]
++ [TagField]
b)
instance Monoid (TagFields CTAG) where
    mempty :: TagFields 'CTAG
mempty = [TagField] -> TagFields 'CTAG
TagFields [TagField]
forall a. Monoid a => a
mempty
instance Monoid (TagFields ETAG) where
    mempty :: TagFields 'ETAG
mempty = TagFields 'ETAG
NoTagFields

type CTagFields = TagFields CTAG
type ETagFields = TagFields ETAG

newtype TagFilePath = TagFilePath { TagFilePath -> Text
getRawFilePath :: Text }
  deriving (Eq TagFilePath
Eq TagFilePath
-> (TagFilePath -> TagFilePath -> Ordering)
-> (TagFilePath -> TagFilePath -> Bool)
-> (TagFilePath -> TagFilePath -> Bool)
-> (TagFilePath -> TagFilePath -> Bool)
-> (TagFilePath -> TagFilePath -> Bool)
-> (TagFilePath -> TagFilePath -> TagFilePath)
-> (TagFilePath -> TagFilePath -> TagFilePath)
-> Ord TagFilePath
TagFilePath -> TagFilePath -> Bool
TagFilePath -> TagFilePath -> Ordering
TagFilePath -> TagFilePath -> TagFilePath
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TagFilePath -> TagFilePath -> TagFilePath
$cmin :: TagFilePath -> TagFilePath -> TagFilePath
max :: TagFilePath -> TagFilePath -> TagFilePath
$cmax :: TagFilePath -> TagFilePath -> TagFilePath
>= :: TagFilePath -> TagFilePath -> Bool
$c>= :: TagFilePath -> TagFilePath -> Bool
> :: TagFilePath -> TagFilePath -> Bool
$c> :: TagFilePath -> TagFilePath -> Bool
<= :: TagFilePath -> TagFilePath -> Bool
$c<= :: TagFilePath -> TagFilePath -> Bool
< :: TagFilePath -> TagFilePath -> Bool
$c< :: TagFilePath -> TagFilePath -> Bool
compare :: TagFilePath -> TagFilePath -> Ordering
$ccompare :: TagFilePath -> TagFilePath -> Ordering
$cp1Ord :: Eq TagFilePath
Ord, Int -> TagFilePath -> ShowS
[TagFilePath] -> ShowS
TagFilePath -> String
(Int -> TagFilePath -> ShowS)
-> (TagFilePath -> String)
-> ([TagFilePath] -> ShowS)
-> Show TagFilePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagFilePath] -> ShowS
$cshowList :: [TagFilePath] -> ShowS
show :: TagFilePath -> String
$cshow :: TagFilePath -> String
showsPrec :: Int -> TagFilePath -> ShowS
$cshowsPrec :: Int -> TagFilePath -> ShowS
Show)

instance Eq TagFilePath where
    (TagFilePath Text
a) == :: TagFilePath -> TagFilePath -> Bool
== (TagFilePath Text
b) = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b

-- | Tag record.  For either ctags or etags formats.  It is either filled with
-- information parsed from a tags file or from *GHC* ast.
--
data Tag (tk :: TAG_KIND) = Tag
  { Tag tk -> TagName
tagName       :: !TagName
    -- ^ name of the tag
  , Tag tk -> TagKind tk
tagKind       :: !(TagKind tk)
    -- ^ ctags specifc field, which classifies tags
  , Tag tk -> TagFilePath
tagFilePath   :: !TagFilePath
    -- ^ source file path; it might not be normalised.
  , Tag tk -> TagAddress tk
tagAddr       :: !(TagAddress tk)
    -- ^ address in source file
  , Tag tk -> TagDefinition tk
tagDefinition :: !(TagDefinition tk)
    -- ^ etags specific field; only tags read from emacs tags file contain this
    -- field.
  , Tag tk -> TagFields tk
tagFields     :: !(TagFields tk)
    -- ^ ctags specific field
  }
  deriving (Int -> Tag tk -> ShowS
[Tag tk] -> ShowS
Tag tk -> String
(Int -> Tag tk -> ShowS)
-> (Tag tk -> String) -> ([Tag tk] -> ShowS) -> Show (Tag tk)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (tk :: TAG_KIND). Int -> Tag tk -> ShowS
forall (tk :: TAG_KIND). [Tag tk] -> ShowS
forall (tk :: TAG_KIND). Tag tk -> String
showList :: [Tag tk] -> ShowS
$cshowList :: forall (tk :: TAG_KIND). [Tag tk] -> ShowS
show :: Tag tk -> String
$cshow :: forall (tk :: TAG_KIND). Tag tk -> String
showsPrec :: Int -> Tag tk -> ShowS
$cshowsPrec :: forall (tk :: TAG_KIND). Int -> Tag tk -> ShowS
Show)

instance Eq (Tag tk) where
    Tag tk
t0 == :: Tag tk -> Tag tk -> Bool
== Tag tk
t1 = (TagName -> TagName -> Bool)
-> (Tag tk -> TagName) -> Tag tk -> Tag tk -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on TagName -> TagName -> Bool
forall a. Eq a => a -> a -> Bool
(==) Tag tk -> TagName
forall (tk :: TAG_KIND). Tag tk -> TagName
tagName Tag tk
t0 Tag tk
t1
            Bool -> Bool -> Bool
&& (TagKind tk -> TagKind tk -> Bool)
-> (Tag tk -> TagKind tk) -> Tag tk -> Tag tk -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on TagKind tk -> TagKind tk -> Bool
forall a. Eq a => a -> a -> Bool
(==) Tag tk -> TagKind tk
forall (tk :: TAG_KIND). Tag tk -> TagKind tk
tagKind Tag tk
t0 Tag tk
t1
            Bool -> Bool -> Bool
&& (TagFilePath -> TagFilePath -> Bool)
-> (Tag tk -> TagFilePath) -> Tag tk -> Tag tk -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on TagFilePath -> TagFilePath -> Bool
forall a. Eq a => a -> a -> Bool
(==) Tag tk -> TagFilePath
forall (tk :: TAG_KIND). Tag tk -> TagFilePath
tagFilePath Tag tk
t0 Tag tk
t1
            Bool -> Bool -> Bool
&& (TagAddress tk -> TagAddress tk -> Bool)
-> (Tag tk -> TagAddress tk) -> Tag tk -> Tag tk -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on TagAddress tk -> TagAddress tk -> Bool
forall a. Eq a => a -> a -> Bool
(==) Tag tk -> TagAddress tk
forall (tk :: TAG_KIND). Tag tk -> TagAddress tk
tagAddr Tag tk
t0 Tag tk
t1
            Bool -> Bool -> Bool
&& (TagDefinition tk -> TagDefinition tk -> Bool)
-> (Tag tk -> TagDefinition tk) -> Tag tk -> Tag tk -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on TagDefinition tk -> TagDefinition tk -> Bool
forall a. Eq a => a -> a -> Bool
(==) Tag tk -> TagDefinition tk
forall (tk :: TAG_KIND). Tag tk -> TagDefinition tk
tagDefinition Tag tk
t0 Tag tk
t1
            Bool -> Bool -> Bool
&& (TagFields tk -> TagFields tk -> Bool)
-> (Tag tk -> TagFields tk) -> Tag tk -> Tag tk -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on TagFields tk -> TagFields tk -> Bool
forall a. Eq a => a -> a -> Bool
(==) Tag tk -> TagFields tk
forall (tk :: TAG_KIND). Tag tk -> TagFields tk
tagFields Tag tk
t0 Tag tk
t1


type CTag = Tag CTAG
type ETag = Tag ETAG


-- | Total order relation on 'Tag' elements.
--
-- It sorts type classes / type families ('TkTypeClass', 'TkTypeFamily',
-- 'TkDataTypeFamily')  before instances ('TkTypeClassInstance',
-- 'TkTypeFamilyInstance', 'TkDataTypeFamilyInstance'); but also (as a side
-- effect of keeping transitivity property) it will put type classes and their
-- instances before other kinds.
--
-- It satisfies the following properties:
--
-- * anti-symmetry
-- * reflexivity
-- * transitivity
-- * partial consistency with 'Eq' instance:
--
--   prop> a == b => compareTags a b == EQ
--
compareTags :: forall (tk :: TAG_KIND).
               Ord (TagAddress tk)
            => Tag tk -> Tag tk -> Ordering
compareTags :: Tag tk -> Tag tk -> Ordering
compareTags Tag tk
t0 Tag tk
t1 = (TagName -> TagName -> Ordering)
-> (Tag tk -> TagName) -> Tag tk -> Tag tk -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on TagName -> TagName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Tag tk -> TagName
forall (tk :: TAG_KIND). Tag tk -> TagName
tagName Tag tk
t0 Tag tk
t1
                    -- sort type classes / type families before their instances,
                    -- and take precendence over a file where they are defined.
                    --
                    -- This will also sort type classes and instances before any
                    -- other terms.
                 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (Maybe (TagKind tk) -> Maybe (TagKind tk) -> Ordering)
-> (Tag tk -> Maybe (TagKind tk)) -> Tag tk -> Tag tk -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Maybe (TagKind tk) -> Maybe (TagKind tk) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Tag tk -> Maybe (TagKind tk)
getTkClass  Tag tk
t0 Tag tk
t1
                 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (TagFilePath -> TagFilePath -> Ordering)
-> (Tag tk -> TagFilePath) -> Tag tk -> Tag tk -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on TagFilePath -> TagFilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Tag tk -> TagFilePath
forall (tk :: TAG_KIND). Tag tk -> TagFilePath
tagFilePath Tag tk
t0 Tag tk
t1
                 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (TagAddress tk -> TagAddress tk -> Ordering)
-> (Tag tk -> TagAddress tk) -> Tag tk -> Tag tk -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on TagAddress tk -> TagAddress tk -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Tag tk -> TagAddress tk
forall (tk :: TAG_KIND). Tag tk -> TagAddress tk
tagAddr     Tag tk
t0 Tag tk
t1
                 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (TagKind tk -> TagKind tk -> Ordering)
-> (Tag tk -> TagKind tk) -> Tag tk -> Tag tk -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on TagKind tk -> TagKind tk -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Tag tk -> TagKind tk
forall (tk :: TAG_KIND). Tag tk -> TagKind tk
tagKind     Tag tk
t0 Tag tk
t1

    where
      getTkClass :: Tag tk -> Maybe (TagKind tk)
      getTkClass :: Tag tk -> Maybe (TagKind tk)
getTkClass Tag tk
t = case Tag tk -> TagKind tk
forall (tk :: TAG_KIND). Tag tk -> TagKind tk
tagKind Tag tk
t of
        TagKind tk
TkTypeClass              -> TagKind 'CTAG -> Maybe (TagKind 'CTAG)
forall a. a -> Maybe a
Just TagKind 'CTAG
TkTypeClass
        TagKind tk
TkTypeClassInstance      -> TagKind 'CTAG -> Maybe (TagKind 'CTAG)
forall a. a -> Maybe a
Just TagKind 'CTAG
TkTypeClassInstance
        TagKind tk
TkTypeFamily             -> TagKind 'CTAG -> Maybe (TagKind 'CTAG)
forall a. a -> Maybe a
Just TagKind 'CTAG
TkTypeFamily
        TagKind tk
TkTypeFamilyInstance     -> TagKind 'CTAG -> Maybe (TagKind 'CTAG)
forall a. a -> Maybe a
Just TagKind 'CTAG
TkTypeFamilyInstance
        TagKind tk
TkDataTypeFamily         -> TagKind 'CTAG -> Maybe (TagKind 'CTAG)
forall a. a -> Maybe a
Just TagKind 'CTAG
TkDataTypeFamily
        TagKind tk
TkDataTypeFamilyInstance -> TagKind 'CTAG -> Maybe (TagKind 'CTAG)
forall a. a -> Maybe a
Just TagKind 'CTAG
TkDataTypeFamilyInstance
        TagKind tk
_                        -> Maybe (TagKind tk)
forall a. Maybe a
Nothing



-- | Combine tags from a single /GHC/ module with tags read from a tags file
-- with respect to the given ordering function, e.g. 'GhcTags.CTags.orderTags'
-- or 'GhcTags.ETags.orderTags'.
--
-- This is performance crtitical function.  Tags from the first list are
-- assumeed to be from the same file.
--
-- complexity: /O(max n m)/
--
combineTags :: (Tag tk -> Tag tk -> Ordering)
            -> RawFilePath
            -> [Tag tk] -> [Tag tk] -> [Tag tk]
combineTags :: (Tag tk -> Tag tk -> Ordering)
-> RawFilePath -> [Tag tk] -> [Tag tk] -> [Tag tk]
combineTags Tag tk -> Tag tk -> Ordering
compareFn RawFilePath
modPath = [Tag tk] -> [Tag tk] -> [Tag tk]
go
  where
    go :: [Tag tk] -> [Tag tk] -> [Tag tk]
go as :: [Tag tk]
as@(Tag tk
a : [Tag tk]
as') bs :: [Tag tk]
bs@(Tag tk
b : [Tag tk]
bs')
      | RawFilePath
modPath RawFilePath -> RawFilePath -> Bool
`BS.isSuffixOf` Text -> RawFilePath
Text.encodeUtf8 (TagFilePath -> Text
getRawFilePath (Tag tk -> TagFilePath
forall (tk :: TAG_KIND). Tag tk -> TagFilePath
tagFilePath Tag tk
b))
      = [Tag tk] -> [Tag tk] -> [Tag tk]
go [Tag tk]
as [Tag tk]
bs'
      | Bool
otherwise = case Tag tk
a Tag tk -> Tag tk -> Ordering
`compareFn` Tag tk
b of
          Ordering
LT -> Tag tk
a Tag tk -> [Tag tk] -> [Tag tk]
forall a. a -> [a] -> [a]
: [Tag tk] -> [Tag tk] -> [Tag tk]
go [Tag tk]
as' [Tag tk]
bs
          Ordering
EQ -> Tag tk
a Tag tk -> [Tag tk] -> [Tag tk]
forall a. a -> [a] -> [a]
: [Tag tk] -> [Tag tk] -> [Tag tk]
go [Tag tk]
as' [Tag tk]
bs'
          Ordering
GT -> Tag tk
b Tag tk -> [Tag tk] -> [Tag tk]
forall a. a -> [a] -> [a]
: [Tag tk] -> [Tag tk] -> [Tag tk]
go [Tag tk]
as  [Tag tk]
bs'
    go [] [Tag tk]
bs = (Tag tk -> Bool) -> [Tag tk] -> [Tag tk]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Tag tk
b -> Bool -> Bool
not (RawFilePath
modPath RawFilePath -> RawFilePath -> Bool
`BS.isSuffixOf` Text -> RawFilePath
Text.encodeUtf8 (TagFilePath -> Text
getRawFilePath (Tag tk -> TagFilePath
forall (tk :: TAG_KIND). Tag tk -> TagFilePath
tagFilePath Tag tk
b)))) [Tag tk]
bs
    go [Tag tk]
as [] = [Tag tk]
as
    {-# INLINE go #-}


--
--  GHC interface
--

-- | Create a 'Tag' from 'GhcTag'.
--
ghcTagToTag :: SingTagKind tk -> DynFlags
            -> GhcTag -> Maybe (Tag tk)
#if   __GLASGOW_HASKELL__ >= 902
ghcTagToTag sing _dynFlags GhcTag { gtSrcSpan, gtTag, gtKind, gtIsExported, gtFFI } =
#else
ghcTagToTag :: SingTagKind tk -> DynFlags -> GhcTag -> Maybe (Tag tk)
ghcTagToTag SingTagKind tk
sing  DynFlags
dynFlags GhcTag { SrcSpan
gtSrcSpan :: GhcTag -> SrcSpan
gtSrcSpan :: SrcSpan
gtSrcSpan, RawFilePath
gtTag :: GhcTag -> RawFilePath
gtTag :: RawFilePath
gtTag, GhcTagKind
gtKind :: GhcTag -> GhcTagKind
gtKind :: GhcTagKind
gtKind, Bool
gtIsExported :: GhcTag -> Bool
gtIsExported :: Bool
gtIsExported, Maybe String
gtFFI :: GhcTag -> Maybe String
gtFFI :: Maybe String
gtFFI } =
#endif
    case SrcSpan
gtSrcSpan of
      UnhelpfulSpan {} -> Maybe (Tag tk)
forall a. Maybe a
Nothing
#if   __GLASGOW_HASKELL__ >= 900
      RealSrcSpan realSrcSpan _ ->
#else
      RealSrcSpan RealSrcSpan
realSrcSpan ->
#endif
        Tag tk -> Maybe (Tag tk)
forall a. a -> Maybe a
Just (Tag tk -> Maybe (Tag tk)) -> Tag tk -> Maybe (Tag tk)
forall a b. (a -> b) -> a -> b
$ Tag :: forall (tk :: TAG_KIND).
TagName
-> TagKind tk
-> TagFilePath
-> TagAddress tk
-> TagDefinition tk
-> TagFields tk
-> Tag tk
Tag
          { tagName :: TagName
tagName       = Text -> TagName
TagName (RawFilePath -> Text
Text.decodeUtf8 RawFilePath
gtTag)
          , tagFilePath :: TagFilePath
tagFilePath   = Text -> TagFilePath
TagFilePath
                          (Text -> TagFilePath) -> Text -> TagFilePath
forall a b. (a -> b) -> a -> b
$ RawFilePath -> Text
Text.decodeUtf8
                          (RawFilePath -> Text) -> RawFilePath -> Text
forall a b. (a -> b) -> a -> b
$ FastString -> RawFilePath
bytesFS
                          (FastString -> RawFilePath) -> FastString -> RawFilePath
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
realSrcSpan

          , tagAddr :: TagAddress tk
tagAddr       =
              case SingTagKind tk
sing of
                SingTagKind tk
SingETag -> Int -> TagAddress tk
forall (tk :: TAG_KIND). Int -> TagAddress tk
TagLine    (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
realSrcSpan)
                SingTagKind tk
SingCTag -> Int -> Int -> TagAddress tk
forall (tk :: TAG_KIND). Int -> Int -> TagAddress tk
TagLineCol (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
realSrcSpan)
                                       (RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
realSrcSpan)

          , tagKind :: TagKind tk
tagKind       =
              case SingTagKind tk
sing of
                SingTagKind tk
SingCTag -> GhcTagKind -> TagKind 'CTAG
fromGhcTagKind GhcTagKind
gtKind
                SingTagKind tk
SingETag -> TagKind tk
forall (tk :: TAG_KIND). TagKind tk
NoKind

          , tagDefinition :: TagDefinition tk
tagDefinition = TagDefinition tk
forall (tk :: TAG_KIND). TagDefinition tk
NoTagDefinition

          , tagFields :: TagFields tk
tagFields     = (    SingTagKind tk -> TagFields tk
forall (tk :: TAG_KIND). SingTagKind tk -> TagFields tk
staticField
                              (SingTagKind tk -> TagFields tk)
-> (SingTagKind tk -> TagFields tk)
-> SingTagKind tk
-> TagFields tk
forall a. Semigroup a => a -> a -> a
<> SingTagKind tk -> TagFields tk
forall (tk :: TAG_KIND). SingTagKind tk -> TagFields tk
ffiField
                              (SingTagKind tk -> TagFields tk)
-> (SingTagKind tk -> TagFields tk)
-> SingTagKind tk
-> TagFields tk
forall a. Semigroup a => a -> a -> a
<> SingTagKind tk -> TagFields tk
forall (tk :: TAG_KIND). SingTagKind tk -> TagFields tk
kindField
                            ) SingTagKind tk
sing
          }

  where
    fromGhcTagKind :: GhcTagKind -> CTagKind
    fromGhcTagKind :: GhcTagKind -> TagKind 'CTAG
fromGhcTagKind = \case
      GhcTagKind
GtkTerm                      -> TagKind 'CTAG
TkTerm
      GhcTagKind
GtkFunction                  -> TagKind 'CTAG
TkFunction
      GtkTypeConstructor {}        -> TagKind 'CTAG
TkTypeConstructor
      GtkDataConstructor {}        -> TagKind 'CTAG
TkDataConstructor
      GtkGADTConstructor {}        -> TagKind 'CTAG
TkGADTConstructor
      GhcTagKind
GtkRecordField               -> TagKind 'CTAG
TkRecordField
      GtkTypeSynonym {}            -> TagKind 'CTAG
TkTypeSynonym
      GtkTypeSignature {}          -> TagKind 'CTAG
TkTypeSignature
      GtkTypeKindSignature {}      -> TagKind 'CTAG
TkTypeSignature
      GhcTagKind
GtkPatternSynonym            -> TagKind 'CTAG
TkPatternSynonym
      GhcTagKind
GtkTypeClass                 -> TagKind 'CTAG
TkTypeClass
      GtkTypeClassMember {}        -> TagKind 'CTAG
TkTypeClassMember
      GtkTypeClassInstance {}      -> TagKind 'CTAG
TkTypeClassInstance
      GtkTypeFamily {}             -> TagKind 'CTAG
TkTypeFamily
      GtkTypeFamilyInstance {}     -> TagKind 'CTAG
TkTypeFamilyInstance
      GtkDataTypeFamily {}         -> TagKind 'CTAG
TkDataTypeFamily
      GtkDataTypeFamilyInstance {} -> TagKind 'CTAG
TkDataTypeFamilyInstance
      GhcTagKind
GtkForeignImport             -> TagKind 'CTAG
TkForeignImport
      GhcTagKind
GtkForeignExport             -> TagKind 'CTAG
TkForeignExport

    -- static field (wheather term is exported or not)
    staticField :: SingTagKind tk -> TagFields tk
    staticField :: SingTagKind tk -> TagFields tk
staticField = \case
      SingTagKind tk
SingETag -> TagFields tk
TagFields 'ETAG
NoTagFields
      SingTagKind tk
SingCTag ->
        [TagField] -> TagFields 'CTAG
TagFields ([TagField] -> TagFields 'CTAG) -> [TagField] -> TagFields 'CTAG
forall a b. (a -> b) -> a -> b
$
          if Bool
gtIsExported
            then [TagField]
forall a. Monoid a => a
mempty
            else [TagField
fileField]

    -- ffi field
    ffiField :: SingTagKind tk -> TagFields tk
    ffiField :: SingTagKind tk -> TagFields tk
ffiField = \case
      SingTagKind tk
SingETag -> TagFields tk
TagFields 'ETAG
NoTagFields
      SingTagKind tk
SingCTag ->
        [TagField] -> TagFields 'CTAG
TagFields ([TagField] -> TagFields 'CTAG) -> [TagField] -> TagFields 'CTAG
forall a b. (a -> b) -> a -> b
$
          case Maybe String
gtFFI of
            Maybe String
Nothing  -> [TagField]
forall a. Monoid a => a
mempty
            Just String
ffi -> [Text -> Text -> TagField
TagField Text
"ffi" (String -> Text
Text.pack String
ffi)]


    -- 'TagFields' from 'GhcTagKind'
    kindField :: SingTagKind tk -> TagFields tk
    kindField :: SingTagKind tk -> TagFields tk
kindField = \case
      SingTagKind tk
SingETag -> TagFields tk
TagFields 'ETAG
NoTagFields
      SingTagKind tk
SingCTag ->
        case GhcTagKind
gtKind of
          GtkTypeClassInstance HsType GhcPs
hsType ->
            Text -> HsType GhcPs -> TagFields 'CTAG
forall p. Outputable p => Text -> p -> TagFields 'CTAG
mkField Text
"instance" HsType GhcPs
hsType

          GtkTypeFamily (Just ([GhcPsHsTyVarBndr]
hsTyVars, Either (HsType GhcPs) GhcPsHsTyVarBndr
hsKind)) ->
            [TagField] -> TagFields 'CTAG
TagFields
              [ TagField :: Text -> Text -> TagField
TagField
                 { fieldName :: Text
fieldName  = Text
kindFieldName
                 , fieldValue :: Text
fieldValue = Text -> [Text] -> Text
Text.intercalate Text
" -> " (GhcPsHsTyVarBndr -> Text
forall p. Outputable p => p -> Text
render (GhcPsHsTyVarBndr -> Text) -> [GhcPsHsTyVarBndr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
`map` [GhcPsHsTyVarBndr]
hsTyVars)
                             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case [GhcPsHsTyVarBndr]
hsTyVars of
                                  []      ->           (HsType GhcPs -> Text)
-> (GhcPsHsTyVarBndr -> Text)
-> Either (HsType GhcPs) GhcPsHsTyVarBndr
-> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsType GhcPs -> Text
forall p. Outputable p => p -> Text
render GhcPsHsTyVarBndr -> Text
forall p. Outputable p => p -> Text
render Either (HsType GhcPs) GhcPsHsTyVarBndr
hsKind
                                  (GhcPsHsTyVarBndr
_ : [GhcPsHsTyVarBndr]
_) -> Text
" -> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (HsType GhcPs -> Text)
-> (GhcPsHsTyVarBndr -> Text)
-> Either (HsType GhcPs) GhcPsHsTyVarBndr
-> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsType GhcPs -> Text
forall p. Outputable p => p -> Text
render GhcPsHsTyVarBndr -> Text
forall p. Outputable p => p -> Text
render Either (HsType GhcPs) GhcPsHsTyVarBndr
hsKind

                 }
              ]
          GtkTypeFamilyInstance Maybe (TyFamInstDecl GhcPs)
decl ->
            [TagField] -> TagFields 'CTAG
TagFields
              [ TagField :: Text -> Text -> TagField
TagField
                  { fieldName :: Text
fieldName = Text
typeFieldName
                  , fieldValue :: Text
fieldValue = Maybe (TyFamInstDecl GhcPs) -> Text
forall p. Outputable p => p -> Text
render Maybe (TyFamInstDecl GhcPs)
decl
                  }
              ]

          GtkDataTypeFamily (Just ([GhcPsHsTyVarBndr], Either (HsType GhcPs) GhcPsHsTyVarBndr)
hsKind) ->
            Text
-> ([GhcPsHsTyVarBndr], Either (HsType GhcPs) GhcPsHsTyVarBndr)
-> TagFields 'CTAG
forall p. Outputable p => Text -> p -> TagFields 'CTAG
mkField Text
kindFieldName ([GhcPsHsTyVarBndr], Either (HsType GhcPs) GhcPsHsTyVarBndr)
hsKind

          GtkDataTypeFamilyInstance (Just HsType GhcPs
hsKind) ->
            Text -> HsType GhcPs -> TagFields 'CTAG
forall p. Outputable p => Text -> p -> TagFields 'CTAG
mkField Text
kindFieldName HsType GhcPs
hsKind

          GtkTypeSignature HsWildCardBndrs GhcPs (LHsSigType GhcPs)
hsSigWcType ->
            Text -> HsWildCardBndrs GhcPs (LHsSigType GhcPs) -> TagFields 'CTAG
forall p. Outputable p => Text -> p -> TagFields 'CTAG
mkField Text
typeFieldName HsWildCardBndrs GhcPs (LHsSigType GhcPs)
hsSigWcType

          GtkTypeSynonym HsType GhcPs
hsType ->
            Text -> HsType GhcPs -> TagFields 'CTAG
forall p. Outputable p => Text -> p -> TagFields 'CTAG
mkField Text
typeFieldName HsType GhcPs
hsType

          GtkTypeConstructor (Just HsType GhcPs
hsKind) ->
            Text -> HsType GhcPs -> TagFields 'CTAG
forall p. Outputable p => Text -> p -> TagFields 'CTAG
mkField Text
kindFieldName HsType GhcPs
hsKind

          GtkDataConstructor ConDecl GhcPs
decl ->
            [TagField] -> TagFields 'CTAG
TagFields
              [TagField :: Text -> Text -> TagField
TagField
                { fieldName :: Text
fieldName  = Text
termFieldName
                , fieldValue :: Text
fieldValue = ConDecl GhcPs -> Text
forall p. Outputable p => p -> Text
render ConDecl GhcPs
decl
                }]

          GtkGADTConstructor ConDecl GhcPs
decl ->
            [TagField] -> TagFields 'CTAG
TagFields
              [TagField :: Text -> Text -> TagField
TagField
                { fieldName :: Text
fieldName  = Text
termFieldName
                , fieldValue :: Text
fieldValue = ConDecl GhcPs -> Text
forall p. Outputable p => p -> Text
render ConDecl GhcPs
decl
                }]

          GtkTypeClassMember HsType GhcPs
hsType ->
            Text -> HsType GhcPs -> TagFields 'CTAG
forall p. Outputable p => Text -> p -> TagFields 'CTAG
mkField Text
typeFieldName HsType GhcPs
hsType

          GhcTagKind
_ -> TagFields tk
forall a. Monoid a => a
mempty


    kindFieldName, typeFieldName, termFieldName :: Text
    kindFieldName :: Text
kindFieldName = Text
"Kind" -- "kind" is reserverd
    typeFieldName :: Text
typeFieldName = Text
"type"
    termFieldName :: Text
termFieldName = Text
"term"

    --
    -- fields
    --

    mkField :: Out.Outputable p => Text -> p -> TagFields CTAG
    mkField :: Text -> p -> TagFields 'CTAG
mkField Text
fieldName  p
p =
      [TagField] -> TagFields 'CTAG
TagFields
        [ TagField :: Text -> Text -> TagField
TagField
            { Text
fieldName :: Text
fieldName :: Text
fieldName
            , fieldValue :: Text
fieldValue = p -> Text
forall p. Outputable p => p -> Text
render p
p
            }]

    render :: Out.Outputable p => p -> Text
    render :: p -> Text
render p
hsType =
        Text -> [Text] -> Text
Text.intercalate Text
" " -- remove all line breaks, tabs and multiple spaces
      ([Text] -> Text) -> (String -> [Text]) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.words
      (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
#if   __GLASGOW_HASKELL__ >= 902
      . Out.renderWithContext
          Out.defaultSDocContext { Out.sdocStyle = Out.mkErrStyle Out.neverQualify }
      . Out.ppr
      $ hsType
#elif __GLASGOW_HASKELL__ >= 900
      $ Out.renderWithStyle
          (Out.initSDocContext
            dynFlags
            (Out.setStyleColoured False
              $ Out.mkErrStyle Out.neverQualify))
          (Out.ppr hsType)
          
#else
      (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> PprStyle -> String
Out.renderWithStyle
          (DynFlags
dynFlags { pprUserLength :: Int
pprUserLength = Int
1 })
          (p -> SDoc
forall a. Outputable a => a -> SDoc
Out.ppr p
hsType)
          (Bool -> PprStyle -> PprStyle
Out.setStyleColoured Bool
False
            (PprStyle -> PprStyle) -> PprStyle -> PprStyle
forall a b. (a -> b) -> a -> b
$ DynFlags -> PrintUnqualified -> PprStyle
Out.mkErrStyle DynFlags
dynFlags PrintUnqualified
Out.neverQualify)
#endif