aboutsummaryrefslogtreecommitdiff
path: root/src/HaskellCodeExplorer
diff options
context:
space:
mode:
authorYuchen Pei <hi@ypei.me>2022-06-08 23:06:10 +1000
committerYuchen Pei <hi@ypei.me>2022-06-08 23:06:10 +1000
commit3e46f1ae9eeabd0e7aabaa8b4b52a05dba774e51 (patch)
tree6a3b2e58026d84d3c7740d8a13aa6b9ed2791b80 /src/HaskellCodeExplorer
parenta4676c40291af4bf0c9e56b4ffdc25db3cdfef3d (diff)
clean up comments etc.
Diffstat (limited to 'src/HaskellCodeExplorer')
-rw-r--r--src/HaskellCodeExplorer/PackageInfo.hs99
1 files changed, 1 insertions, 98 deletions
diff --git a/src/HaskellCodeExplorer/PackageInfo.hs b/src/HaskellCodeExplorer/PackageInfo.hs
index bb7455a..af1f478 100644
--- a/src/HaskellCodeExplorer/PackageInfo.hs
+++ b/src/HaskellCodeExplorer/PackageInfo.hs
@@ -161,12 +161,6 @@ createPackageInfo packageDirectoryPath mbDistDirRelativePath sourceCodePreproces
case mbDistDirRelativePath of
Just path -> return $ packageDirectoryAbsPath </> path
Nothing -> return $ packageDirectoryAbsPath </> "dist-newstyle"
- -- Nothing -> do
- -- eitherDistDir <- findDistDirectory packageDirectoryAbsPath
- -- case eitherDistDir of
- -- Right distDir -> return distDir
- -- Left errorMessage ->
- -- logErrorN (T.pack errorMessage) >> liftIO exitFailure
cabalFiles <-
liftIO $
length .
@@ -211,7 +205,6 @@ createPackageInfo packageDirectoryPath mbDistDirRelativePath sourceCodePreproces
<> "Alternatively, try using absolute path for -p."
return $ head packages
- -- ((packageName, packageVersion), (_packageCompilerName, packageCompilerVersion), compInfo) <-
units <-
liftIO $
(filter (\((pkgName, _), _, _) -> pkgName == pPackageName package)) . NE.toList <$>
@@ -227,9 +220,8 @@ createPackageInfo packageDirectoryPath mbDistDirRelativePath sourceCodePreproces
-- TODO: we are assuming all pakcageVersion and packageCompilerVersion are the same
let ((packageName, packageVersion), (_, packageCompilerVersion), _) = head units
compInfo = concatMap (\(_, _, comp) -> comp) units
- -- logInfoN $ "unitinfo: " <> (T.pack $ show (packageName, packageVersion))
- -- logInfoN $ "compinfo: " <> (T.pack $ show compInfo)
currentPackageId = HCE.PackageId (T.pack packageName) packageVersion
+ logDebugN $ "compinfo: " <> (T.pack $ show compInfo)
unless
(take 3 (versionBranch packageCompilerVersion) ==
take 3 (versionBranch ghcVersion)) $ do
@@ -322,16 +314,12 @@ createPackageInfo packageDirectoryPath mbDistDirRelativePath sourceCodePreproces
chComponentNameToComponentType :: ChComponentName -> HCE.ComponentType
chComponentNameToComponentType ChSetupHsName = HCE.Setup
chComponentNameToComponentType (ChLibName _) = HCE.Lib
- -- chComponentNameToComponentType (ChSubLibName name) =
- -- HCE.SubLib $ T.pack name
chComponentNameToComponentType (ChFLibName name) = HCE.FLib $ T.pack name
chComponentNameToComponentType (ChExeName name) = HCE.Exe $ T.pack name
chComponentNameToComponentType (ChTestName name) = HCE.Test $ T.pack name
chComponentNameToComponentType (ChBenchName name) = HCE.Bench $ T.pack name
chComponentNameToComponentId :: ChComponentName -> HCE.ComponentId
chComponentNameToComponentId (ChLibName _) = HCE.ComponentId "lib"
- -- chComponentNameToComponentId (ChSubLibName name) =
- -- HCE.ComponentId . T.append "sublib-" . T.pack $ name
chComponentNameToComponentId (ChFLibName name) =
HCE.ComponentId . T.append "flib-" . T.pack $ name
chComponentNameToComponentId (ChExeName name) =
@@ -345,28 +333,6 @@ createPackageInfo packageDirectoryPath mbDistDirRelativePath sourceCodePreproces
ghcVersion :: Version
ghcVersion = makeVersion [9, 2, 2, 0]
--- #if MIN_VERSION_GLASGOW_HASKELL(8,6,5,0)
--- ghcVersion :: Version
--- ghcVersion = makeVersion [8, 6, 5, 0]
--- #elif MIN_VERSION_GLASGOW_HASKELL(8,6,4,0)
--- ghcVersion :: Version
--- ghcVersion = makeVersion [8, 6, 4, 0]
--- #elif MIN_VERSION_GLASGOW_HASKELL(8,6,3,0)
--- ghcVersion :: Version
--- ghcVersion = makeVersion [8, 6, 3, 0]
--- #elif MIN_VERSION_GLASGOW_HASKELL(8,4,4,0)
--- ghcVersion :: Version
--- ghcVersion = makeVersion [8, 4, 4, 0]
--- #elif MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
--- ghcVersion :: Version
--- ghcVersion = makeVersion [8, 4, 3, 0]
--- #elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
--- ghcVersion :: Version
--- ghcVersion = makeVersion [8, 2, 2, 0]
--- #else
--- ghcVersion :: Version
--- ghcVersion = makeVersion [8, 0, 2, 0]
--- #endif
buildDirectoryTree :: FilePath -> [FilePath] -> (FilePath -> Bool) -> IO HCE.DirTree
buildDirectoryTree path ignoreDirectories isHaskellModule = do
@@ -436,57 +402,6 @@ addReferencesFromModule references modInfo@HCE.ModuleInfo {..} =
HM.insertWith S.union externalId (S.singleton idSrcSpan) occMap
Nothing -> occMap)
--- findDistDirectory :: FilePath -> LoggingT IO (Either String FilePath)
--- findDistDirectory packagePath = do
--- let parents =
--- reverse . map joinPath . filter (not . null) . L.inits . splitPath $
--- packagePath
--- -- e.g., ["/dir/subdir/subsubdir","/dir/subdir/","/dir/","/"]
--- hasStackYaml <-
--- liftIO $ anyM (\path -> doesFileExist (path </> "stack.yaml")) parents
--- mbStackExecutable <- liftIO $ findExecutable "stack"
--- case (hasStackYaml, mbStackExecutable) of
--- (True, Just stack) -> do
--- let removeEndOfLine str
--- | null str = str
--- | otherwise = init str
--- logInfoN
--- "Found stack.yaml. Executing \"stack path --dist-dir\" to get dist directory."
--- eitherDistDir :: (Either IOException String) <-
--- liftIO .
--- try . fmap removeEndOfLine . readProcess stack ["path", "--dist-dir"] $
--- ""
--- case eitherDistDir of
--- Right distDir -> do
--- logInfoN $ T.append "Stack dist directory : " $ T.pack distDir
--- hasSetupConfig <- liftIO $ doesFileExist $ distDir </> "setup-config"
--- if hasSetupConfig
--- then return $ Right distDir
--- else return $
--- Left
--- "Cannot find setup-config file in a dist directory. Has the package been built?"
--- Left exception ->
--- return $
--- Left $
--- "Error while executing \"stack path --dist-dir\" : " ++ show exception
--- _ -> do
--- logInfoN "Trying to find dist directory"
--- setupConfigPaths <-
--- liftIO $
--- map (takeDirectory . normalise) <$>
--- find always (fileName ==? "setup-config") "."
--- case setupConfigPaths of
--- [] ->
--- return $
--- Left "Cannot find dist directory. Has the package been built?"
--- [path] -> do
--- logInfoN $ T.append "Found dist directory : " $ T.pack path
--- return $ Right path
--- _ ->
--- return $
--- Left $
--- "Found multiple possible dist directories : \n" ++
--- show setupConfigPaths ++ " \nPlease specify --dist option"
eachIdentifierOccurrence ::
forall a.
@@ -504,18 +419,6 @@ eachIdentifierOccurrence accumulator HCE.ModuleInfo {..} f =
accumulator
idOccMap
--- loggingT IO is already MonadCatch and MonadMask
--- instance MonadCatch (LoggingT IO) where
--- catch act h =
--- LoggingT $ \logFn ->
--- runLoggingT act logFn `gcatch` \e -> runLoggingT (h e) logFn
--- instance MonadMask (LoggingT IO) where
--- mask f =
--- LoggingT $ \logFn ->
--- gmask $ \io_restore ->
--- let g_restore (LoggingT m) = LoggingT $ \lf -> io_restore (m lf)
--- in runLoggingT (f g_restore) logFn
-
instance MonadLoggerIO (GhcT (LoggingT IO)) where
askLoggerIO = GhcT $ const askLoggerIO