content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# OPTIONS_GHC -Wno-redundant-constraints -Wno-unused-matches #-}
  
  module Calligraphy.Compat.Lib
    ( sourceInfo,
      showContextInfo,
      readHieFileCompat,
      isInstanceNode,
      isTypeSignatureNode,
      isInlineNode,
      isMinimalNode,
      isDerivingNode,
      showAnns,
      mergeSpans,
      isPointSpan,
      getHieFiles,
    )
  where
  
  import qualified Calligraphy.Compat.GHC as GHC
  import Calligraphy.Prelude
  import Calligraphy.Util.Lens
  import Data.IORef
  import qualified Data.Map as Map
  import qualified Data.Set as Set
  
  #if MIN_VERSION_ghc(9,4,0)
  
  getHieFiles :: [FilePath] -> IO [HieFile]
  getHieFiles filePaths = do
    ref <- newIORef =<< GHC.initNameCache 'z' []
    forM filePaths (readHieFileWithWarning ref)
  
  #else
  
  getHieFiles :: [FilePath] -> IO [HieFile]
  getHieFiles filePaths = do
      uniqSupply <- GHC.mkSplitUniqSupply 'z'
      ref <- newIORef (GHC.initNameCache uniqSupply [])
      forM filePaths (readHieFileWithWarning ref)
  
  #endif
  
  readHieFileWithWarning :: IORef GHC.NameCache -> FilePath -> IO GHC.HieFile
  readHieFileWithWarning ref path = do
    GHC.HieFileResult fileHieVersion fileGHCVersion hie <- readHieFileCompat ref path
    when (GHC.hieVersion /= fileHieVersion) $ do
      putStrLn $ "WARNING: version mismatch in " <> path
      putStrLn $ "    The hie files in this project were generated with GHC version: " <> show fileGHCVersion
      putStrLn $ "    This version of calligraphy was compiled with GHC version: " <> show GHC.hieVersion
      putStrLn "    Optimistically continuing anyway..."
    pure hie
  
  {-# INLINE sourceInfo #-}
  sourceInfo :: Traversal' (HieAST a) (NodeInfo a)
  showContextInfo :: ContextInfo -> String
  readHieFileCompat :: IORef NameCache -> FilePath -> IO HieFileResult
  
  #if MIN_VERSION_ghc(9,4,0)
  
  sourceInfo f (Node (SourcedNodeInfo inf) sp children) = (\inf' -> Node (SourcedNodeInfo inf') sp children) <$> Map.alterF (maybe (pure Nothing) (fmap Just . f)) SourceInfo inf
  
  showContextInfo = showSDocUnsafe . ppr
  
  readHieFileCompat ref path = do
    nameCache <- readIORef ref
    readHieFile nameCache path
  
  #elif MIN_VERSION_ghc(9,0,0)
  
  sourceInfo f (Node (SourcedNodeInfo inf) sp children) = (\inf' -> Node (SourcedNodeInfo inf') sp children) <$> Map.alterF (maybe (pure Nothing) (fmap Just . f)) SourceInfo inf
  
  showContextInfo = showSDocUnsafe . ppr
  
  readHieFileCompat ref = readHieFile (NCU (atomicModifyIORef ref))
  
  #else
  
  sourceInfo f (Node inf sp children) = (\inf' -> Node inf' sp children) <$> f inf
  
  showContextInfo = show
  
  readHieFileCompat ref fp = do
    cache <- readIORef ref
    (res, cache') <- readHieFile cache fp
    writeIORef ref cache'
    pure res
  
  #endif
  
  isInstanceNode :: NodeInfo a -> Bool
  isTypeSignatureNode :: NodeInfo a -> Bool
  isInlineNode :: NodeInfo a -> Bool
  isMinimalNode :: NodeInfo a -> Bool
  isDerivingNode :: NodeInfo a -> Bool
  showAnns :: NodeInfo a -> String
  #if MIN_VERSION_ghc(9,2,0)
  
  isInstanceNode (NodeInfo anns _ _) = any (flip Set.member anns) [NodeAnnotation "ClsInstD" "InstDecl", NodeAnnotation "DerivDecl" "DerivDecl"]
  
  isTypeSignatureNode (NodeInfo anns _ _) = Set.member (NodeAnnotation "TypeSig" "Sig") anns
  
  isInlineNode (NodeInfo anns _ _) = Set.member (NodeAnnotation "InlineSig" "Sig") anns
  
  isMinimalNode (NodeInfo anns _ _) = Set.member (NodeAnnotation "MinimalSig" "Sig") anns
  
  isDerivingNode (NodeInfo anns _ _) = Set.member (NodeAnnotation "HsDerivingClause" "HsDerivingClause") anns
  
  showAnns (NodeInfo anns _ _) = unwords (show . unNodeAnnotation <$> Set.toList anns)
    where
      unNodeAnnotation (NodeAnnotation a b) = (a, b)
  
  #else
  
  isInstanceNode (NodeInfo anns _ _) = any (flip Set.member anns) [("ClsInstD", "InstDecl"), ("DerivDecl", "DerivDecl")]
  
  isTypeSignatureNode (NodeInfo anns _ _) = Set.member ("TypeSig", "Sig") anns
  
  isInlineNode (NodeInfo anns _ _) = Set.member ("InlineSig", "Sig") anns
  
  isMinimalNode (NodeInfo anns _ _) = Set.member ("MinimalSig", "Sig") anns
  
  isDerivingNode (NodeInfo anns _ _) = Set.member ("HsDerivingClause", "HsDerivingClause") anns
  
  showAnns (NodeInfo anns _ _) = unwords (show <$> Set.toList anns)
  
  #endif
  
  mergeSpans :: Span -> Span -> Span
  mergeSpans sp1 sp2 =
    mkRealSrcSpan
      ( min
          (realSrcSpanStart sp1)
          (realSrcSpanStart sp2)
      )
      ( max
          (realSrcSpanEnd sp1)
          (realSrcSpanEnd sp2)
      )
  
  isPointSpan :: Span -> Bool
  isPointSpan sp = realSrcSpanEnd sp <= realSrcSpanStart sp
  