{-# 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
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
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)
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
,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
,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
]