{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-}
module HieDb.Utils where

import qualified Data.Tree

import Prelude hiding (mod)

import Compat.HieBin
import Compat.HieTypes
import qualified Compat.HieTypes as HieTypes
import Compat.HieUtils
import qualified Data.Map as M


import System.Directory
import System.FilePath

import Control.Arrow ( (&&&) )
import Data.Bifunctor ( bimap )
import Data.List (find)
import Control.Monad.IO.Class
import qualified Data.Array as A

import Data.Char
import Data.Int
import Data.Maybe
import Data.Monoid
import Data.IORef

import HieDb.Types
import HieDb.Compat
import Database.SQLite.Simple
import Control.Concurrent

addTypeRef :: HieDb -> FilePath -> A.Array TypeIndex HieTypeFlat -> A.Array TypeIndex (Maybe Int64) -> RealSrcSpan -> TypeIndex -> IO ()
addTypeRef :: HieDb
-> FilePath
-> Array TypeIndex HieTypeFlat
-> Array TypeIndex (Maybe Int64)
-> RealSrcSpan
-> TypeIndex
-> IO ()
addTypeRef (HieDb -> Connection
getConn -> Connection
conn) FilePath
hf Array TypeIndex HieTypeFlat
arr Array TypeIndex (Maybe Int64)
ixs RealSrcSpan
sp = TypeIndex -> TypeIndex -> IO ()
go TypeIndex
0
  where
    sl :: TypeIndex
sl = RealSrcSpan -> TypeIndex
srcSpanStartLine RealSrcSpan
sp
    sc :: TypeIndex
sc = RealSrcSpan -> TypeIndex
srcSpanStartCol RealSrcSpan
sp
    el :: TypeIndex
el = RealSrcSpan -> TypeIndex
srcSpanEndLine RealSrcSpan
sp
    ec :: TypeIndex
ec = RealSrcSpan -> TypeIndex
srcSpanEndCol RealSrcSpan
sp
    go :: TypeIndex -> Int -> IO ()
    go :: TypeIndex -> TypeIndex -> IO ()
go TypeIndex
d TypeIndex
i = do
      case Array TypeIndex (Maybe Int64)
ixs forall i e. Ix i => Array i e -> i -> e
A.! TypeIndex
i of
        Maybe Int64
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just Int64
occ -> do
          let ref :: TypeRef
ref = Int64
-> FilePath
-> TypeIndex
-> TypeIndex
-> TypeIndex
-> TypeIndex
-> TypeIndex
-> TypeRef
TypeRef Int64
occ FilePath
hf TypeIndex
d TypeIndex
sl TypeIndex
sc TypeIndex
el TypeIndex
ec
          forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"INSERT INTO typerefs VALUES (?,?,?,?,?,?,?)" TypeRef
ref
      let next :: TypeIndex -> IO ()
next = TypeIndex -> TypeIndex -> IO ()
go (TypeIndex
dforall a. Num a => a -> a -> a
+TypeIndex
1)
      case Array TypeIndex HieTypeFlat
arr forall i e. Ix i => Array i e -> i -> e
A.! TypeIndex
i of
        HTyVarTy Name
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
#if __GLASGOW_HASKELL__ >= 808
        HAppTy TypeIndex
x (HieArgs [(Bool, TypeIndex)]
xs) -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TypeIndex -> IO ()
next (TypeIndex
xforall a. a -> [a] -> [a]
:forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Bool, TypeIndex)]
xs)
#else
        HAppTy x y -> mapM_ next [x,y]
#endif
        HTyConApp IfaceTyCon
_ (HieArgs [(Bool, TypeIndex)]
xs) -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TypeIndex -> IO ()
next forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Bool, TypeIndex)]
xs
        HForAllTy ((Name
_ , TypeIndex
a),ArgFlag
_) TypeIndex
b -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TypeIndex -> IO ()
next [TypeIndex
a,TypeIndex
b]
#if __GLASGOW_HASKELL__ >= 900
        HFunTy TypeIndex
a TypeIndex
b TypeIndex
c -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TypeIndex -> IO ()
next [TypeIndex
a,TypeIndex
b,TypeIndex
c]
#else
        HFunTy a b -> mapM_ next [a,b]
#endif
        HQualTy TypeIndex
a TypeIndex
b -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TypeIndex -> IO ()
next [TypeIndex
a,TypeIndex
b]
        HLitTy IfaceTyLit
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        HCastTy TypeIndex
a -> TypeIndex -> TypeIndex -> IO ()
go TypeIndex
d TypeIndex
a
        HieTypeFlat
HCoercionTy -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

makeNc :: IO NameCache
makeNc :: IO NameCache
makeNc = do
#if __GLASGOW_HASKELL__ >= 903
  initNameCache 'z' []
#else
  UniqSupply
uniq_supply <- Char -> IO UniqSupply
mkSplitUniqSupply Char
'z'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UniqSupply -> [Name] -> NameCache
initNameCache UniqSupply
uniq_supply []
#endif

-- | Recursively search for @.hie@ and @.hie-boot@  files in given directory
getHieFilesIn :: FilePath -> IO [FilePath]
getHieFilesIn :: FilePath -> IO [FilePath]
getHieFilesIn FilePath
path = do
  Bool
isFile <- FilePath -> IO Bool
doesFileExist FilePath
path
  if Bool
isFile Bool -> Bool -> Bool
&& (FilePath
"hie" FilePath -> FilePath -> Bool
`isExtensionOf` FilePath
path Bool -> Bool -> Bool
|| FilePath
"hie-boot" FilePath -> FilePath -> Bool
`isExtensionOf` FilePath
path) then do
      FilePath
path' <- FilePath -> IO FilePath
canonicalizePath FilePath
path
      forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
path']
  else do
    Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
    if Bool
isDir then do
      [FilePath]
cnts <- FilePath -> IO [FilePath]
listDirectory FilePath
path
      forall a. FilePath -> IO a -> IO a
withCurrentDirectory FilePath
path forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FilePath -> IO [FilePath]
getHieFilesIn [FilePath]
cnts
    else
      forall (m :: * -> *) a. Monad m => a -> m a
return []

withHieFile :: (NameCacheMonad m, MonadIO m)
            => FilePath
            -> (HieFile -> m a)
            -> m a
withHieFile :: forall (m :: * -> *) a.
(NameCacheMonad m, MonadIO m) =>
FilePath -> (HieFile -> m a) -> m a
withHieFile FilePath
path HieFile -> m a
act = do
  NameCacheUpdater
ncu <- forall (m :: * -> *). NameCacheMonad m => m NameCacheUpdater
getNcUpdater
  HieFileResult
hiefile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ NameCacheUpdater -> FilePath -> IO HieFileResult
readHieFile NameCacheUpdater
ncu FilePath
path
  HieFile -> m a
act (HieFileResult -> HieFile
hie_file_result HieFileResult
hiefile)

-- | Given the path to a HieFile, it tries to find the SrcSpan of an External name in
-- it by loading it and then looking for the name in NameCache
findDefInFile :: OccName -> Module -> FilePath -> IO (Either HieDbErr (RealSrcSpan,Module))
findDefInFile :: OccName
-> Module -> FilePath -> IO (Either HieDbErr (RealSrcSpan, Module))
findDefInFile OccName
occ Module
mdl FilePath
file = do
  IORef NameCache
ncr <- forall a. a -> IO (IORef a)
newIORef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NameCache
makeNc
  ()
_ <- forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
ncr forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(NameCacheMonad m, MonadIO m) =>
FilePath -> (HieFile -> m a) -> m a
withHieFile FilePath
file (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())
  NameCache
nc <- forall a. IORef a -> IO a
readIORef IORef NameCache
ncr
#if __GLASGOW_HASKELL__ >= 903
  nsns <- readMVar (nsNames nc)
#else
  let nsns :: OrigNameCache
nsns = NameCache -> OrigNameCache
nsNames NameCache
nc
#endif
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case OrigNameCache -> Module -> OccName -> Maybe Name
lookupOrigNameCache OrigNameCache
nsns Module
mdl OccName
occ of
    Just Name
name -> case Name -> SrcSpan
nameSrcSpan Name
name of
#if __GLASGOW_HASKELL__ >= 900
      RealSrcSpan RealSrcSpan
sp Maybe BufSpan
_ -> forall a b. b -> Either a b
Right (RealSrcSpan
sp, Module
mdl)
#else
      RealSrcSpan sp -> Right (sp, mdl)
#endif
      UnhelpfulSpan UnhelpfulSpanReason
msg -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Name -> FilePath -> HieDbErr
NameUnhelpfulSpan Name
name (FastString -> FilePath
unpackFS forall a b. (a -> b) -> a -> b
$ UnhelpfulSpanReason -> FastString
unhelpfulSpanFS UnhelpfulSpanReason
msg)
    Maybe Name
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ OccName -> Maybe ModuleName -> Maybe Unit -> HieDbErr
NameNotFound OccName
occ (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> ModuleName
moduleName Module
mdl) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> unit
moduleUnit Module
mdl)

pointCommand :: HieFile -> (Int, Int) -> Maybe (Int, Int) -> (HieAST TypeIndex -> a) -> [a]
pointCommand :: forall a.
HieFile
-> (TypeIndex, TypeIndex)
-> Maybe (TypeIndex, TypeIndex)
-> (HieAST TypeIndex -> a)
-> [a]
pointCommand HieFile
hf (TypeIndex
sl,TypeIndex
sc) Maybe (TypeIndex, TypeIndex)
mep HieAST TypeIndex -> a
k =
    forall k a. Map k a -> [a]
M.elems forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
M.mapMaybeWithKey (forall a. HieASTs a -> Map HiePath (HieAST a)
getAsts forall a b. (a -> b) -> a -> b
$ HieFile -> HieASTs TypeIndex
hie_asts HieFile
hf) forall a b. (a -> b) -> a -> b
$ \HiePath
fs HieAST TypeIndex
ast ->
      HieAST TypeIndex -> a
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. RealSrcSpan -> HieAST a -> Maybe (HieAST a)
selectSmallestContaining (FastString -> RealSrcSpan
sp forall a b. (a -> b) -> a -> b
$ HiePath -> FastString
hiePathToFS HiePath
fs) HieAST TypeIndex
ast
 where
   sloc :: FastString -> RealSrcLoc
sloc FastString
fs = FastString -> TypeIndex -> TypeIndex -> RealSrcLoc
mkRealSrcLoc FastString
fs TypeIndex
sl TypeIndex
sc
   eloc :: FastString -> RealSrcLoc
eloc FastString
fs = case Maybe (TypeIndex, TypeIndex)
mep of
     Maybe (TypeIndex, TypeIndex)
Nothing -> FastString -> RealSrcLoc
sloc FastString
fs
     Just (TypeIndex
el,TypeIndex
ec) -> FastString -> TypeIndex -> TypeIndex -> RealSrcLoc
mkRealSrcLoc FastString
fs TypeIndex
el TypeIndex
ec
   sp :: FastString -> RealSrcSpan
sp FastString
fs = RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan (FastString -> RealSrcLoc
sloc FastString
fs) (FastString -> RealSrcLoc
eloc FastString
fs)

dynFlagsForPrinting :: LibDir -> IO DynFlags
dynFlagsForPrinting :: LibDir -> IO DynFlags
dynFlagsForPrinting (LibDir FilePath
libdir) = do
  Settings
systemSettings <- FilePath -> IO Settings
initSysTools
#if __GLASGOW_HASKELL__ >= 808
                    FilePath
libdir
#else
                    (Just libdir)
#endif
#if __GLASGOW_HASKELL__ >= 905
  return $ defaultDynFlags systemSettings
#elif __GLASGOW_HASKELL__ >= 810
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Settings -> LlvmConfig -> DynFlags
defaultDynFlags Settings
systemSettings forall a b. (a -> b) -> a -> b
$ [(FilePath, LlvmTarget)] -> [(TypeIndex, FilePath)] -> LlvmConfig
LlvmConfig [] []
#else
  return $ defaultDynFlags systemSettings ([], [])
#endif

isCons :: String -> Bool
isCons :: FilePath -> Bool
isCons (Char
':':FilePath
_) = Bool
True
isCons (Char
x:FilePath
_) | Char -> Bool
isUpper Char
x = Bool
True
isCons FilePath
_ = Bool
False

genRefsAndDecls :: FilePath -> Module -> M.Map Identifier [(Span, IdentifierDetails a)] -> ([RefRow],[DeclRow])
genRefsAndDecls :: forall a.
FilePath
-> Module
-> Map Identifier [(RealSrcSpan, IdentifierDetails a)]
-> ([RefRow], [DeclRow])
genRefsAndDecls FilePath
path Module
smdl Map Identifier [(RealSrcSpan, IdentifierDetails a)]
refmap = forall {a} {a}.
[(Either a Name, (RealSrcSpan, IdentifierDetails a))]
-> ([RefRow], [DeclRow])
genRows forall a b. (a -> b) -> a -> b
$ forall {t} {a}. [(t, [a])] -> [(t, a)]
flat forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Identifier [(RealSrcSpan, IdentifierDetails a)]
refmap
  where
    flat :: [(t, [a])] -> [(t, a)]
flat = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(t
a,[a]
xs) -> forall a b. (a -> b) -> [a] -> [b]
map (t
a,) [a]
xs)
    genRows :: [(Either a Name, (RealSrcSpan, IdentifierDetails a))]
-> ([RefRow], [DeclRow])
genRows = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a} {a}.
(Either a Name, (RealSrcSpan, IdentifierDetails a))
-> ([RefRow], [DeclRow])
go
    go :: (Either a Name, (RealSrcSpan, IdentifierDetails a))
-> ([RefRow], [DeclRow])
go = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. Maybe a -> [a]
maybeToList forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {a} {b}. (Either a Name, (RealSrcSpan, b)) -> Maybe RefRow
goRef forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall {a} {a} {a}.
(Either a Name, (a, IdentifierDetails a)) -> Maybe DeclRow
goDec)

    goRef :: (Either a Name, (RealSrcSpan, b)) -> Maybe RefRow
goRef (Right Name
name, (RealSrcSpan
sp,b
_))
      | Just Module
mod <- Name -> Maybe Module
nameModule_maybe Name
name = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
          FilePath
-> OccName
-> ModuleName
-> Unit
-> TypeIndex
-> TypeIndex
-> TypeIndex
-> TypeIndex
-> RefRow
RefRow FilePath
path OccName
occ (forall unit. GenModule unit -> ModuleName
moduleName Module
mod) (forall unit. GenModule unit -> unit
moduleUnit Module
mod) TypeIndex
sl TypeIndex
sc TypeIndex
el TypeIndex
ec
          where
            occ :: OccName
occ = Name -> OccName
nameOccName Name
name
            sl :: TypeIndex
sl = RealSrcSpan -> TypeIndex
srcSpanStartLine RealSrcSpan
sp
            sc :: TypeIndex
sc = RealSrcSpan -> TypeIndex
srcSpanStartCol RealSrcSpan
sp
            el :: TypeIndex
el = RealSrcSpan -> TypeIndex
srcSpanEndLine RealSrcSpan
sp
            ec :: TypeIndex
ec = RealSrcSpan -> TypeIndex
srcSpanEndCol RealSrcSpan
sp
    goRef (Either a Name, (RealSrcSpan, b))
_ = forall a. Maybe a
Nothing

    goDec :: (Either a Name, (a, IdentifierDetails a)) -> Maybe DeclRow
goDec (Right Name
name,(a
_,IdentifierDetails a
dets))
      | Just Module
mod <- Name -> Maybe Module
nameModule_maybe Name
name
      , Module
mod forall a. Eq a => a -> a -> Bool
== Module
smdl
      , OccName
occ  <- Name -> OccName
nameOccName Name
name
      , Set ContextInfo
info <- forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
dets
      , Just RealSrcSpan
sp <- Set ContextInfo -> Maybe RealSrcSpan
getBindSpan Set ContextInfo
info
      , Bool
is_root <- Set ContextInfo -> Bool
isRoot Set ContextInfo
info
      , TypeIndex
sl   <- RealSrcSpan -> TypeIndex
srcSpanStartLine RealSrcSpan
sp
      , TypeIndex
sc   <- RealSrcSpan -> TypeIndex
srcSpanStartCol RealSrcSpan
sp
      , TypeIndex
el   <- RealSrcSpan -> TypeIndex
srcSpanEndLine RealSrcSpan
sp
      , TypeIndex
ec   <- RealSrcSpan -> TypeIndex
srcSpanEndCol RealSrcSpan
sp
      = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FilePath
-> OccName
-> TypeIndex
-> TypeIndex
-> TypeIndex
-> TypeIndex
-> Bool
-> DeclRow
DeclRow FilePath
path OccName
occ TypeIndex
sl TypeIndex
sc TypeIndex
el TypeIndex
ec Bool
is_root
    goDec (Either a Name, (a, IdentifierDetails a))
_ = forall a. Maybe a
Nothing

    isRoot :: Set ContextInfo -> Bool
isRoot = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\case
      ValBind BindType
InstanceBind Scope
_ Maybe RealSrcSpan
_ -> Bool
True
      Decl DeclType
_ Maybe RealSrcSpan
_ -> Bool
True
      ContextInfo
_ -> Bool
False)

    getBindSpan :: Set ContextInfo -> Maybe RealSrcSpan
getBindSpan = forall a. First a -> Maybe a
getFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Maybe a -> First a
First forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextInfo -> Maybe RealSrcSpan
goDecl)
    goDecl :: ContextInfo -> Maybe RealSrcSpan
goDecl (ValBind BindType
_ Scope
_ Maybe RealSrcSpan
sp) = Maybe RealSrcSpan
sp
    goDecl (PatternBind Scope
_ Scope
_ Maybe RealSrcSpan
sp) = Maybe RealSrcSpan
sp
    goDecl (Decl DeclType
_ Maybe RealSrcSpan
sp) = Maybe RealSrcSpan
sp
    goDecl (RecField RecFieldContext
_ Maybe RealSrcSpan
sp) = Maybe RealSrcSpan
sp
    goDecl ContextInfo
_ = forall a. Maybe a
Nothing

genDefRow :: FilePath -> Module -> M.Map Identifier [(Span, IdentifierDetails a)] -> [DefRow]
genDefRow :: forall a.
FilePath
-> Module
-> Map Identifier [(RealSrcSpan, IdentifierDetails a)]
-> [DefRow]
genDefRow FilePath
path Module
smod Map Identifier [(RealSrcSpan, IdentifierDetails a)]
refmap = forall {a} {a}.
[(Either a Name, [(RealSrcSpan, IdentifierDetails a)])] -> [DefRow]
genRows forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Identifier [(RealSrcSpan, IdentifierDetails a)]
refmap
  where
    genRows :: [(Either a Name, [(RealSrcSpan, IdentifierDetails a)])] -> [DefRow]
genRows = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {t :: * -> *} {a} {a}.
Foldable t =>
(Either a Name, t (RealSrcSpan, IdentifierDetails a))
-> Maybe DefRow
go
    getSpan :: Name -> t (RealSrcSpan, IdentifierDetails a) -> Maybe RealSrcSpan
getSpan Name
name t (RealSrcSpan, IdentifierDetails a)
dets
#if __GLASGOW_HASKELL__ >= 900
      | RealSrcSpan RealSrcSpan
sp Maybe BufSpan
_ <- Name -> SrcSpan
nameSrcSpan Name
name = forall a. a -> Maybe a
Just RealSrcSpan
sp
#else
      | RealSrcSpan sp <- nameSrcSpan name = Just sp
#endif
      | Bool
otherwise = do
          (RealSrcSpan
sp, IdentifierDetails a
_dets) <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find forall {a} {a}. (a, IdentifierDetails a) -> Bool
defSpan t (RealSrcSpan, IdentifierDetails a)
dets
          forall (f :: * -> *) a. Applicative f => a -> f a
pure RealSrcSpan
sp

    defSpan :: (a, IdentifierDetails a) -> Bool
defSpan = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isDef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IdentifierDetails a -> Set ContextInfo
identInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
    isDef :: ContextInfo -> Bool
isDef (ValBind BindType
RegularBind Scope
_ Maybe RealSrcSpan
_) = Bool
True
    isDef PatternBind{}             = Bool
True
    isDef Decl{}                    = Bool
True
    isDef ContextInfo
_                         = Bool
False

    go :: (Either a Name, t (RealSrcSpan, IdentifierDetails a))
-> Maybe DefRow
go (Right Name
name,t (RealSrcSpan, IdentifierDetails a)
dets)
      | Just Module
mod <- Name -> Maybe Module
nameModule_maybe Name
name
      , Module
mod forall a. Eq a => a -> a -> Bool
== Module
smod
      , OccName
occ  <- Name -> OccName
nameOccName Name
name
      , Just RealSrcSpan
sp <- forall {t :: * -> *} {a}.
Foldable t =>
Name -> t (RealSrcSpan, IdentifierDetails a) -> Maybe RealSrcSpan
getSpan Name
name t (RealSrcSpan, IdentifierDetails a)
dets
      , TypeIndex
sl   <- RealSrcSpan -> TypeIndex
srcSpanStartLine RealSrcSpan
sp
      , TypeIndex
sc   <- RealSrcSpan -> TypeIndex
srcSpanStartCol RealSrcSpan
sp
      , TypeIndex
el   <- RealSrcSpan -> TypeIndex
srcSpanEndLine RealSrcSpan
sp
      , TypeIndex
ec   <- RealSrcSpan -> TypeIndex
srcSpanEndCol RealSrcSpan
sp
      = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FilePath
-> OccName
-> TypeIndex
-> TypeIndex
-> TypeIndex
-> TypeIndex
-> DefRow
DefRow FilePath
path OccName
occ TypeIndex
sl TypeIndex
sc TypeIndex
el TypeIndex
ec
    go (Either a Name, t (RealSrcSpan, IdentifierDetails a))
_ = forall a. Maybe a
Nothing

identifierTree :: HieTypes.HieAST a -> Data.Tree.Tree ( HieTypes.HieAST a )
identifierTree :: forall a. HieAST a -> Tree (HieAST a)
identifierTree nd :: HieAST a
nd@HieTypes.Node{ [HieAST a]
nodeChildren :: forall a. HieAST a -> [HieAST a]
nodeChildren :: [HieAST a]
nodeChildren } =
  Data.Tree.Node
    { rootLabel :: HieAST a
rootLabel = HieAST a
nd { nodeChildren :: [HieAST a]
nodeChildren = forall a. Monoid a => a
mempty }
    , subForest :: [Tree (HieAST a)]
subForest = forall a b. (a -> b) -> [a] -> [b]
map forall a. HieAST a -> Tree (HieAST a)
identifierTree [HieAST a]
nodeChildren
    }

generateExports :: FilePath -> [AvailInfo] -> [ExportRow]
generateExports :: FilePath -> [AvailInfo] -> [ExportRow]
generateExports FilePath
fp = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [ExportRow]
generateExport where
  generateExport :: AvailInfo -> [ExportRow]
  generateExport :: AvailInfo -> [ExportRow]
generateExport (AvailName Name
n)
    = [ExportRow
        { exportHieFile :: FilePath
exportHieFile = FilePath
fp
        , exportName :: OccName
exportName = Name -> OccName
nameOccName Name
n
        , exportMod :: ModuleName
exportMod = forall unit. GenModule unit -> ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
nameModule Name
n
        , exportUnit :: Unit
exportUnit = forall unit. GenModule unit -> unit
moduleUnit forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
nameModule Name
n
        , exportParent :: Maybe OccName
exportParent = forall a. Maybe a
Nothing
        , exportParentMod :: Maybe ModuleName
exportParentMod = forall a. Maybe a
Nothing
        , exportParentUnit :: Maybe Unit
exportParentUnit = forall a. Maybe a
Nothing
        , exportIsDatacon :: Bool
exportIsDatacon = Bool
False
        }]
  generateExport (AvailFL FieldLabel
fl)
    = [ExportRow
        { exportHieFile :: FilePath
exportHieFile = FilePath
fp
        , exportName :: OccName
exportName = OccName
n
        , exportMod :: ModuleName
exportMod = ModuleName
m
        , exportUnit :: Unit
exportUnit = Unit
u
        , exportParent :: Maybe OccName
exportParent = forall a. Maybe a
Nothing
        , exportParentMod :: Maybe ModuleName
exportParentMod = forall a. Maybe a
Nothing
        , exportParentUnit :: Maybe Unit
exportParentUnit = forall a. Maybe a
Nothing
        , exportIsDatacon :: Bool
exportIsDatacon = Bool
False
        }]
      where
        (OccName
n, ModuleName
m, Unit
u) = (FastString -> OccName
mkVarOccFS forall a b. (a -> b) -> a -> b
$ forall a. a -> a
field_label forall a b. (a -> b) -> a -> b
$ FieldLabel -> FastString
flLabel FieldLabel
fl
                    -- For fields, the module details come from the parent
                    ,forall unit. GenModule unit -> ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
nameModule forall a b. (a -> b) -> a -> b
$ FieldLabel -> Name
flSelector FieldLabel
fl
                    ,forall unit. GenModule unit -> unit
moduleUnit forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
nameModule forall a b. (a -> b) -> a -> b
$ FieldLabel -> Name
flSelector FieldLabel
fl
                    )
  generateExport (AvailTC Name
name [Name]
pieces [FieldLabel]
fields)
    = ExportRow
        { exportHieFile :: FilePath
exportHieFile = FilePath
fp
        , exportName :: OccName
exportName = Name -> OccName
nameOccName Name
name
        , exportMod :: ModuleName
exportMod = forall unit. GenModule unit -> ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
nameModule Name
name
        , exportUnit :: Unit
exportUnit = forall unit. GenModule unit -> unit
moduleUnit forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
nameModule Name
name
        , exportParent :: Maybe OccName
exportParent = forall a. Maybe a
Nothing
        , exportParentMod :: Maybe ModuleName
exportParentMod = forall a. Maybe a
Nothing
        , exportParentUnit :: Maybe Unit
exportParentUnit = forall a. Maybe a
Nothing
        , exportIsDatacon :: Bool
exportIsDatacon = Bool
False}
    forall a. a -> [a] -> [a]
: [ExportRow
        { exportHieFile :: FilePath
exportHieFile = FilePath
fp
        , exportName :: OccName
exportName = OccName
n
        , exportMod :: ModuleName
exportMod = ModuleName
m
        , exportUnit :: Unit
exportUnit = Unit
u
        , exportParent :: Maybe OccName
exportParent = forall a. a -> Maybe a
Just (Name -> OccName
nameOccName Name
name)
        , exportParentMod :: Maybe ModuleName
exportParentMod = forall a. a -> Maybe a
Just (forall unit. GenModule unit -> ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
nameModule Name
name)
        , exportParentUnit :: Maybe Unit
exportParentUnit = forall a. a -> Maybe a
Just (forall unit. GenModule unit -> unit
moduleUnit forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
nameModule Name
name)
        , exportIsDatacon :: Bool
exportIsDatacon = Bool
False}
      | (OccName
n,ModuleName
m,Unit
u) <- forall a b. (a -> b) -> [a] -> [b]
map (\Name
n ->
                        (Name -> OccName
nameOccName Name
n
                        ,forall unit. GenModule unit -> ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
nameModule Name
n
                        ,forall unit. GenModule unit -> unit
moduleUnit forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
nameModule Name
n
                        ))
                      (forall a. TypeIndex -> [a] -> [a]
drop TypeIndex
1 [Name]
pieces)
               forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map (\FieldLabel
s ->
                        (FastString -> OccName
mkVarOccFS forall a b. (a -> b) -> a -> b
$ forall a. a -> a
field_label forall a b. (a -> b) -> a -> b
$ FieldLabel -> FastString
flLabel FieldLabel
s
                        -- For fields, the module details come from the parent
                        ,forall unit. GenModule unit -> ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
nameModule Name
name
                        ,forall unit. GenModule unit -> unit
moduleUnit forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
nameModule Name
name
                        ))
                      [FieldLabel]
fields
      ]