{-# LANGUAGE CPP #-}

module Stan.Hie.Compat904
#if __GLASGOW_HASKELL__ == 904 || __GLASGOW_HASKELL__ == 906 || __GLASGOW_HASKELL__ == 908
    ( -- * Main HIE types
      ContextInfo (..)
    , HieArgs (..)
    , HieAST (..)
    , HieASTs (..)
    , HieFile (..)
    , HieType (..)
    , HieTypeFlat
    , IEType (..)
    , Identifier
    , IdentifierDetails (..)
    , NodeInfo (..)
    , TypeIndex
    , Stan.Hie.Compat904.DeclType (..)
    , hFunTy2
    , conDec
    , eqDeclType
    , Stan.Hie.Compat904.NodeAnnotation
    , mkNodeAnnotation
    , toNodeAnnotation

      -- * Binary interface to hie files
    , HieFileResult (hie_file_result)
    , readHieFileWithNameCache
    , nodeInfo
    ) where

import GHC.Iface.Ext.Binary (HieFileResult (hie_file_result), readHieFile)
import GHC.Iface.Ext.Types
                 (ContextInfo (..), DeclType (..), HieAST (..), HieASTs (..), HieArgs (..),
                 HieFile (..), HieType (..), HieTypeFlat, IEType (..), Identifier,
                 IdentifierDetails (..), NodeInfo (..), TypeIndex,
                 getSourcedNodeInfo, NodeAnnotation(..))
import GHC.Iface.Ext.Utils (emptyNodeInfo)
import GHC.Types.Name.Cache (initNameCache)
import GHC.Data.FastString (FastString)
import GHC.Utils.Outputable (ppr, showSDocUnsafe)

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

import Text.Show (show)

-- This is a direct copy of GHC.Iface.Ext.Utils.emptyNodeInfo except
-- we're using our own redefined combineNodeInfo.
nodeInfo :: Ord a => HieAST a -> NodeInfo a
nodeInfo :: forall a. Ord a => HieAST a -> NodeInfo a
nodeInfo = (NodeInfo a -> NodeInfo a -> NodeInfo a)
-> NodeInfo a -> Map NodeOrigin (NodeInfo a) -> NodeInfo a
forall b a. (b -> a -> b) -> b -> Map NodeOrigin a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' NodeInfo a -> NodeInfo a -> NodeInfo a
forall a. Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
combineNodeInfo NodeInfo a
forall a. NodeInfo a
emptyNodeInfo (Map NodeOrigin (NodeInfo a) -> NodeInfo a)
-> (HieAST a -> Map NodeOrigin (NodeInfo a))
-> HieAST a
-> NodeInfo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a))
-> (HieAST a -> SourcedNodeInfo a)
-> HieAST a
-> Map NodeOrigin (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> SourcedNodeInfo a
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo

-- This is a direct copy of GHC.Iface.Ext.Utils.combineNodeInfo except
-- we use compare rather than nonDetCmpType.
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 b. Ord b => [b] -> [b] -> [b]
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
Map.unionWith IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a
forall a. Semigroup a => a -> a -> a
(<>) NodeIdentifiers a
ad NodeIdentifiers a
bd)
  where
    mergeSorted :: Ord b => [b] -> [b] -> [b]
    mergeSorted :: forall b. Ord b => [b] -> [b] -> [b]
mergeSorted lc :: [b]
lc@(b
c:[b]
cs) ld :: [b]
ld@(b
d:[b]
ds) = case b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare b
c b
d of
                                        Ordering
LT -> b
c b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b] -> [b] -> [b]
forall b. Ord b => [b] -> [b] -> [b]
mergeSorted [b]
cs [b]
ld
                                        Ordering
EQ -> b
c b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b] -> [b] -> [b]
forall b. Ord b => [b] -> [b] -> [b]
mergeSorted [b]
cs [b]
ds
                                        Ordering
GT -> b
d b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b] -> [b] -> [b]
forall b. Ord b => [b] -> [b] -> [b]
mergeSorted [b]
lc [b]
ds
    mergeSorted [b]
cs [] = [b]
cs
    mergeSorted [] [b]
ds = [b]
ds

mkNodeAnnotation :: FastString
                 -> FastString
                 -> Stan.Hie.Compat904.NodeAnnotation
mkNodeAnnotation :: FastString -> FastString -> NodeAnnotation
mkNodeAnnotation FastString
f1 FastString
f2 =
  NodeAnnotation -> NodeAnnotation
Stan.Hie.Compat904.NodeAnnotation (FastString -> FastString -> NodeAnnotation
GHC.Iface.Ext.Types.NodeAnnotation FastString
f1 FastString
f2)

newtype NodeAnnotation = NodeAnnotation GHC.Iface.Ext.Types.NodeAnnotation
  deriving stock (NodeAnnotation -> NodeAnnotation -> Bool
(NodeAnnotation -> NodeAnnotation -> Bool)
-> (NodeAnnotation -> NodeAnnotation -> Bool) -> Eq NodeAnnotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeAnnotation -> NodeAnnotation -> Bool
== :: NodeAnnotation -> NodeAnnotation -> Bool
$c/= :: NodeAnnotation -> NodeAnnotation -> Bool
/= :: NodeAnnotation -> NodeAnnotation -> Bool
Eq, Eq NodeAnnotation
Eq NodeAnnotation =>
(NodeAnnotation -> NodeAnnotation -> Ordering)
-> (NodeAnnotation -> NodeAnnotation -> Bool)
-> (NodeAnnotation -> NodeAnnotation -> Bool)
-> (NodeAnnotation -> NodeAnnotation -> Bool)
-> (NodeAnnotation -> NodeAnnotation -> Bool)
-> (NodeAnnotation -> NodeAnnotation -> NodeAnnotation)
-> (NodeAnnotation -> NodeAnnotation -> NodeAnnotation)
-> Ord NodeAnnotation
NodeAnnotation -> NodeAnnotation -> Bool
NodeAnnotation -> NodeAnnotation -> Ordering
NodeAnnotation -> NodeAnnotation -> NodeAnnotation
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 :: NodeAnnotation -> NodeAnnotation -> Ordering
compare :: NodeAnnotation -> NodeAnnotation -> Ordering
$c< :: NodeAnnotation -> NodeAnnotation -> Bool
< :: NodeAnnotation -> NodeAnnotation -> Bool
$c<= :: NodeAnnotation -> NodeAnnotation -> Bool
<= :: NodeAnnotation -> NodeAnnotation -> Bool
$c> :: NodeAnnotation -> NodeAnnotation -> Bool
> :: NodeAnnotation -> NodeAnnotation -> Bool
$c>= :: NodeAnnotation -> NodeAnnotation -> Bool
>= :: NodeAnnotation -> NodeAnnotation -> Bool
$cmax :: NodeAnnotation -> NodeAnnotation -> NodeAnnotation
max :: NodeAnnotation -> NodeAnnotation -> NodeAnnotation
$cmin :: NodeAnnotation -> NodeAnnotation -> NodeAnnotation
min :: NodeAnnotation -> NodeAnnotation -> NodeAnnotation
Ord)

instance Show Stan.Hie.Compat904.NodeAnnotation where
  show :: NodeAnnotation -> String
show
    (Stan.Hie.Compat904.NodeAnnotation (GHC.Iface.Ext.Types.NodeAnnotation FastString
a1 FastString
a2)) =
    (FastString, FastString) -> String
forall a. Show a => a -> String
Text.Show.show (FastString
a1, FastString
a2)

toNodeAnnotation :: GHC.Iface.Ext.Types.NodeAnnotation
                 -> Stan.Hie.Compat904.NodeAnnotation
toNodeAnnotation :: NodeAnnotation -> NodeAnnotation
toNodeAnnotation = NodeAnnotation -> NodeAnnotation
Stan.Hie.Compat904.NodeAnnotation

-- For forward compatibility: the two-argument function type
-- constructor.
hFunTy2 :: HieType b -> Maybe (b, b)
hFunTy2 :: forall b. HieType b -> Maybe (b, b)
hFunTy2 HieType b
t = case HieType b
t of
  HFunTy b
_multiplicity b
i1 b
i2 -> (b, b) -> Maybe (b, b)
forall a. a -> Maybe a
Just (b
i1, b
i2)
  HieType b
_ -> Maybe (b, b)
forall a. Maybe a
Nothing

readHieFileWithNameCache :: IO (FilePath -> IO HieFileResult)
readHieFileWithNameCache :: IO (String -> IO HieFileResult)
readHieFileWithNameCache = do
    NameCache
nameCache <- Char -> [Name] -> IO NameCache
initNameCache Char
'z' []
    (String -> IO HieFileResult) -> IO (String -> IO HieFileResult)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NameCache -> String -> IO HieFileResult
readHieFile NameCache
nameCache)

newtype DeclType = DeclType GHC.Iface.Ext.Types.DeclType
  deriving stock DeclType -> DeclType -> Bool
(DeclType -> DeclType -> Bool)
-> (DeclType -> DeclType -> Bool) -> Eq DeclType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeclType -> DeclType -> Bool
== :: DeclType -> DeclType -> Bool
$c/= :: DeclType -> DeclType -> Bool
/= :: DeclType -> DeclType -> Bool
Eq

instance Show Stan.Hie.Compat904.DeclType where
  show :: DeclType -> String
show (DeclType DeclType
d) = ShowS
forall a. Show a => a -> String
Text.Show.show (SDoc -> String
showSDocUnsafe (DeclType -> SDoc
forall a. Outputable a => a -> SDoc
ppr DeclType
d))

conDec :: Stan.Hie.Compat904.DeclType
conDec :: DeclType
conDec = DeclType -> DeclType
DeclType DeclType
ConDec

eqDeclType :: Stan.Hie.Compat904.DeclType -> GHC.Iface.Ext.Types.DeclType -> Bool
eqDeclType :: DeclType -> DeclType -> Bool
eqDeclType (DeclType DeclType
d1) DeclType
d2 = DeclType
d1 DeclType -> DeclType -> Bool
forall a. Eq a => a -> a -> Bool
== DeclType
d2
#else
  () where
#endif