Update HIE to use latest hie-bios

Author: fendor

.gitmodules

@@ -10,3 +10,6 @@
 #     rm -rf path_to_submodule
 
 
+[submodule "hie-bios"]
+	path = hie-bios
+	url = https://github.com/mpickering/hie-bios.git

app/MainHie.hs

@@ -13,7 +13,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
@@ -198,7 +199,7 @@ run opts = do
 
 -- ---------------------------------------------------------------------
 
-getCradleInfo :: FilePath -> IO (Either Yaml.ParseException Cradle)
+getCradleInfo :: FilePath -> IO (Either Yaml.ParseException (Cradle CabalHelper))
 getCradleInfo currentDir = do
         let dummyCradleFile = currentDir </> "File.hs"
         cradleRes <- E.try (findLocalCradle dummyCradleFile)

cabal.project

@@ -1,7 +1,7 @@
 packages:
          ./
          ./hie-plugin-api/
-
+         ./hie-bios/
          -- ./submodules/HaRe
 
 tests: true

hie-bios

@@ -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
 

hie-plugin-api/Haskell/Ide/Engine/ArtifactMap.hs

@@ -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 (Cradle(..), 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
@@ -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
@@ -42,44 +44,67 @@ 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 $ relaxCradle crdl
+    Nothing -> cabalHelperCradle fp
   logm $ "Module \"" ++ fp ++ "\" is loaded by Cradle: " ++ show crdl
   return crdl
+ where
+  relaxCradle :: Cradle a -> Cradle CabalHelper
+  relaxCradle crdl =
+    let newActionName = case actionName $ cradleOptsProg crdl of
+          Bios.Other _ -> Bios.Other CabalNone
+          Bios.Stack   -> Bios.Stack
+          Bios.Cabal   -> Bios.Cabal
+          Bios.Direct  -> Bios.Direct
+          Bios.None    -> Bios.None
+          Bios.Multi   -> Bios.Multi
+          Bios.Default -> Bios.Default
+          Bios.Bios    -> Bios.Bios
+    in  crdl
+          { cradleOptsProg = (cradleOptsProg crdl) { actionName = newActionName
+                                                   }
+          }
 
 -- | 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 =
+  ( `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 :: Cradle CabalHelper -> 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"
-    ]
+  ( `elem`
+      [ Bios.Other CabalV2
+      , Bios.Other CabalNone
+      ]
   )
-  . BIOS.actionName
-  . BIOS.cradleOptsProg
+  . 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
@@ -88,7 +113,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"
@@ -144,7 +169,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
@@ -441,7 +466,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
@@ -451,7 +476,7 @@ cabalHelperCradle file = do
       return
         Cradle { cradleRootDir = cwd
                , cradleOptsProg =
-                   CradleAction { actionName = "Direct"
+                   CradleAction { actionName = Bios.Direct
                                 , runCradle = \_ _ ->
                                       return
                                       $ CradleSuccess
@@ -484,9 +509,7 @@ cabalHelperCradle file = do
           return
             Cradle { cradleRootDir = root
                    , cradleOptsProg =
-                       CradleAction { actionName = "Cabal-Helper-"
-                                        ++ actionNameSuffix
-                                        ++ "-None"
+                       CradleAction { actionName = Bios.None
                                     , runCradle = \_ _ -> return CradleNone
                                     }
                    }
@@ -501,8 +524,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
@@ -751,12 +773,12 @@ 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"
+projectSuffix :: ProjLoc qt -> CabalHelper
+projectSuffix ProjLocV1CabalFile {} = CabalV2
+projectSuffix ProjLocV1Dir {} = CabalV2
+projectSuffix ProjLocV2File {} = CabalV2
+projectSuffix ProjLocV2Dir {} = CabalV2
+projectSuffix ProjLocStackYaml {} = Stack
 
 -- ----------------------------------------------------------------------------
 --
@@ -867,14 +889,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)

hie-plugin-api/Haskell/Ide/Engine/Cradle.hs

@@ -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
 
@@ -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
@@ -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
@@ -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
@@ -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)

hie-plugin-api/Haskell/Ide/Engine/GhcModuleCache.hs

@@ -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