Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Update HIE to use latest hie-bios #1601

Merged
merged 1 commit into from
Feb 2, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 0 additions & 2 deletions .gitmodules
Original file line number Diff line number Diff line change
Expand Up @@ -8,5 +8,3 @@
# Commit git commit -m "Removed submodule <name>"
# Delete the now untracked submodule files
# rm -rf path_to_submodule


10 changes: 7 additions & 3 deletions app/MainHie.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,8 @@ import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Yaml as Yaml
import HIE.Bios.Types
import Haskell.Ide.Engine.Cradle (findLocalCradle, cradleDisplay, getProjectGhcLibDir)
import Haskell.Ide.Engine.Cradle (findLocalCradle, cradleDisplay
, getProjectGhcLibDir, CabalHelper)
import Haskell.Ide.Engine.MonadFunctions
import Haskell.Ide.Engine.MonadTypes
import Haskell.Ide.Engine.Options
Expand Down Expand Up @@ -151,8 +152,11 @@ main = do

-- ---------------------------------------------------------------------

getCradleInfo :: FilePath -> IO (Either Yaml.ParseException Cradle)
getCradleInfo currentDir = E.try $ findLocalCradle $ currentDir </> "File.hs"
getCradleInfo :: FilePath -> IO (Either Yaml.ParseException (Cradle CabalHelper))
getCradleInfo currentDir = do
let dummyCradleFile = currentDir </> "File.hs"
cradleRes <- E.try (findLocalCradle dummyCradleFile)
return cradleRes

-- ---------------------------------------------------------------------

Expand Down
3 changes: 1 addition & 2 deletions cabal.project
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
packages:
./
./hie-plugin-api/

-- ./submodules/HaRe

tests: true
Expand All @@ -16,4 +15,4 @@ constraints:

write-ghc-environment-files: never

index-state: 2020-01-24T16:47:33Z
index-state: 2020-02-01T17:43:11Z
2 changes: 1 addition & 1 deletion haskell-ide-engine.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -99,7 +99,7 @@ library
, vector
, versions
, yaml >= 0.8.31
, hie-bios >= 0.3.2 && < 0.4.0
, hie-bios >= 0.4 && < 0.5.0
, bytestring-trie
, unliftio
, hlint >= 2.2.8
Expand Down
2 changes: 1 addition & 1 deletion hie-plugin-api/Haskell/Ide/Engine/ArtifactMap.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ import qualified GHC
import GHC (TypecheckedModule)
import qualified SrcLoc as GHC
import qualified Var
import Haskell.Ide.Engine.GhcCompat
import Haskell.Ide.Engine.GhcCompat

import Language.Haskell.LSP.Types

Expand Down
127 changes: 73 additions & 54 deletions hie-plugin-api/Haskell/Ide/Engine/Cradle.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,19 +5,19 @@

module Haskell.Ide.Engine.Cradle where

import HIE.Bios as BIOS
import HIE.Bios.Types as BIOS
import Haskell.Ide.Engine.MonadFunctions
import HIE.Bios as Bios
import qualified HIE.Bios.Cradle as Bios
import HIE.Bios.Types (CradleAction(..))
import qualified HIE.Bios.Types as Bios
import Distribution.Helper (Package, projectPackages, pUnits,
pSourceDir, ChComponentInfo(..),
unChModuleName, Ex(..), ProjLoc(..),
QueryEnv, mkQueryEnv, runQuery,
Unit, unitInfo, uiComponents,
ChEntrypoint(..), UnitInfo(..))
import Distribution.Helper.Discover (findProjects, getDefaultDistDir)
import Data.Char (toLower)
import Data.Function ((&))
import Data.List (isPrefixOf, isInfixOf, sortOn, find)
import Data.List (isPrefixOf, sortOn, find)
import qualified Data.List.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map as Map
Expand All @@ -32,6 +32,8 @@ import System.Directory (getCurrentDirectory, canonicalizePath, findEx
import System.Exit
import System.Process (readCreateProcessWithExitCode, shell)

import Haskell.Ide.Engine.Logger

-- | Find the cradle that the given File belongs to.
--
-- First looks for a "hie.yaml" file in the directory of the file
Expand All @@ -42,44 +44,49 @@ import System.Process (readCreateProcessWithExitCode, shell)
-- If no "hie.yaml" can be found, the implicit config is used.
-- The implicit config uses different heuristics to determine the type
-- of the project that may or may not be accurate.
findLocalCradle :: FilePath -> IO Cradle
findLocalCradle :: FilePath -> IO (Cradle CabalHelper)
findLocalCradle fp = do
cradleConf <- BIOS.findCradle fp
crdl <- case cradleConf of
cradleConf <- Bios.findCradle fp
crdl <- case cradleConf of
Just yaml -> do
debugm $ "Found \"" ++ yaml ++ "\" for \"" ++ fp ++ "\""
BIOS.loadCradle yaml
Nothing -> cabalHelperCradle fp
crdl <- Bios.loadCradle yaml
return $ fmap (const CabalNone) crdl
Nothing -> cabalHelperCradle fp
logm $ "Module \"" ++ fp ++ "\" is loaded by Cradle: " ++ show crdl
return crdl

-- | Check if the given cradle is a stack cradle.
-- This might be used to determine the GHC version to use on the project.
-- If it is a stack-cradle, we have to use @"stack path --compiler-exe"@
-- otherwise we may ask `ghc` directly what version it is.
isStackCradle :: Cradle -> Bool
isStackCradle = (`elem` ["stack", "Cabal-Helper-Stack", "Cabal-Helper-Stack-None"])
. BIOS.actionName
. BIOS.cradleOptsProg
isStackCradle :: Cradle CabalHelper -> Bool
isStackCradle crdl = Bios.isStackCradle crdl || cabalHelperStackCradle crdl
where
cabalHelperStackCradle =
(`elem` [Bios.Other Stack, Bios.Other StackNone])
. Bios.actionName
. Bios.cradleOptsProg


-- | Check if the given cradle is a cabal cradle.
-- This might be used to determine the GHC version to use on the project.
-- If it is a stack-cradle, we have to use @"stack path --compiler-exe"@
-- otherwise we may ask @ghc@ directly what version it is.
isCabalCradle :: Cradle -> Bool
isCabalCradle =
(`elem`
[ "cabal"
, "Cabal-Helper-Cabal-V1"
, "Cabal-Helper-Cabal-V2"
, "Cabal-Helper-Cabal-V1-Dir"
, "Cabal-Helper-Cabal-V2-Dir"
, "Cabal-Helper-Cabal-V2-None"
, "Cabal-Helper-Cabal-None"
]
)
. BIOS.actionName
. BIOS.cradleOptsProg
isCabalCradle :: Cradle CabalHelper -> Bool
isCabalCradle crdl = Bios.isCabalCradle crdl || cabalHelperCabalCradle crdl
where
cabalHelperCabalCradle =
(`elem` [Bios.Other CabalV2, Bios.Other CabalNone])
. Bios.actionName
. Bios.cradleOptsProg

data CabalHelper
= Stack
| StackNone
| CabalV2
| CabalNone
deriving (Show, Eq, Ord)

-- | Execute @ghc@ that is based on the given cradle.
-- Output must be a single line. If an error is raised, e.g. the command
Expand All @@ -88,7 +95,7 @@ isCabalCradle =
--
-- E.g. for a stack cradle, we use @stack ghc@ and for a cabal cradle
-- we are taking the @ghc@ that is on the path.
execProjectGhc :: Cradle -> [String] -> IO (Maybe String)
execProjectGhc :: Cradle CabalHelper -> [String] -> IO (Maybe String)
execProjectGhc crdl args = do
isStackInstalled <- isJust <$> findExecutable "stack"
-- isCabalInstalled <- isJust <$> findExecutable "cabal"
Expand Down Expand Up @@ -144,7 +151,7 @@ tryCommand cmd = do


-- | Get the directory of the libdir based on the project ghc.
getProjectGhcLibDir :: Cradle -> IO (Maybe FilePath)
getProjectGhcLibDir :: Cradle CabalHelper -> IO (Maybe FilePath)
getProjectGhcLibDir crdl =
execProjectGhc crdl ["--print-libdir"] >>= \case
Nothing -> do
Expand Down Expand Up @@ -441,7 +448,7 @@ the compiler options obtained from Cabal-Helper are relative to the package
source directory, which is "\/Repo\/SubRepo".

-}
cabalHelperCradle :: FilePath -> IO Cradle
cabalHelperCradle :: FilePath -> IO (Cradle CabalHelper)
cabalHelperCradle file = do
projM <- findCabalHelperEntryPoint file
case projM of
Expand All @@ -451,7 +458,7 @@ cabalHelperCradle file = do
return
Cradle { cradleRootDir = cwd
, cradleOptsProg =
CradleAction { actionName = "Direct"
CradleAction { actionName = Bios.Direct
, runCradle = \_ _ ->
return
$ CradleSuccess
Expand All @@ -467,7 +474,7 @@ cabalHelperCradle file = do
let root = projectRootDir proj
-- Create a suffix for the cradle name.
-- Purpose is mainly for easier debugging.
let actionNameSuffix = projectSuffix proj
let actionNameSuffix = projectType proj
debugm $ "Cabal-Helper dirs: " ++ show [root, file]
let dist_dir = getDefaultDistDir proj
env <- mkQueryEnv proj dist_dir
Expand All @@ -484,9 +491,7 @@ cabalHelperCradle file = do
return
Cradle { cradleRootDir = root
, cradleOptsProg =
CradleAction { actionName = "Cabal-Helper-"
++ actionNameSuffix
++ "-None"
CradleAction { actionName = Bios.Other (projectNoneType proj)
, runCradle = \_ _ -> return CradleNone
}
}
Expand All @@ -501,8 +506,7 @@ cabalHelperCradle file = do
return
Cradle { cradleRootDir = normalisedPackageLocation
, cradleOptsProg =
CradleAction { actionName =
"Cabal-Helper-" ++ actionNameSuffix
CradleAction { actionName = Bios.Other actionNameSuffix
, runCradle = \_ fp -> cabalHelperAction
(Ex proj)
env
Expand Down Expand Up @@ -751,12 +755,19 @@ projectRootDir ProjLocV2File { plProjectDirV2 } = plProjectDirV2
projectRootDir ProjLocV2Dir { plProjectDirV2 } = plProjectDirV2
projectRootDir ProjLocStackYaml { plStackYaml } = takeDirectory plStackYaml

projectSuffix :: ProjLoc qt -> FilePath
projectSuffix ProjLocV1CabalFile {} = "Cabal-V1"
projectSuffix ProjLocV1Dir {} = "Cabal-V1-Dir"
projectSuffix ProjLocV2File {} = "Cabal-V2"
projectSuffix ProjLocV2Dir {} = "Cabal-V2-Dir"
projectSuffix ProjLocStackYaml {} = "Stack"
projectType :: ProjLoc qt -> CabalHelper
projectType ProjLocV1CabalFile {} = CabalV2
projectType ProjLocV1Dir {} = CabalV2
projectType ProjLocV2File {} = CabalV2
projectType ProjLocV2Dir {} = CabalV2
projectType ProjLocStackYaml {} = Stack

projectNoneType :: ProjLoc qt -> CabalHelper
projectNoneType ProjLocV1CabalFile {} = CabalNone
projectNoneType ProjLocV1Dir {} = CabalNone
projectNoneType ProjLocV2File {} = CabalNone
projectNoneType ProjLocV2Dir {} = CabalNone
projectNoneType ProjLocStackYaml {} = StackNone

-- ----------------------------------------------------------------------------
--
Expand Down Expand Up @@ -867,14 +878,22 @@ relativeTo file sourceDirs =

-- | Returns a user facing display name for the cradle type,
-- e.g. "Stack project" or "GHC session"
cradleDisplay :: IsString a => BIOS.Cradle -> a
cradleDisplay :: IsString a => Cradle CabalHelper -> a
cradleDisplay cradle = fromString result
where
result
| "stack" `isInfixOf` name = "Stack project"
| "cabal-v1" `isInfixOf` name = "Cabal (V1) project"
| "cabal" `isInfixOf` name = "Cabal project"
| "direct" `isInfixOf` name = "GHC session"
| "multi" `isInfixOf` name = "Multi Component project"
| otherwise = "project"
name = map toLower $ BIOS.actionName (BIOS.cradleOptsProg cradle)
where
result
| Bios.isStackCradle cradle
|| name
`elem` [Bios.Other Stack, Bios.Other StackNone]
= "Stack project"
| Bios.isCabalCradle cradle
|| name
`elem` [Bios.Other CabalV2, Bios.Other CabalNone]
= "Cabal project"
| Bios.isDirectCradle cradle
= "GHC session"
| Bios.isMultiCradle cradle
= "Multi Component project"
| otherwise
= "project"
name = Bios.actionName (Bios.cradleOptsProg cradle)
28 changes: 13 additions & 15 deletions hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,21 +4,19 @@

module Haskell.Ide.Engine.GhcModuleCache where

import qualified Data.Map as Map
import qualified Data.ByteString.Char8 as B
import Data.Dynamic (Dynamic)
import Data.Typeable (TypeRep)

import qualified HIE.Bios as BIOS
import Data.List
import qualified Data.Map as Map
import qualified Data.Trie as T
import qualified Data.ByteString.Char8 as B
import Data.Typeable (TypeRep)

import qualified HIE.Bios as Bios
import GHC (TypecheckedModule, ParsedModule, HscEnv)

import Data.List

import Haskell.Ide.Engine.ArtifactMap

import Language.Haskell.LSP.Types
import Haskell.Ide.Engine.ArtifactMap
import Haskell.Ide.Engine.Cradle
import Language.Haskell.LSP.Types

type UriCaches = Map.Map FilePath UriCacheResult

Expand Down Expand Up @@ -103,7 +101,7 @@ lookupCradle fp gmc =

-- | Find the cradle wide 'ComponentOptions' that apply to a 'FilePath'
lookupComponentOptions
:: HasGhcModuleCache m => FilePath -> m (Maybe BIOS.ComponentOptions)
:: HasGhcModuleCache m => FilePath -> m (Maybe Bios.ComponentOptions)
lookupComponentOptions fp = do
gmc <- getModuleCache
return $ lookupInCache fp gmc (const Just) (Just . compOpts) Nothing
Expand All @@ -112,7 +110,7 @@ lookupInCache
:: FilePath
-> GhcModuleCache
-- | Called when file is in the current cradle
-> (BIOS.Cradle -> BIOS.ComponentOptions -> a)
-> (Bios.Cradle CabalHelper -> Bios.ComponentOptions -> a)
-- | Called when file is a member of a cached cradle
-> (CachedCradle -> a)
-- | Default value to return if a cradle is not found
Expand All @@ -126,9 +124,9 @@ lookupInCache fp gmc cur cached def = case currentCradle gmc of

-- | A 'Cradle', it's 'HscEnv' and 'ComponentOptions'
data CachedCradle = CachedCradle
{ ccradle :: BIOS.Cradle
{ ccradle :: Bios.Cradle CabalHelper
, hscEnv :: HscEnv
, compOpts :: BIOS.ComponentOptions
, compOpts :: Bios.ComponentOptions
}

instance Show CachedCradle where
Expand All @@ -139,7 +137,7 @@ data GhcModuleCache = GhcModuleCache
-- ^ map from FilePath to cradle and it's config.
-- May not include currentCradle
, uriCaches :: !UriCaches
, currentCradle :: Maybe ([FilePath], BIOS.Cradle, BIOS.ComponentOptions)
, currentCradle :: Maybe ([FilePath], Bios.Cradle CabalHelper, Bios.ComponentOptions)
-- ^ The current cradle, it's config,
-- and which FilePath's it is responsible for.
} deriving (Show)
Expand Down
16 changes: 16 additions & 0 deletions hie-plugin-api/Haskell/Ide/Engine/Logger.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
module Haskell.Ide.Engine.Logger where

import Control.Monad.IO.Class
import System.Log.Logger

logm :: MonadIO m => String -> m ()
logm s = liftIO $ infoM "hie" s

debugm :: MonadIO m => String -> m ()
debugm s = liftIO $ debugM "hie" s

warningm :: MonadIO m => String -> m ()
warningm s = liftIO $ warningM "hie" s

errorm :: MonadIO m => String -> m ()
errorm s = liftIO $ errorM "hie" s
Loading