{-# LANGUAGE CPP, PatternSynonyms, ViewPatterns, TupleSections #-}
module HieDb.Compat (
    nodeInfo'
    , Unit
    , unitString
    , stringToUnit
    , moduleUnit
    , unhelpfulSpanFS
    -- * Types re-exports
    , ModuleName
    , mkModuleName
    , moduleName
    , moduleNameString
    , Fingerprint
    , unpackFS
    , readHexFingerprint
    , getFileHash
    , NameSpace
    , OccName
    , mkOccName
    , nameOccName
    , occNameSpace
    , occNameString
    , mkVarOccFS
    , Name
    , nameSrcSpan
#if __GLASGOW_HASKELL__ >= 903
    , NameCacheUpdater
#else
    , NameCacheUpdater(..)
#endif
    , NameCache
    , nsNames
    , initNameCache
    , lookupOrigNameCache
    , Module
    , mkModule
    , nameModule_maybe
    , nameModule
    , varName
    , isVarNameSpace
    , dataName
    , isDataConNameSpace
    , tcClsName
    , isTcClsNameSpace
    , tvName
    , isTvNameSpace
    , flLabel
    -- * Dynflags re-exports
    , DynFlags
    , defaultDynFlags
    , LlvmConfig(..)
    -- * AvailInfo
    , Avail.AvailInfo
    , pattern AvailName
    , pattern AvailFL
    , pattern AvailTC
    , flSelector
    -- * SrcSpan
    , SrcSpan(..)
    , RealSrcSpan
    , mkRealSrcLoc
    , mkRealSrcSpan
    , srcSpanStartLine
    , srcSpanStartCol
    , srcSpanEndLine
    , srcSpanEndCol
    , mkSplitUniqSupply
    -- * Systools
    , initSysTools
    -- * Hie Types
    , HiePath
    , hiePathToFS
    -- * Outputable
    , (<+>)
    , ppr
    , showSDoc
    , hang
    , text
    -- * FastString
    , FastString
    -- * IFace
    , IfaceType
    , IfaceTyCon(..)
    , field_label
    , dfs
    , fieldNameSpace_maybe
    , fieldName
    , mkFastStringByteString
) where

import Compat.HieTypes

import GHC.Data.FastString as FS
import GHC.Driver.Session
import GHC.Iface.Env
import GHC.Iface.Type
import GHC.SysTools
import qualified GHC.Types.Avail as Avail
import GHC.Types.FieldLabel
import GHC.Types.Name
import GHC.Types.Name.Cache
import GHC.Types.Unique.Supply
import GHC.Unit.Types
#if __GLASGOW_HASKELL__ >= 905
import Language.Haskell.Syntax.Module.Name
import GHC.CmmToLlvm.Config
import Language.Haskell.Syntax.Basic
#else
import GHC.Unit.Module.Name
#endif
import GHC.Utils.Fingerprint
#if __GLASGOW_HASKELL__ >= 902
import GHC.Driver.Ppr (showSDoc)
import GHC.Utils.Outputable (ppr, (<+>), hang, text)
#else
import GHC.Utils.Outputable (showSDoc, ppr, (<+>), hang, text)
#endif

import qualified Algebra.Graph.AdjacencyMap           as Graph
import qualified Algebra.Graph.AdjacencyMap.Algorithm as Graph

import GHC.Types.SrcLoc
import Compat.HieUtils

import qualified Data.Map as M
import qualified Data.Set as S


-- nodeInfo' :: Ord a => HieAST a -> NodeInfo a
nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex
nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex
nodeInfo' = (NodeInfo TypeIndex -> NodeInfo TypeIndex -> NodeInfo TypeIndex)
-> NodeInfo TypeIndex
-> Map NodeOrigin (NodeInfo TypeIndex)
-> NodeInfo TypeIndex
forall a b k. (a -> b -> a) -> a -> Map k b -> a
M.foldl' NodeInfo TypeIndex -> NodeInfo TypeIndex -> NodeInfo TypeIndex
forall a. Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
combineNodeInfo' NodeInfo TypeIndex
forall a. NodeInfo a
emptyNodeInfo (Map NodeOrigin (NodeInfo TypeIndex) -> NodeInfo TypeIndex)
-> (HieAST TypeIndex -> Map NodeOrigin (NodeInfo TypeIndex))
-> HieAST TypeIndex
-> NodeInfo TypeIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo TypeIndex -> Map NodeOrigin (NodeInfo TypeIndex)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo (SourcedNodeInfo TypeIndex -> Map NodeOrigin (NodeInfo TypeIndex))
-> (HieAST TypeIndex -> SourcedNodeInfo TypeIndex)
-> HieAST TypeIndex
-> Map NodeOrigin (NodeInfo TypeIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST TypeIndex -> SourcedNodeInfo TypeIndex
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo

combineNodeInfo' :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
(NodeInfo Set NodeAnnotation
as [a]
ai NodeIdentifiers a
ad) combineNodeInfo' :: forall a. Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
`combineNodeInfo'` (NodeInfo Set NodeAnnotation
bs [a]
bi NodeIdentifiers a
bd) =
  Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
forall a.
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
NodeInfo (Set NodeAnnotation -> Set NodeAnnotation -> Set NodeAnnotation
forall a. Ord a => Set a -> Set a -> Set a
S.union Set NodeAnnotation
as Set NodeAnnotation
bs) ([a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
ai [a]
bi) ((IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a)
-> NodeIdentifiers a -> NodeIdentifiers a -> NodeIdentifiers a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a
forall a. Semigroup a => a -> a -> a
(<>) NodeIdentifiers a
ad NodeIdentifiers a
bd)
  where
    mergeSorted :: Ord a => [a] -> [a] -> [a]
    mergeSorted :: forall a. Ord a => [a] -> [a] -> [a]
mergeSorted la :: [a]
la@(a
a:[a]
as) lb :: [a]
lb@(a
b:[a]
bs) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b of
                                        Ordering
LT -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
as [a]
lb
                                        Ordering
EQ -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
as [a]
bs
                                        Ordering
GT -> a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
la [a]
bs
    mergeSorted [a]
as [] = [a]
as
    mergeSorted [] [a]
bs = [a]
bs

#if __GLASGOW_HASKELL__ < 902
type HiePath = FastString
#endif

hiePathToFS :: HiePath -> FastString
#if __GLASGOW_HASKELL__ >= 902
hiePathToFS :: HiePath -> FastString
hiePathToFS (LexicalFastString FastString
fs) = FastString
fs
#else
hiePathToFS fs = fs
#endif

{-# COMPLETE AvailTC, AvailName, AvailFL #-}

pattern AvailTC :: Name -> [Name] -> [FieldLabel] -> Avail.AvailInfo
#if __GLASGOW_HASKELL__ >= 907
pattern AvailTC n names pieces <- Avail.AvailTC n ((,[]) -> (names,pieces))
#elif __GLASGOW_HASKELL__ >= 902
pattern $mAvailTC :: forall {r}.
AvailInfo
-> (Name -> [Name] -> [FieldLabel] -> r) -> ((# #) -> r) -> r
AvailTC n names pieces <- Avail.AvailTC n ((\[GreName]
gres -> (GreName -> ([Name], [FieldLabel]) -> ([Name], [FieldLabel]))
-> ([Name], [FieldLabel]) -> [GreName] -> ([Name], [FieldLabel])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\GreName
gre ([Name]
names, [FieldLabel]
pieces) -> case GreName
gre of
      Avail.NormalGreName Name
name -> (Name
nameName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
names, [FieldLabel]
pieces)
      Avail.FieldGreName FieldLabel
label -> ([Name]
names, FieldLabel
labelFieldLabel -> [FieldLabel] -> [FieldLabel]
forall a. a -> [a] -> [a]
:[FieldLabel]
pieces)) ([], []) [GreName]
gres) -> (names, pieces))
#else
pattern AvailTC n names pieces <- Avail.AvailTC n names pieces
#endif

pattern AvailName :: Name -> Avail.AvailInfo
#if __GLASGOW_HASKELL__ >= 907
pattern AvailName n <- Avail.Avail n
#elif __GLASGOW_HASKELL__ >= 902
pattern $mAvailName :: forall {r}. AvailInfo -> (Name -> r) -> ((# #) -> r) -> r
AvailName n <- Avail.Avail (Avail.NormalGreName n)
#else
pattern AvailName n <- Avail.Avail n
#endif

pattern AvailFL :: FieldLabel -> Avail.AvailInfo
#if __GLASGOW_HASKELL__ >= 907
pattern AvailFL fl <- (const Nothing -> Just fl) -- this pattern always fails as this field was removed in 9.7
#elif __GLASGOW_HASKELL__ >= 902
pattern $mAvailFL :: forall {r}. AvailInfo -> (FieldLabel -> r) -> ((# #) -> r) -> r
AvailFL fl <- Avail.Avail (Avail.FieldGreName fl)
#else
-- pattern synonym that is never populated
pattern AvailFL x <- Avail.Avail ((\_ -> (True, undefined)) -> (False, x))
#endif

#if __GLASGOW_HASKELL__ >= 903
type NameCacheUpdater = NameCache
#endif

#if __GLASGOW_HASKELL__ < 905
field_label :: a -> a
field_label = id
#endif

dfs :: Ord a => Graph.AdjacencyMap a -> [a] -> [a]
#if MIN_VERSION_algebraic_graphs(0,7,0)
dfs :: forall a. Ord a => AdjacencyMap a -> [a] -> [a]
dfs = AdjacencyMap a -> [a] -> [a]
forall a. Ord a => AdjacencyMap a -> [a] -> [a]
Graph.dfs
#else
dfs = flip Graph.dfs
#endif

fieldNameSpace_maybe :: NameSpace -> Maybe FastString
#if __GLASGOW_HASKELL__ >= 907
-- This is horrible, we can improve it once
-- https://gitlab.haskell.org/ghc/ghc/-/issues/24244 is addressed
fieldNameSpace_maybe ns = fieldOcc_maybe (mkOccName ns "")
#else
fieldNameSpace_maybe :: NameSpace -> Maybe FastString
fieldNameSpace_maybe NameSpace
_ = Maybe FastString
forall a. Maybe a
Nothing
#endif

#if __GLASGOW_HASKELL__ < 907
fieldName :: FastString -> NameSpace
fieldName :: FastString -> NameSpace
fieldName FastString
_ = NameSpace
varName
#endif