{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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 qualified Data.Set as S

import System.Directory
import System.FilePath

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.Monad.State.Strict (StateT, get, put)
import qualified Data.IntSet as ISet
import qualified Data.IntMap.Strict as IMap
import Data.IntMap.Strict (IntMap)
import Data.IntSet (IntSet)
import Control.Monad (guard, unless)

#if __GLASGOW_HASKELL__ >= 903
import Control.Concurrent.MVar (readMVar)
#endif

-- Each AST Node can have a lot of repetitive type information,
-- esp. when deriving is involved.
-- This StateT state keeps track of which types in AST we already indexed
-- to avoid having repeated (Depth, Type) inserted under the same RealSrcSpan.
--
-- This `IntMap IntSet` is morally `Map Depth (Set TypeIndex)` mapping
-- the depth (of a type within tree structure of types - ends up as typerefs.depth)
-- to a list of type IDs (identifiers of types assigned as id within typenames table)
-- that we already indexed.
type TypeIndexing a = StateT (IntMap IntSet) IO a

addTypeRef :: HieDb -> FilePath -> A.Array TypeIndex HieTypeFlat -> A.Array TypeIndex (Maybe Int64) -> RealSrcSpan -> TypeIndex -> TypeIndexing ()
addTypeRef :: HieDb
-> FilePath
-> Array TypeIndex HieTypeFlat
-> Array TypeIndex (Maybe Int64)
-> RealSrcSpan
-> TypeIndex
-> TypeIndexing ()
addTypeRef (HieDb -> Connection
getConn -> Connection
conn) FilePath
hf Array TypeIndex HieTypeFlat
arr Array TypeIndex (Maybe Int64)
ixs RealSrcSpan
sp = TypeIndex -> TypeIndex -> TypeIndexing ()
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 :: Int -> TypeIndex -> TypeIndexing ()
    go :: TypeIndex -> TypeIndex -> TypeIndexing ()
go TypeIndex
depth TypeIndex
i = do
      case Array TypeIndex (Maybe Int64)
ixs Array TypeIndex (Maybe Int64) -> TypeIndex -> Maybe Int64
forall i e. Ix i => Array i e -> i -> e
A.! TypeIndex
i of
        Maybe Int64
Nothing -> () -> TypeIndexing ()
forall a. a -> StateT (IntMap IntSet) IO a
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
depth TypeIndex
sl TypeIndex
sc TypeIndex
el TypeIndex
ec
          IntMap IntSet
indexed <- StateT (IntMap IntSet) IO (IntMap IntSet)
forall s (m :: * -> *). MonadState s m => m s
get
          let isTypeIndexed :: Bool
isTypeIndexed = TypeIndex -> IntSet -> Bool
ISet.member (Int64 -> TypeIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
occ) (IntSet -> TypeIndex -> IntMap IntSet -> IntSet
forall a. a -> TypeIndex -> IntMap a -> a
IMap.findWithDefault IntSet
ISet.empty TypeIndex
depth IntMap IntSet
indexed)
          Bool -> TypeIndexing () -> TypeIndexing ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isTypeIndexed (TypeIndexing () -> TypeIndexing ())
-> TypeIndexing () -> TypeIndexing ()
forall a b. (a -> b) -> a -> b
$ do
            IO () -> TypeIndexing ()
forall a. IO a -> StateT (IntMap IntSet) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> TypeIndexing ()) -> IO () -> TypeIndexing ()
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> TypeRef -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn Query
"INSERT INTO typerefs VALUES (?,?,?,?,?,?,?)" TypeRef
ref
            IntMap IntSet -> TypeIndexing ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (IntMap IntSet -> TypeIndexing ())
-> IntMap IntSet -> TypeIndexing ()
forall a b. (a -> b) -> a -> b
$ (Maybe IntSet -> Maybe IntSet)
-> TypeIndex -> IntMap IntSet -> IntMap IntSet
forall a. (Maybe a -> Maybe a) -> TypeIndex -> IntMap a -> IntMap a
IMap.alter (\case
                  Maybe IntSet
Nothing -> IntSet -> Maybe IntSet
forall a. a -> Maybe a
Just (IntSet -> Maybe IntSet) -> IntSet -> Maybe IntSet
forall a b. (a -> b) -> a -> b
$ TypeIndex -> IntSet
ISet.singleton (Int64 -> TypeIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
occ)
                  Just IntSet
s -> IntSet -> Maybe IntSet
forall a. a -> Maybe a
Just (IntSet -> Maybe IntSet) -> IntSet -> Maybe IntSet
forall a b. (a -> b) -> a -> b
$ TypeIndex -> IntSet -> IntSet
ISet.insert (Int64 -> TypeIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
occ) IntSet
s
                ) TypeIndex
depth IntMap IntSet
indexed
      let next :: TypeIndex -> TypeIndexing ()
next = TypeIndex -> TypeIndex -> TypeIndexing ()
go (TypeIndex
depth TypeIndex -> TypeIndex -> TypeIndex
forall a. Num a => a -> a -> a
+ TypeIndex
1)
      case Array TypeIndex HieTypeFlat
arr Array TypeIndex HieTypeFlat -> TypeIndex -> HieTypeFlat
forall i e. Ix i => Array i e -> i -> e
A.! TypeIndex
i of
        HTyVarTy Name
_ -> () -> TypeIndexing ()
forall a. a -> StateT (IntMap IntSet) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        HAppTy TypeIndex
x (HieArgs [(Bool, TypeIndex)]
xs) -> (TypeIndex -> TypeIndexing ()) -> [TypeIndex] -> TypeIndexing ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TypeIndex -> TypeIndexing ()
next (TypeIndex
xTypeIndex -> [TypeIndex] -> [TypeIndex]
forall a. a -> [a] -> [a]
:((Bool, TypeIndex) -> TypeIndex)
-> [(Bool, TypeIndex)] -> [TypeIndex]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, TypeIndex) -> TypeIndex
forall a b. (a, b) -> b
snd [(Bool, TypeIndex)]
xs)
        HTyConApp IfaceTyCon
_ (HieArgs [(Bool, TypeIndex)]
xs) -> ((Bool, TypeIndex) -> TypeIndexing ())
-> [(Bool, TypeIndex)] -> TypeIndexing ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TypeIndex -> TypeIndexing ()
next (TypeIndex -> TypeIndexing ())
-> ((Bool, TypeIndex) -> TypeIndex)
-> (Bool, TypeIndex)
-> TypeIndexing ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, TypeIndex) -> TypeIndex
forall a b. (a, b) -> b
snd) [(Bool, TypeIndex)]
xs
        HForAllTy ((Name
_ , TypeIndex
a),ForAllTyFlag
_) TypeIndex
b -> (TypeIndex -> TypeIndexing ()) -> [TypeIndex] -> TypeIndexing ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TypeIndex -> TypeIndexing ()
next [TypeIndex
a,TypeIndex
b]
        HFunTy TypeIndex
a TypeIndex
b TypeIndex
c -> (TypeIndex -> TypeIndexing ()) -> [TypeIndex] -> TypeIndexing ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TypeIndex -> TypeIndexing ()
next [TypeIndex
a,TypeIndex
b,TypeIndex
c]
        HQualTy TypeIndex
a TypeIndex
b -> (TypeIndex -> TypeIndexing ()) -> [TypeIndex] -> TypeIndexing ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TypeIndex -> TypeIndexing ()
next [TypeIndex
a,TypeIndex
b]
        HLitTy IfaceTyLit
_ -> () -> TypeIndexing ()
forall a. a -> StateT (IntMap IntSet) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        HCastTy TypeIndex
a -> TypeIndex -> TypeIndex -> TypeIndexing ()
go TypeIndex
depth TypeIndex
a
        HieTypeFlat
HCoercionTy -> () -> TypeIndexing ()
forall a. a -> StateT (IntMap IntSet) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

makeNc :: IO NameCache
makeNc :: IO NameCache
makeNc = do
#if __GLASGOW_HASKELL__ >= 903
  Char -> [Name] -> IO NameCache
initNameCache Char
'z' []
#else
  uniq_supply <- mkSplitUniqSupply 'z'
  return $ initNameCache 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
      [FilePath] -> IO [FilePath]
forall a. a -> IO a
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
      FilePath -> IO [FilePath] -> IO [FilePath]
forall a. FilePath -> IO a -> IO a
withCurrentDirectory FilePath
path (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FilePath -> IO [FilePath]
getHieFilesIn [FilePath]
cnts
    else
      [FilePath] -> IO [FilePath]
forall a. a -> IO a
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
  NameCache
ncu <- m NameCache
forall (m :: * -> *). NameCacheMonad m => m NameCache
getNcUpdater
  HieFileResult
hiefile <- IO HieFileResult -> m HieFileResult
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HieFileResult -> m HieFileResult)
-> IO HieFileResult -> m HieFileResult
forall a b. (a -> b) -> a -> b
$ NameCache -> FilePath -> IO HieFileResult
readHieFile NameCache
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 <- NameCache -> IO (IORef NameCache)
forall a. a -> IO (IORef a)
newIORef (NameCache -> IO (IORef NameCache))
-> IO NameCache -> IO (IORef NameCache)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NameCache
makeNc
  ()
_ <- IORef NameCache -> DbMonad () -> IO ()
forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
ncr (DbMonad () -> IO ()) -> DbMonad () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> (HieFile -> DbMonad ()) -> DbMonad ()
forall (m :: * -> *) a.
(NameCacheMonad m, MonadIO m) =>
FilePath -> (HieFile -> m a) -> m a
withHieFile FilePath
file (DbMonad () -> HieFile -> DbMonad ()
forall a b. a -> b -> a
const (DbMonad () -> HieFile -> DbMonad ())
-> DbMonad () -> HieFile -> DbMonad ()
forall a b. (a -> b) -> a -> b
$ () -> DbMonad ()
forall a. a -> DbMonadT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  NameCache
nc <- IORef NameCache -> IO NameCache
forall a. IORef a -> IO a
readIORef IORef NameCache
ncr
#if __GLASGOW_HASKELL__ >= 903
  OrigNameCache
nsns <- MVar OrigNameCache -> IO OrigNameCache
forall a. MVar a -> IO a
readMVar (NameCache -> MVar OrigNameCache
nsNames NameCache
nc)
#else
  let nsns = nsNames nc
#endif
  Either HieDbErr (RealSrcSpan, Module)
-> IO (Either HieDbErr (RealSrcSpan, Module))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HieDbErr (RealSrcSpan, Module)
 -> IO (Either HieDbErr (RealSrcSpan, Module)))
-> Either HieDbErr (RealSrcSpan, Module)
-> IO (Either HieDbErr (RealSrcSpan, Module))
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
      RealSrcSpan RealSrcSpan
sp Maybe BufSpan
_ -> (RealSrcSpan, Module) -> Either HieDbErr (RealSrcSpan, Module)
forall a b. b -> Either a b
Right (RealSrcSpan
sp, Module
mdl)
      UnhelpfulSpan UnhelpfulSpanReason
msg -> HieDbErr -> Either HieDbErr (RealSrcSpan, Module)
forall a b. a -> Either a b
Left (HieDbErr -> Either HieDbErr (RealSrcSpan, Module))
-> HieDbErr -> Either HieDbErr (RealSrcSpan, Module)
forall a b. (a -> b) -> a -> b
$ Name -> FilePath -> HieDbErr
NameUnhelpfulSpan Name
name (FastString -> FilePath
unpackFS (FastString -> FilePath) -> FastString -> FilePath
forall a b. (a -> b) -> a -> b
$ UnhelpfulSpanReason -> FastString
unhelpfulSpanFS UnhelpfulSpanReason
msg)
    Maybe Name
Nothing -> HieDbErr -> Either HieDbErr (RealSrcSpan, Module)
forall a b. a -> Either a b
Left (HieDbErr -> Either HieDbErr (RealSrcSpan, Module))
-> HieDbErr -> Either HieDbErr (RealSrcSpan, Module)
forall a b. (a -> b) -> a -> b
$ OccName -> Maybe ModuleName -> Maybe Unit -> HieDbErr
NameNotFound OccName
occ (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> Maybe ModuleName) -> ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mdl) (Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Unit -> Maybe Unit) -> Unit -> Maybe Unit
forall a b. (a -> b) -> a -> b
$ Module -> Unit
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 =
    Map HiePath a -> [a]
forall k a. Map k a -> [a]
M.elems (Map HiePath a -> [a]) -> Map HiePath a -> [a]
forall a b. (a -> b) -> a -> b
$ ((HiePath -> HieAST TypeIndex -> Maybe a)
 -> Map HiePath (HieAST TypeIndex) -> Map HiePath a)
-> Map HiePath (HieAST TypeIndex)
-> (HiePath -> HieAST TypeIndex -> Maybe a)
-> Map HiePath a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (HiePath -> HieAST TypeIndex -> Maybe a)
-> Map HiePath (HieAST TypeIndex) -> Map HiePath a
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
M.mapMaybeWithKey (HieASTs TypeIndex -> Map HiePath (HieAST TypeIndex)
forall a. HieASTs a -> Map HiePath (HieAST a)
getAsts (HieASTs TypeIndex -> Map HiePath (HieAST TypeIndex))
-> HieASTs TypeIndex -> Map HiePath (HieAST TypeIndex)
forall a b. (a -> b) -> a -> b
$ HieFile -> HieASTs TypeIndex
hie_asts HieFile
hf) ((HiePath -> HieAST TypeIndex -> Maybe a) -> Map HiePath a)
-> (HiePath -> HieAST TypeIndex -> Maybe a) -> Map HiePath a
forall a b. (a -> b) -> a -> b
$ \HiePath
fs HieAST TypeIndex
ast ->
      HieAST TypeIndex -> a
k (HieAST TypeIndex -> a) -> Maybe (HieAST TypeIndex) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RealSrcSpan -> HieAST TypeIndex -> Maybe (HieAST TypeIndex)
forall a. RealSrcSpan -> HieAST a -> Maybe (HieAST a)
selectSmallestContaining (FastString -> RealSrcSpan
sp (FastString -> RealSrcSpan) -> FastString -> RealSrcSpan
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 FilePath
libdir
  DynFlags -> IO DynFlags
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags -> IO DynFlags) -> DynFlags -> IO DynFlags
forall a b. (a -> b) -> a -> b
$ Settings -> DynFlags
defaultDynFlags Settings
systemSettings
#if __GLASGOW_HASKELL__ < 905
    (LlvmConfig [] [])
#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

data AstInfo =
  AstInfo
    { AstInfo -> [RefRow]
astInfoRefs :: [RefRow]
    , AstInfo -> [DeclRow]
astInfoDecls :: [DeclRow]
    , AstInfo -> [ImportRow]
astInfoImports :: [ImportRow]
    }

instance Semigroup AstInfo where
  AstInfo [RefRow]
r1 [DeclRow]
d1 [ImportRow]
i1 <> :: AstInfo -> AstInfo -> AstInfo
<> AstInfo [RefRow]
r2 [DeclRow]
d2 [ImportRow]
i2 = [RefRow] -> [DeclRow] -> [ImportRow] -> AstInfo
AstInfo ([RefRow]
r1 [RefRow] -> [RefRow] -> [RefRow]
forall a. Semigroup a => a -> a -> a
<> [RefRow]
r2) ([DeclRow]
d1 [DeclRow] -> [DeclRow] -> [DeclRow]
forall a. Semigroup a => a -> a -> a
<> [DeclRow]
d2) ([ImportRow]
i1 [ImportRow] -> [ImportRow] -> [ImportRow]
forall a. Semigroup a => a -> a -> a
<> [ImportRow]
i2)

instance Monoid AstInfo where
  mempty :: AstInfo
mempty = [RefRow] -> [DeclRow] -> [ImportRow] -> AstInfo
AstInfo [] [] []

genAstInfo :: FilePath -> Module -> M.Map Identifier [(Span, IdentifierDetails a)] -> AstInfo
genAstInfo :: forall a.
FilePath
-> Module
-> Map Identifier [(RealSrcSpan, IdentifierDetails a)]
-> AstInfo
genAstInfo FilePath
path Module
smdl Map Identifier [(RealSrcSpan, IdentifierDetails a)]
refmap = [(Identifier, (RealSrcSpan, IdentifierDetails a))] -> AstInfo
forall {a}.
[(Identifier, (RealSrcSpan, IdentifierDetails a))] -> AstInfo
genRows ([(Identifier, (RealSrcSpan, IdentifierDetails a))] -> AstInfo)
-> [(Identifier, (RealSrcSpan, IdentifierDetails a))] -> AstInfo
forall a b. (a -> b) -> a -> b
$ [(Identifier, [(RealSrcSpan, IdentifierDetails a)])]
-> [(Identifier, (RealSrcSpan, IdentifierDetails a))]
forall {t} {a}. [(t, [a])] -> [(t, a)]
flat ([(Identifier, [(RealSrcSpan, IdentifierDetails a)])]
 -> [(Identifier, (RealSrcSpan, IdentifierDetails a))])
-> [(Identifier, [(RealSrcSpan, IdentifierDetails a)])]
-> [(Identifier, (RealSrcSpan, IdentifierDetails a))]
forall a b. (a -> b) -> a -> b
$ Map Identifier [(RealSrcSpan, IdentifierDetails a)]
-> [(Identifier, [(RealSrcSpan, IdentifierDetails a)])]
forall k a. Map k a -> [(k, a)]
M.toList Map Identifier [(RealSrcSpan, IdentifierDetails a)]
refmap
  where
    flat :: [(t, [a])] -> [(t, a)]
flat = ((t, [a]) -> [(t, a)]) -> [(t, [a])] -> [(t, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(t
a,[a]
xs) -> (a -> (t, a)) -> [a] -> [(t, a)]
forall a b. (a -> b) -> [a] -> [b]
map (t
a,) [a]
xs)
    genRows :: [(Identifier, (RealSrcSpan, IdentifierDetails a))] -> AstInfo
genRows = ((Identifier, (RealSrcSpan, IdentifierDetails a)) -> AstInfo)
-> [(Identifier, (RealSrcSpan, IdentifierDetails a))] -> AstInfo
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Identifier, (RealSrcSpan, IdentifierDetails a)) -> AstInfo
forall {a}.
(Identifier, (RealSrcSpan, IdentifierDetails a)) -> AstInfo
go
    go :: (Identifier, (RealSrcSpan, IdentifierDetails a)) -> AstInfo
go = (Identifier, (RealSrcSpan, IdentifierDetails a)) -> AstInfo
forall {a}.
(Identifier, (RealSrcSpan, IdentifierDetails a)) -> AstInfo
mkAstInfo

    mkAstInfo :: (Identifier, (RealSrcSpan, IdentifierDetails a)) -> AstInfo
mkAstInfo (Identifier, (RealSrcSpan, IdentifierDetails a))
x = [RefRow] -> [DeclRow] -> [ImportRow] -> AstInfo
AstInfo (Maybe RefRow -> [RefRow]
forall a. Maybe a -> [a]
maybeToList (Maybe RefRow -> [RefRow]) -> Maybe RefRow -> [RefRow]
forall a b. (a -> b) -> a -> b
$ (Identifier, (RealSrcSpan, IdentifierDetails a)) -> Maybe RefRow
forall {a} {b}. (Either a Name, (RealSrcSpan, b)) -> Maybe RefRow
goRef (Identifier, (RealSrcSpan, IdentifierDetails a))
x) (Maybe DeclRow -> [DeclRow]
forall a. Maybe a -> [a]
maybeToList (Maybe DeclRow -> [DeclRow]) -> Maybe DeclRow -> [DeclRow]
forall a b. (a -> b) -> a -> b
$ (Identifier, (RealSrcSpan, IdentifierDetails a)) -> Maybe DeclRow
forall {a} {a} {a}.
(Either a Name, (a, IdentifierDetails a)) -> Maybe DeclRow
goDec (Identifier, (RealSrcSpan, IdentifierDetails a))
x) (Maybe ImportRow -> [ImportRow]
forall a. Maybe a -> [a]
maybeToList (Maybe ImportRow -> [ImportRow]) -> Maybe ImportRow -> [ImportRow]
forall a b. (a -> b) -> a -> b
$ (Identifier, (RealSrcSpan, IdentifierDetails a)) -> Maybe ImportRow
forall {b} {a}.
(Either ModuleName b, (RealSrcSpan, IdentifierDetails a))
-> Maybe ImportRow
goImport (Identifier, (RealSrcSpan, IdentifierDetails a))
x)

    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 = RefRow -> Maybe RefRow
forall a. a -> Maybe a
Just (RefRow -> Maybe RefRow) -> RefRow -> Maybe RefRow
forall a b. (a -> b) -> a -> b
$
          FilePath
-> OccName
-> ModuleName
-> Unit
-> TypeIndex
-> TypeIndex
-> TypeIndex
-> TypeIndex
-> RefRow
RefRow FilePath
path OccName
occ (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) (Module -> Unit
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))
_ = Maybe RefRow
forall a. Maybe a
Nothing

    goImport :: (Either ModuleName b, (RealSrcSpan, IdentifierDetails a))
-> Maybe ImportRow
goImport (Left ModuleName
modName, (RealSrcSpan
sp, IdentifierDetails Maybe a
_ Set ContextInfo
contextInfos)) = do
          ()
_ <- Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set ContextInfo -> Set ContextInfo -> Bool
forall a. Ord a => Set a -> Set a -> Bool
S.disjoint Set ContextInfo
contextInfos (Set ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall a b. (a -> b) -> a -> b
$ [ContextInfo] -> Set ContextInfo
forall a. Ord a => [a] -> Set a
S.fromList [IEType -> ContextInfo
IEThing IEType
Import, IEType -> ContextInfo
IEThing IEType
ImportAs, IEType -> ContextInfo
IEThing IEType
ImportHiding]
          let
            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
          ImportRow -> Maybe ImportRow
forall a. a -> Maybe a
Just (ImportRow -> Maybe ImportRow) -> ImportRow -> Maybe ImportRow
forall a b. (a -> b) -> a -> b
$ FilePath
-> ModuleName
-> TypeIndex
-> TypeIndex
-> TypeIndex
-> TypeIndex
-> ImportRow
ImportRow FilePath
path ModuleName
modName TypeIndex
sl TypeIndex
sc TypeIndex
el TypeIndex
ec
    goImport (Either ModuleName b, (RealSrcSpan, IdentifierDetails a))
_ = Maybe ImportRow
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 Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
smdl
      , OccName
occ  <- Name -> OccName
nameOccName Name
name
      , Set ContextInfo
info <- IdentifierDetails a -> Set ContextInfo
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
      = DeclRow -> Maybe DeclRow
forall a. a -> Maybe a
Just (DeclRow -> Maybe DeclRow) -> DeclRow -> Maybe DeclRow
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))
_ = Maybe DeclRow
forall a. Maybe a
Nothing

    isRoot :: Set ContextInfo -> Bool
isRoot = (ContextInfo -> Bool) -> Set ContextInfo -> Bool
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 = First RealSrcSpan -> Maybe RealSrcSpan
forall a. First a -> Maybe a
getFirst (First RealSrcSpan -> Maybe RealSrcSpan)
-> (Set ContextInfo -> First RealSrcSpan)
-> Set ContextInfo
-> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContextInfo -> First RealSrcSpan)
-> Set ContextInfo -> First RealSrcSpan
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe RealSrcSpan -> First RealSrcSpan
forall a. Maybe a -> First a
First (Maybe RealSrcSpan -> First RealSrcSpan)
-> (ContextInfo -> Maybe RealSrcSpan)
-> ContextInfo
-> First RealSrcSpan
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
_ = Maybe RealSrcSpan
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 = [(Identifier, [(RealSrcSpan, IdentifierDetails a)])] -> [DefRow]
forall {a} {a}.
[(Either a Name, [(RealSrcSpan, IdentifierDetails a)])] -> [DefRow]
genRows ([(Identifier, [(RealSrcSpan, IdentifierDetails a)])] -> [DefRow])
-> [(Identifier, [(RealSrcSpan, IdentifierDetails a)])] -> [DefRow]
forall a b. (a -> b) -> a -> b
$ Map Identifier [(RealSrcSpan, IdentifierDetails a)]
-> [(Identifier, [(RealSrcSpan, IdentifierDetails a)])]
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 = ((Either a Name, [(RealSrcSpan, IdentifierDetails a)])
 -> Maybe DefRow)
-> [(Either a Name, [(RealSrcSpan, IdentifierDetails a)])]
-> [DefRow]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Either a Name, [(RealSrcSpan, IdentifierDetails a)])
-> Maybe DefRow
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
      | RealSrcSpan RealSrcSpan
sp Maybe BufSpan
_ <- Name -> SrcSpan
nameSrcSpan Name
name = RealSrcSpan -> Maybe RealSrcSpan
forall a. a -> Maybe a
Just RealSrcSpan
sp
      | Bool
otherwise = do
          (RealSrcSpan
sp, IdentifierDetails a
_dets) <- ((RealSrcSpan, IdentifierDetails a) -> Bool)
-> t (RealSrcSpan, IdentifierDetails a)
-> Maybe (RealSrcSpan, IdentifierDetails a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (RealSrcSpan, IdentifierDetails a) -> Bool
forall {a} {a}. (a, IdentifierDetails a) -> Bool
defSpan t (RealSrcSpan, IdentifierDetails a)
dets
          RealSrcSpan -> Maybe RealSrcSpan
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RealSrcSpan
sp

    defSpan :: (a, IdentifierDetails a) -> Bool
defSpan = (ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isDef (Set ContextInfo -> Bool)
-> ((a, IdentifierDetails a) -> Set ContextInfo)
-> (a, IdentifierDetails a)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo (IdentifierDetails a -> Set ContextInfo)
-> ((a, IdentifierDetails a) -> IdentifierDetails a)
-> (a, IdentifierDetails a)
-> Set ContextInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, IdentifierDetails a) -> IdentifierDetails a
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 Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
smod
      , OccName
occ  <- Name -> OccName
nameOccName Name
name
      , Just RealSrcSpan
sp <- Name -> t (RealSrcSpan, IdentifierDetails a) -> Maybe RealSrcSpan
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
      = DefRow -> Maybe DefRow
forall a. a -> Maybe a
Just (DefRow -> Maybe DefRow) -> DefRow -> Maybe DefRow
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))
_ = Maybe DefRow
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 :: [HieAST a]
nodeChildren :: forall a. HieAST a -> [HieAST a]
nodeChildren } =
  Data.Tree.Node
    { rootLabel :: HieAST a
rootLabel = HieAST a
nd { nodeChildren = mempty }
    , subForest :: [Tree (HieAST a)]
subForest = (HieAST a -> Tree (HieAST a)) -> [HieAST a] -> [Tree (HieAST a)]
forall a b. (a -> b) -> [a] -> [b]
map HieAST a -> Tree (HieAST a)
forall a. HieAST a -> Tree (HieAST a)
identifierTree [HieAST a]
nodeChildren
    }

generateExports :: FilePath -> [AvailInfo] -> [ExportRow]
generateExports :: FilePath -> [AvailInfo] -> [ExportRow]
generateExports FilePath
fp = (AvailInfo -> [ExportRow]) -> [AvailInfo] -> [ExportRow]
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 = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
n
        , exportUnit :: Unit
exportUnit = Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit (Module -> Unit) -> Module -> Unit
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
n
        , exportParent :: Maybe OccName
exportParent = Maybe OccName
forall a. Maybe a
Nothing
        , exportParentMod :: Maybe ModuleName
exportParentMod = Maybe ModuleName
forall a. Maybe a
Nothing
        , exportParentUnit :: Maybe Unit
exportParentUnit = Maybe Unit
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 = Maybe OccName
forall a. Maybe a
Nothing
        , exportParentMod :: Maybe ModuleName
exportParentMod = Maybe ModuleName
forall a. Maybe a
Nothing
        , exportParentUnit :: Maybe Unit
exportParentUnit = Maybe Unit
forall a. Maybe a
Nothing
        , exportIsDatacon :: Bool
exportIsDatacon = Bool
False
        }]
      where
        (OccName
n, ModuleName
m, Unit
u) = (FastString -> OccName
mkVarOccFS (FastString -> OccName) -> FastString -> OccName
forall a b. (a -> b) -> a -> b
$ FieldLabelString -> FastString
field_label (FieldLabelString -> FastString) -> FieldLabelString -> FastString
forall a b. (a -> b) -> a -> b
$ FieldLabel -> FieldLabelString
flLabel FieldLabel
fl
                    -- For fields, the module details come from the parent
                    ,Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule (Name -> Module) -> Name -> Module
forall a b. (a -> b) -> a -> b
$ FieldLabel -> Name
flSelector FieldLabel
fl
                    ,Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit (Module -> Unit) -> Module -> Unit
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule (Name -> Module) -> Name -> Module
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 = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name
        , exportUnit :: Unit
exportUnit = Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit (Module -> Unit) -> Module -> Unit
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name
        , exportParent :: Maybe OccName
exportParent = Maybe OccName
forall a. Maybe a
Nothing
        , exportParentMod :: Maybe ModuleName
exportParentMod = Maybe ModuleName
forall a. Maybe a
Nothing
        , exportParentUnit :: Maybe Unit
exportParentUnit = Maybe Unit
forall a. Maybe a
Nothing
        , exportIsDatacon :: Bool
exportIsDatacon = Bool
False}
    ExportRow -> [ExportRow] -> [ExportRow]
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 = OccName -> Maybe OccName
forall a. a -> Maybe a
Just (Name -> OccName
nameOccName Name
name)
        , exportParentMod :: Maybe ModuleName
exportParentMod = ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name)
        , exportParentUnit :: Maybe Unit
exportParentUnit = Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit (Module -> Unit) -> Module -> Unit
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name)
        , exportIsDatacon :: Bool
exportIsDatacon = Bool
False}
      | (OccName
n,ModuleName
m,Unit
u) <- (Name -> (OccName, ModuleName, Unit))
-> [Name] -> [(OccName, ModuleName, Unit)]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
n ->
                        (Name -> OccName
nameOccName Name
n
                        ,Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
n
                        ,Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit (Module -> Unit) -> Module -> Unit
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
n
                        ))
                      (TypeIndex -> [Name] -> [Name]
forall a. TypeIndex -> [a] -> [a]
drop TypeIndex
1 [Name]
pieces)
               [(OccName, ModuleName, Unit)]
-> [(OccName, ModuleName, Unit)] -> [(OccName, ModuleName, Unit)]
forall a. Semigroup a => a -> a -> a
<> (FieldLabel -> (OccName, ModuleName, Unit))
-> [FieldLabel] -> [(OccName, ModuleName, Unit)]
forall a b. (a -> b) -> [a] -> [b]
map (\FieldLabel
s ->
                        (FastString -> OccName
mkVarOccFS (FastString -> OccName) -> FastString -> OccName
forall a b. (a -> b) -> a -> b
$ FieldLabelString -> FastString
field_label (FieldLabelString -> FastString) -> FieldLabelString -> FastString
forall a b. (a -> b) -> a -> b
$ FieldLabel -> FieldLabelString
flLabel FieldLabel
s
                        -- For fields, the module details come from the parent
                        ,Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name
                        ,Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit (Module -> Unit) -> Module -> Unit
forall a b. (a -> b) -> a -> b
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name
                        ))
                      [FieldLabel]
fields
      ]