{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module GhcTags.Tag
(
TAG_KIND (..)
, SingTagKind (..)
, Tag (..)
, ETag
, CTag
, ETagMap
, CTagMap
, TagName (..)
, TagFilePath (..)
, ExCommand (..)
, TagAddress (..)
, CTagAddress
, ETagAddress
, TagKind (..)
, CTagKind
, ETagKind
, TagDefinition (..)
, TagFields (..)
, CTagFields
, ETagFields
, TagField (..)
, compareTags
, combineTags
, RawFilePath
, rawFilePathToBS
, rawFilePathFromBS
, normaliseRawFilePath
, makeRelativeRawFilePath
, (</>)
, ghcTagToTag
) where
import Control.DeepSeq
import Data.Function (on)
import qualified Data.ByteString as BS
#if __GLASGOW_HASKELL__ >= 906
import qualified Data.ByteString.Char8 as BS.Char8
#endif
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
#if __GLASGOW_HASKELL__ >= 906
import System.OsPath (OsPath)
import qualified System.OsPath as OsPath
import System.IO.Unsafe (unsafePerformIO)
#else
import System.FilePath.ByteString (RawFilePath)
import qualified System.FilePath.ByteString as FilePath.BS
#endif
#if MIN_VERSION_GHC(9,0)
import GHC.Driver.Session (DynFlags)
#else
import DynFlags (DynFlags (pprUserLength))
#endif
#if MIN_VERSION_GHC(9,0)
import GHC.Data.FastString (bytesFS)
#else
import FastString (bytesFS)
#endif
#if MIN_VERSION_GHC(9,0)
import GHC.Types.SrcLoc
( SrcSpan (..)
, srcSpanFile
, srcSpanStartLine
, srcSpanStartCol
)
#else
import SrcLoc ( SrcSpan (..)
, srcSpanFile
, srcSpanStartLine
, srcSpanStartCol
)
#endif
import GhcTags.Ghc ( GhcTag (..)
, GhcTagKind (..)
)
#if MIN_VERSION_GHC(9,0)
import qualified GHC.Utils.Outputable as Out
#else
import qualified Outputable as Out
#endif
#if __GLASGOW_HASKELL__ >= 906
type RawFilePath = OsPath
#endif
rawFilePathToBS :: RawFilePath -> BS.ByteString
#if __GLASGOW_HASKELL__ >= 906
rawFilePathToBS :: RawFilePath -> ByteString
rawFilePathToBS = \RawFilePath
a -> IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.Char8.pack (String -> ByteString) -> IO String -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawFilePath -> IO String
OsPath.decodeFS RawFilePath
a
#else
rawFilePathToBS = id
#endif
rawFilePathFromBS :: BS.ByteString -> RawFilePath
#if __GLASGOW_HASKELL__ >= 906
rawFilePathFromBS :: ByteString -> RawFilePath
rawFilePathFromBS = IO RawFilePath -> RawFilePath
forall a. IO a -> a
unsafePerformIO (IO RawFilePath -> RawFilePath)
-> (ByteString -> IO RawFilePath) -> ByteString -> RawFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO RawFilePath
OsPath.encodeFS (String -> IO RawFilePath)
-> (ByteString -> String) -> ByteString -> IO RawFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS.Char8.unpack
#else
rawFilePathFromBS = id
#endif
normaliseRawFilePath :: RawFilePath -> RawFilePath
#if __GLASGOW_HASKELL__ >= 906
normaliseRawFilePath :: RawFilePath -> RawFilePath
normaliseRawFilePath = RawFilePath -> RawFilePath
OsPath.normalise
#else
normaliseRawFilePath = FilePath.BS.normalise
#endif
makeRelativeRawFilePath :: RawFilePath -> RawFilePath -> RawFilePath
#if __GLASGOW_HASKELL__ >= 906
makeRelativeRawFilePath :: RawFilePath -> RawFilePath -> RawFilePath
makeRelativeRawFilePath = RawFilePath -> RawFilePath -> RawFilePath
OsPath.makeRelative
#else
makeRelativeRawFilePath = FilePath.BS.makeRelative
#endif
(</>) :: RawFilePath -> RawFilePath -> RawFilePath
#if __GLASGOW_HASKELL__ >= 906
</> :: RawFilePath -> RawFilePath -> RawFilePath
(</>) = RawFilePath -> RawFilePath -> RawFilePath
(OsPath.</>)
#else
(</>) = (FilePath.BS.</>)
#endif
data TAG_KIND = CTAG | ETAG
deriving Int -> TAG_KIND -> ShowS
[TAG_KIND] -> ShowS
TAG_KIND -> String
(Int -> TAG_KIND -> ShowS)
-> (TAG_KIND -> String) -> ([TAG_KIND] -> ShowS) -> Show TAG_KIND
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TAG_KIND -> ShowS
showsPrec :: Int -> TAG_KIND -> ShowS
$cshow :: TAG_KIND -> String
show :: TAG_KIND -> String
$cshowList :: [TAG_KIND] -> ShowS
showList :: [TAG_KIND] -> ShowS
Show
data SingTagKind (tk :: TAG_KIND) where
SingCTag :: SingTagKind CTAG
SingETag :: SingTagKind ETAG
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
$c== :: TagName -> TagName -> Bool
== :: TagName -> TagName -> Bool
$c/= :: TagName -> TagName -> Bool
/= :: 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
$ccompare :: TagName -> TagName -> Ordering
compare :: TagName -> TagName -> Ordering
$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
>= :: TagName -> TagName -> Bool
$cmax :: TagName -> TagName -> TagName
max :: TagName -> TagName -> TagName
$cmin :: TagName -> TagName -> TagName
min :: TagName -> TagName -> 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
$cshowsPrec :: Int -> TagName -> ShowS
showsPrec :: Int -> TagName -> ShowS
$cshow :: TagName -> String
show :: TagName -> String
$cshowList :: [TagName] -> ShowS
showList :: [TagName] -> ShowS
Show)
instance NFData TagName where
rnf :: TagName -> ()
rnf = Text -> ()
forall a. NFData a => a -> ()
rnf (Text -> ()) -> (TagName -> Text) -> TagName -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagName -> Text
getTagName
data TagKind where
TkModule :: TagKind
TkTerm :: TagKind
TkFunction :: TagKind
TkTypeConstructor :: TagKind
TkDataConstructor :: TagKind
TkGADTConstructor :: TagKind
TkRecordField :: TagKind
TkTypeSynonym :: TagKind
TkTypeSignature :: TagKind
TkPatternSynonym :: TagKind
TkTypeClass :: TagKind
TkTypeClassMember :: TagKind
TkTypeClassInstance :: TagKind
TkTypeClassInstanceMember :: TagKind
TkTypeFamily :: TagKind
TkTypeFamilyInstance :: TagKind
TkDataTypeFamily :: TagKind
TkDataTypeFamilyInstance :: TagKind
TkForeignImport :: TagKind
TkForeignExport :: TagKind
CharKind :: !Char -> TagKind
NoKind :: TagKind
type CTagKind = TagKind
{-# DEPRECATED CTagKind "Use TagKind" #-}
type ETagKind = TagKind
{-# DEPRECATED ETagKind "Use TagKind" #-}
deriving instance Eq TagKind
deriving instance Ord TagKind
deriving instance Show TagKind
instance NFData TagKind where
rnf :: TagKind -> ()
rnf TagKind
x = TagKind
x TagKind -> () -> ()
forall a b. a -> b -> b
`seq` ()
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
$c== :: ExCommand -> ExCommand -> Bool
== :: ExCommand -> ExCommand -> Bool
$c/= :: ExCommand -> ExCommand -> Bool
/= :: 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
$ccompare :: ExCommand -> ExCommand -> Ordering
compare :: ExCommand -> ExCommand -> Ordering
$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
>= :: ExCommand -> ExCommand -> Bool
$cmax :: ExCommand -> ExCommand -> ExCommand
max :: ExCommand -> ExCommand -> ExCommand
$cmin :: ExCommand -> ExCommand -> ExCommand
min :: ExCommand -> ExCommand -> 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
$cshowsPrec :: Int -> ExCommand -> ShowS
showsPrec :: Int -> ExCommand -> ShowS
$cshow :: ExCommand -> String
show :: ExCommand -> String
$cshowList :: [ExCommand] -> ShowS
showList :: [ExCommand] -> ShowS
Show)
data TagAddress (tk :: TAG_KIND) where
TagLineCol :: !Int -> !Int -> TagAddress tk
TagLine :: !Int -> TagAddress tk
TagCommand :: !ExCommand -> TagAddress CTAG
NoAddress :: TagAddress ETAG
type CTagAddress = TagAddress CTAG
type ETagAddress = TagAddress ETAG
deriving instance Eq (TagAddress tk)
deriving instance Ord (TagAddress tk)
deriving instance Show (TagAddress tk)
instance NFData (TagAddress tt) where
rnf :: TagAddress tt -> ()
rnf TagAddress tt
x = TagAddress tt
x TagAddress tt -> () -> ()
forall a b. a -> b -> b
`seq` ()
data TagDefinition (tk :: TAG_KIND) where
TagDefinition :: !Text -> TagDefinition ETAG
NoTagDefinition :: TagDefinition tk
deriving instance Show (TagDefinition tk)
deriving instance Eq (TagDefinition tk)
deriving instance Ord (TagDefinition tk)
instance NFData (TagDefinition tt) where
rnf :: TagDefinition tt -> ()
rnf TagDefinition tt
x = TagDefinition tt
x TagDefinition tt -> () -> ()
forall a b. a -> b -> b
`seq` ()
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
$c== :: TagField -> TagField -> Bool
== :: TagField -> TagField -> Bool
$c/= :: TagField -> TagField -> Bool
/= :: 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
$ccompare :: TagField -> TagField -> Ordering
compare :: TagField -> TagField -> Ordering
$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
>= :: TagField -> TagField -> Bool
$cmax :: TagField -> TagField -> TagField
max :: TagField -> TagField -> TagField
$cmin :: TagField -> TagField -> TagField
min :: TagField -> TagField -> 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
$cshowsPrec :: Int -> TagField -> ShowS
showsPrec :: Int -> TagField -> ShowS
$cshow :: TagField -> String
show :: TagField -> String
$cshowList :: [TagField] -> ShowS
showList :: [TagField] -> ShowS
Show)
instance NFData TagField where
rnf :: TagField -> ()
rnf TagField { Text
fieldName :: TagField -> Text
fieldName :: Text
fieldName, Text
fieldValue :: TagField -> Text
fieldValue :: Text
fieldValue } =
Text -> ()
forall a. NFData a => a -> ()
rnf Text
fieldName () -> () -> ()
forall a b. a -> b -> b
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
fieldValue
fileField :: TagField
fileField :: TagField
fileField = TagField { fieldName :: Text
fieldName = Text
"file", fieldValue :: Text
fieldValue = Text
"" }
data TagFields (tk :: TAG_KIND) where
NoTagFields :: TagFields ETAG
TagFields :: ![TagField]
-> TagFields CTAG
deriving instance Show (TagFields tk)
deriving instance Eq (TagFields tk)
deriving instance Ord (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]
as <> TagFields [TagField]
bs = [TagField] -> TagFields tk
[TagField] -> TagFields 'CTAG
TagFields
([TagField] -> TagFields tk)
-> (Map Text Text -> [TagField]) -> Map Text Text -> TagFields tk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> TagField) -> [(Text, Text)] -> [TagField]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> TagField) -> (Text, Text) -> TagField
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> TagField
TagField)
([(Text, Text)] -> [TagField])
-> (Map Text Text -> [(Text, Text)]) -> Map Text Text -> [TagField]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList
(Map Text Text -> TagFields tk) -> Map Text Text -> TagFields tk
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TagField -> Text
fieldName TagField
f, TagField -> Text
fieldValue TagField
f) | TagField
f <- [TagField]
as]
Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<>
[(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TagField -> Text
fieldName TagField
f, TagField -> Text
fieldValue TagField
f) | TagField
f <- [TagField]
bs]
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
instance NFData (TagFields tk) where
rnf :: TagFields tk -> ()
rnf TagFields tk
NoTagFields = ()
rnf (TagFields [TagField]
as) = [TagField] -> ()
forall a. NFData a => a -> ()
rnf [TagField]
as
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
$ccompare :: TagFilePath -> TagFilePath -> Ordering
compare :: TagFilePath -> TagFilePath -> Ordering
$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
>= :: TagFilePath -> TagFilePath -> Bool
$cmax :: TagFilePath -> TagFilePath -> TagFilePath
max :: TagFilePath -> TagFilePath -> TagFilePath
$cmin :: TagFilePath -> TagFilePath -> TagFilePath
min :: TagFilePath -> TagFilePath -> 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
$cshowsPrec :: Int -> TagFilePath -> ShowS
showsPrec :: Int -> TagFilePath -> ShowS
$cshow :: TagFilePath -> String
show :: TagFilePath -> String
$cshowList :: [TagFilePath] -> ShowS
showList :: [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
instance NFData TagFilePath where
rnf :: TagFilePath -> ()
rnf = Text -> ()
forall a. NFData a => a -> ()
rnf (Text -> ()) -> (TagFilePath -> Text) -> TagFilePath -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagFilePath -> Text
getRawFilePath
data Tag (tk :: TAG_KIND) = Tag
{ forall (tk :: TAG_KIND). Tag tk -> TagName
tagName :: !TagName
, forall (tk :: TAG_KIND). Tag tk -> TagKind
tagKind :: !TagKind
, forall (tk :: TAG_KIND). Tag tk -> TagFilePath
tagFilePath :: !TagFilePath
, forall (tk :: TAG_KIND). Tag tk -> TagAddress tk
tagAddr :: !(TagAddress tk)
, forall (tk :: TAG_KIND). Tag tk -> TagDefinition tk
tagDefinition :: !(TagDefinition tk)
, forall (tk :: TAG_KIND). Tag tk -> TagFields tk
tagFields :: !(TagFields tk)
}
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
$cshowsPrec :: forall (tk :: TAG_KIND). Int -> Tag tk -> ShowS
showsPrec :: Int -> Tag tk -> ShowS
$cshow :: forall (tk :: TAG_KIND). Tag tk -> String
show :: Tag tk -> String
$cshowList :: forall (tk :: TAG_KIND). [Tag tk] -> ShowS
showList :: [Tag tk] -> ShowS
Show, Eq (Tag tk)
Eq (Tag tk) =>
(Tag tk -> Tag tk -> Ordering)
-> (Tag tk -> Tag tk -> Bool)
-> (Tag tk -> Tag tk -> Bool)
-> (Tag tk -> Tag tk -> Bool)
-> (Tag tk -> Tag tk -> Bool)
-> (Tag tk -> Tag tk -> Tag tk)
-> (Tag tk -> Tag tk -> Tag tk)
-> Ord (Tag tk)
Tag tk -> Tag tk -> Bool
Tag tk -> Tag tk -> Ordering
Tag tk -> Tag tk -> Tag tk
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (tk :: TAG_KIND). Eq (Tag tk)
forall (tk :: TAG_KIND). Tag tk -> Tag tk -> Bool
forall (tk :: TAG_KIND). Tag tk -> Tag tk -> Ordering
forall (tk :: TAG_KIND). Tag tk -> Tag tk -> Tag tk
$ccompare :: forall (tk :: TAG_KIND). Tag tk -> Tag tk -> Ordering
compare :: Tag tk -> Tag tk -> Ordering
$c< :: forall (tk :: TAG_KIND). Tag tk -> Tag tk -> Bool
< :: Tag tk -> Tag tk -> Bool
$c<= :: forall (tk :: TAG_KIND). Tag tk -> Tag tk -> Bool
<= :: Tag tk -> Tag tk -> Bool
$c> :: forall (tk :: TAG_KIND). Tag tk -> Tag tk -> Bool
> :: Tag tk -> Tag tk -> Bool
$c>= :: forall (tk :: TAG_KIND). Tag tk -> Tag tk -> Bool
>= :: Tag tk -> Tag tk -> Bool
$cmax :: forall (tk :: TAG_KIND). Tag tk -> Tag tk -> Tag tk
max :: Tag tk -> Tag tk -> Tag tk
$cmin :: forall (tk :: TAG_KIND). Tag tk -> Tag tk -> Tag tk
min :: Tag tk -> Tag tk -> Tag tk
Ord)
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 -> TagKind -> Bool)
-> (Tag tk -> TagKind) -> Tag tk -> Tag tk -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on TagKind -> TagKind -> Bool
forall a. Eq a => a -> a -> Bool
(==) Tag tk -> TagKind
forall (tk :: TAG_KIND). Tag tk -> TagKind
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
instance NFData (Tag tt) where
rnf :: Tag tt -> ()
rnf Tag {TagFilePath
TagFields tt
TagDefinition tt
TagAddress tt
TagKind
TagName
tagName :: forall (tk :: TAG_KIND). Tag tk -> TagName
tagKind :: forall (tk :: TAG_KIND). Tag tk -> TagKind
tagFilePath :: forall (tk :: TAG_KIND). Tag tk -> TagFilePath
tagAddr :: forall (tk :: TAG_KIND). Tag tk -> TagAddress tk
tagDefinition :: forall (tk :: TAG_KIND). Tag tk -> TagDefinition tk
tagFields :: forall (tk :: TAG_KIND). Tag tk -> TagFields tk
tagName :: TagName
tagKind :: TagKind
tagFilePath :: TagFilePath
tagAddr :: TagAddress tt
tagDefinition :: TagDefinition tt
tagFields :: TagFields tt
..} = TagName -> ()
forall a. NFData a => a -> ()
rnf TagName
tagName
() -> () -> ()
forall a b. a -> b -> b
`seq` TagKind -> ()
forall a. NFData a => a -> ()
rnf TagKind
tagKind
() -> () -> ()
forall a b. a -> b -> b
`seq` TagAddress tt -> ()
forall a. NFData a => a -> ()
rnf TagAddress tt
tagAddr
() -> () -> ()
forall a b. a -> b -> b
`seq` TagDefinition tt -> ()
forall a. NFData a => a -> ()
rnf TagDefinition tt
tagDefinition
() -> () -> ()
forall a b. a -> b -> b
`seq` TagFields tt -> ()
forall a. NFData a => a -> ()
rnf TagFields tt
tagFields
type CTag = Tag CTAG
type ETag = Tag ETAG
type TagMap tt = Map TagFilePath [Tag tt]
type CTagMap = TagMap CTAG
type ETagMap = TagMap ETAG
compareTags :: forall (tk :: TAG_KIND).
Ord (TagAddress tk)
=> Tag tk -> Tag tk -> Ordering
compareTags :: forall (tk :: TAG_KIND).
Ord (TagAddress tk) =>
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
Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (Maybe TagKind -> Maybe TagKind -> Ordering)
-> (Tag tk -> Maybe TagKind) -> Tag tk -> Tag tk -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Maybe TagKind -> Maybe TagKind -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Tag tk -> Maybe TagKind
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 -> TagKind -> Ordering)
-> (Tag tk -> TagKind) -> Tag tk -> Tag tk -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on TagKind -> TagKind -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Tag tk -> TagKind
forall (tk :: TAG_KIND). Tag tk -> TagKind
tagKind Tag tk
t0 Tag tk
t1
where
getTkClass :: Tag tk -> Maybe TagKind
getTkClass :: Tag tk -> Maybe TagKind
getTkClass Tag tk
t = case Tag tk -> TagKind
forall (tk :: TAG_KIND). Tag tk -> TagKind
tagKind Tag tk
t of
TagKind
TkTypeClass -> TagKind -> Maybe TagKind
forall a. a -> Maybe a
Just TagKind
TkTypeClass
TagKind
TkTypeClassInstance -> TagKind -> Maybe TagKind
forall a. a -> Maybe a
Just TagKind
TkTypeClassInstance
TagKind
TkTypeFamily -> TagKind -> Maybe TagKind
forall a. a -> Maybe a
Just TagKind
TkTypeFamily
TagKind
TkTypeFamilyInstance -> TagKind -> Maybe TagKind
forall a. a -> Maybe a
Just TagKind
TkTypeFamilyInstance
TagKind
TkDataTypeFamily -> TagKind -> Maybe TagKind
forall a. a -> Maybe a
Just TagKind
TkDataTypeFamily
TagKind
TkDataTypeFamilyInstance -> TagKind -> Maybe TagKind
forall a. a -> Maybe a
Just TagKind
TkDataTypeFamilyInstance
TagKind
_ -> Maybe TagKind
forall a. Maybe a
Nothing
combineTags :: (Tag tk -> Tag tk -> Ordering)
-> RawFilePath
-> [Tag tk] -> [Tag tk] -> [Tag tk]
combineTags :: forall (tk :: TAG_KIND).
(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
modPath' :: ByteString
modPath' = RawFilePath -> ByteString
rawFilePathToBS RawFilePath
modPath
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')
| ByteString
modPath' ByteString -> ByteString -> Bool
`BS.isSuffixOf` Text -> ByteString
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 (ByteString
modPath' ByteString -> ByteString -> Bool
`BS.isSuffixOf` Text -> ByteString
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 #-}
instance Semigroup (Tag tk) where
Tag tk
a <> :: Tag tk -> Tag tk -> Tag tk
<> Tag tk
b = Tag tk
a { tagFields = tagFields a <> tagFields b }
ghcTagToTag :: SingTagKind tk -> DynFlags
-> GhcTag -> Maybe (Tag tk)
#if MIN_VERSION_GHC(9,2)
ghcTagToTag :: forall (tk :: TAG_KIND).
SingTagKind tk -> DynFlags -> GhcTag -> Maybe (Tag tk)
ghcTagToTag SingTagKind tk
sing DynFlags
_dynFlags GhcTag { SrcSpan
gtSrcSpan :: SrcSpan
gtSrcSpan :: GhcTag -> SrcSpan
gtSrcSpan, ByteString
gtTag :: ByteString
gtTag :: GhcTag -> ByteString
gtTag, GhcTagKind
gtKind :: GhcTagKind
gtKind :: GhcTag -> GhcTagKind
gtKind, Bool
gtIsExported :: Bool
gtIsExported :: GhcTag -> Bool
gtIsExported, Maybe String
gtFFI :: Maybe String
gtFFI :: GhcTag -> Maybe String
gtFFI } =
#else
ghcTagToTag sing dynFlags GhcTag { gtSrcSpan, gtTag, gtKind, gtIsExported, gtFFI } =
#endif
case SrcSpan
gtSrcSpan of
UnhelpfulSpan {} -> Maybe (Tag tk)
forall a. Maybe a
Nothing
#if MIN_VERSION_GHC(9,0)
RealSrcSpan RealSrcSpan
realSrcSpan Maybe BufSpan
_ ->
#else
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
{ tagName :: TagName
tagName = Text -> TagName
TagName (ByteString -> Text
Text.decodeUtf8 ByteString
gtTag)
, tagFilePath :: TagFilePath
tagFilePath = Text -> TagFilePath
TagFilePath
(Text -> TagFilePath) -> Text -> TagFilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeUtf8
(ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ FastString -> ByteString
bytesFS
(FastString -> ByteString) -> FastString -> ByteString
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
tagKind = GhcTagKind -> TagKind
fromGhcTagKind GhcTagKind
gtKind
, 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 -> TagKind
fromGhcTagKind :: GhcTagKind -> TagKind
fromGhcTagKind = \case
GhcTagKind
GtkModule -> TagKind
TkModule
GhcTagKind
GtkTerm -> TagKind
TkTerm
GhcTagKind
GtkFunction -> TagKind
TkFunction
GtkTypeConstructor {} -> TagKind
TkTypeConstructor
GtkDataConstructor {} -> TagKind
TkDataConstructor
GtkGADTConstructor {} -> TagKind
TkGADTConstructor
GhcTagKind
GtkRecordField -> TagKind
TkRecordField
GtkTypeSynonym {} -> TagKind
TkTypeSynonym
GtkTypeSignature {} -> TagKind
TkTypeSignature
GtkTypeKindSignature {} -> TagKind
TkTypeSignature
GhcTagKind
GtkPatternSynonym -> TagKind
TkPatternSynonym
GhcTagKind
GtkTypeClass -> TagKind
TkTypeClass
GtkTypeClassMember {} -> TagKind
TkTypeClassMember
GtkTypeClassInstance {} -> TagKind
TkTypeClassInstance
GtkTypeClassInstanceMember {} -> TagKind
TkTypeClassInstanceMember
GtkTypeFamily {} -> TagKind
TkTypeFamily
GtkTypeFamilyInstance {} -> TagKind
TkTypeFamilyInstance
GtkDataTypeFamily {} -> TagKind
TkDataTypeFamily
GtkDataTypeFamilyInstance {} -> TagKind
TkDataTypeFamilyInstance
GhcTagKind
GtkForeignImport -> TagKind
TkForeignImport
GhcTagKind
GtkForeignExport -> TagKind
TkForeignExport
staticField :: SingTagKind tk -> TagFields tk
staticField :: forall (tk :: TAG_KIND). 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]
ffiField :: SingTagKind tk -> TagFields tk
ffiField :: forall (tk :: TAG_KIND). 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)]
kindField :: SingTagKind tk -> TagFields tk
kindField :: forall (tk :: TAG_KIND). 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
GtkTypeClassInstanceMember 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
{ 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
{ 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 (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> TagFields 'CTAG
forall p. Outputable p => Text -> p -> TagFields 'CTAG
mkField Text
typeFieldName HsWildCardBndrs GhcPs (LHsSigType GhcPs)
HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType 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
{ 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
{ 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"
typeFieldName :: Text
typeFieldName = Text
"type"
termFieldName :: Text
termFieldName = Text
"term"
mkField :: Out.Outputable p => Text -> p -> TagFields CTAG
mkField :: forall p. Outputable p => Text -> p -> TagFields 'CTAG
mkField Text
fieldName p
p =
[TagField] -> TagFields 'CTAG
TagFields
[ 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 :: forall p. Outputable p => p -> Text
render p
hsType =
Text -> [Text] -> Text
Text.intercalate Text
" "
([Text] -> Text) -> (p -> [Text]) -> p -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.words
(Text -> [Text]) -> (p -> Text) -> p -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
#if MIN_VERSION_GHC(9,2)
(String -> Text) -> (p -> String) -> p -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDocContext -> SDoc -> String
Out.renderWithContext
SDocContext
Out.defaultSDocContext { Out.sdocStyle = Out.mkErrStyle Out.neverQualify }
(SDoc -> String) -> (p -> SDoc) -> p -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> SDoc
forall a. Outputable a => a -> SDoc
Out.ppr
(p -> Text) -> p -> Text
forall a b. (a -> b) -> a -> b
$ p
hsType
#elif MIN_VERSION_GHC(9,0)
$ Out.renderWithStyle
(Out.initSDocContext
dynFlags
(Out.setStyleColoured False
$ Out.mkErrStyle Out.neverQualify))
(Out.ppr hsType)
#else
$ Out.renderWithStyle
(dynFlags { pprUserLength = 1 })
(Out.ppr hsType)
(Out.setStyleColoured False
$ Out.mkErrStyle dynFlags Out.neverQualify)
#endif