Refactor functions and add Documentation

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

@@ -2,10 +2,10 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE GADTs #-}
 
-module Haskell.Ide.Engine.Cradle (findLocalCradle) where
+module Haskell.Ide.Engine.Cradle (findLocalCradle, isStackCradle) where
 
 import           HIE.Bios as BIOS
-import           HIE.Bios.Types
+import           HIE.Bios.Types as BIOS
 import           Haskell.Ide.Engine.MonadFunctions
 import           Distribution.Helper
 import           Distribution.Helper.Discover
@@ -35,9 +35,17 @@ findLocalCradle fp = do
   -- Get the cabal directory from the cradle
   cradleConf <- BIOS.findCradle fp
   case cradleConf of
-    Just yaml -> BIOS.loadCradle yaml
+    Just yaml -> fixCradle <$> BIOS.loadCradle yaml
+
     Nothing   -> cabalHelperCradle fp
 
+-- | 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 --compile-exe`
+-- otherwise we may ask `ghc` directly what version it is.
+isStackCradle :: Cradle -> Bool
+isStackCradle = (`elem` ["stack", "Cabal-Helper-Stack"]) . BIOS.actionName . BIOS.cradleOptsProg
+
 -- | Finds a Cabal v2-project, Cabal v1-project or a Stack project
 -- relative to the given FilePath.
 -- Cabal v2-project and Stack have priority over Cabal v1-project.
@@ -74,12 +82,16 @@ findCabalHelperEntryPoint fp = do
     isCabalOldProject (Ex ProjLocV1CabalFile {}) = True
     isCabalOldProject _ = False
 
+-- | Given a FilePath, find the Cradle the FilePath belongs to.
+--
+-- TODO: document how and why this works.
 cabalHelperCradle :: FilePath -> IO Cradle
-cabalHelperCradle file' = do
-  file <- canonicalizePath file' -- This is probably unneeded.
-  projM <- findCabalHelperEntryPoint file'
+cabalHelperCradle file = do
+  projM <- findCabalHelperEntryPoint file
   case projM of
-    Nothing        -> error $ "Could not find a Project for file: " ++ file'
+    Nothing        -> do
+      errorm $ "Could not find a Project for file: " ++ file
+      error $ "Could not find a Project for file: " ++ file
     Just (Ex proj) -> do
       -- Find the root of the project based on project type.
       let root = projectRootDir proj
@@ -113,9 +125,9 @@ cabalHelperCradle file' = do
         Just realPackage -> do
           -- Field `pSourceDir` often has the form `<cwd>/./plugin`
           -- but we only want `<cwd>/plugin`
-          debugm $ "Package: " ++ show realPackage
+          debugm $ "Cabal-Helper cradle package: " ++ show realPackage
           let normalisedPackageLocation = normalise $ pSourceDir realPackage
-          debugm $ "normalisedPackageLocation: " ++ normalisedPackageLocation
+          debugm $ "Cabal-Helper normalisedPackageLocation: " ++ normalisedPackageLocation
           return
             Cradle { cradleRootDir = normalisedPackageLocation
                    , cradleOptsProg =
@@ -128,20 +140,24 @@ cabalHelperCradle file' = do
                                     }
                    }
   where
-    cabalHelperAction :: QueryEnv v
-                      -> Package v
-                      -> FilePath
-                      -> FilePath
+    -- | Cradle Action to query for the ComponentOptions that are needed
+    -- to load the given FilePath.
+    -- This Function is not supposed to throw any exceptions and use
+    -- 'CradleLoadResult' to indicate errors.
+    cabalHelperAction :: QueryEnv v -- ^ Query Env created by 'mkQueryEnv'
+                                    -- with the appropriate 'distdir'
+                      -> Package v -- ^ Package this Cradle is part for.
+                      -> FilePath -- ^ Absolute directory of the package.
+                      -> FilePath -- ^ FilePath to load.
                       -> IO (CradleLoadResult ComponentOptions)
-    cabalHelperAction env package relativeDir fp = do
+    cabalHelperAction env package root fp = do
       let units = pUnits package
       -- Get all unit infos the given FilePath may belong to
       -- TODO: lazily initialise units as needed
       unitInfos_ <- mapM (\unit -> runQuery (unitInfo unit) env) units
-      let fpRelativeDir = takeDirectory $ makeRelative relativeDir fp
-      debugm $ "relativeDir: " ++ relativeDir
-      debugm $ "fpRelativeDir: " ++ fpRelativeDir
-      case getComponent fpRelativeDir unitInfos_ of
+      let fpRelativeDir = takeDirectory $ makeRelative root fp
+      debugm $ "Module FilePath relative to the package root: " ++ fpRelativeDir
+      case getComponent unitInfos_ fpRelativeDir of
         Just comp -> do
           let fs = getFlags comp
           let targets = getTargets comp fpRelativeDir
@@ -157,8 +173,8 @@ cabalHelperCradle file' = do
           $ CradleError (ExitFailure 2) ("Could not obtain flags for " ++ fp)
 
 -- TODO: This can be a complete match
-getComponent :: FilePath -> NonEmpty UnitInfo -> Maybe ChComponentInfo
-getComponent dir ui = listToMaybe
+getComponent :: NonEmpty UnitInfo -> FilePath -> Maybe ChComponentInfo
+getComponent ui dir = listToMaybe
   $ map snd
   $ filter (hasParent dir . fst)
   $ sortOn (Down . length . fst)
@@ -171,10 +187,11 @@ getFlags = ciGhcOptions
 
 -- | Get all Targets of a Component, since we want to load all components.
 -- FilePath is needed for the special case that the Component is an Exe.
--- The Exe contains a Path to the Main which is relative to some entry in the 'ciSourceDirs'.
--- We monkey patch this by supplying the FilePath we want to load,
+-- The Exe contains a Path to the Main which is relative to some entry
+-- in 'ciSourceDirs'.
+-- We monkey-patch this by supplying the FilePath we want to load,
 -- which is part of this component, and select the 'ciSourceDir' we actually want.
--- See the Documenation of 'ciCourceDir' to why this contains multiple entries.
+-- See the Documentation of 'ciCourceDir' to why this contains multiple entries.
 getTargets :: ChComponentInfo -> FilePath -> [String]
 getTargets comp fp = case ciEntrypoints comp of
   ChSetupEntrypoint {} -> []
@@ -190,13 +207,18 @@ hasParent :: FilePath -> FilePath -> Bool
 hasParent child parent =
   any (equalFilePath parent) (map joinPath $ inits $ splitPath child)
 
+
+-- | For all packages in a project, find the project the given FilePath
+-- belongs to most likely.
 findPackageFor :: NonEmpty (Package pt) -> FilePath -> Maybe (Package pt)
 findPackageFor packages fp = packages
   & NonEmpty.toList
   & sortOn (Down . pSourceDir)
   & filter (\p -> pSourceDir p `isFilePathPrefixOf` fp)
   & listToMaybe
 
+-- | Helper function to make sure that both FilePaths are normalised.
+--
 isFilePathPrefixOf :: FilePath -> FilePath -> Bool
 isFilePathPrefixOf dir fp = normalise dir `isPrefixOf` normalise fp
 
@@ -213,3 +235,18 @@ projectSuffix ProjLocV1Dir { } =  "Cabal-V1-Dir"
 projectSuffix ProjLocV2File { } = "Cabal-V2"
 projectSuffix ProjLocV2Dir { } = "Cabal-V2-Dir"
 projectSuffix ProjLocStackYaml { } = "Stack"
+
+-- | The hie-bios stack cradle doesn't return the target as well, so add the
+-- FilePath onto the end of the options to make sure at least one target
+-- is returned.
+fixCradle :: BIOS.Cradle -> BIOS.Cradle
+fixCradle cradle =
+  -- Normally this would also succeed for the 'Cabal-Helper-Stack' cradle.
+  -- Make sure that the cradle is definitely the one created by "HIE.Bios.Cradle.loadCradle"
+  if isStackCradle cradle
+    -- We need a lens
+    then cradle { BIOS.cradleOptsProg = (BIOS.cradleOptsProg cradle)
+                { BIOS.runCradle = \fp' ->  fmap (addOption fp') <$> BIOS.runCradle (BIOS.cradleOptsProg cradle) fp' } }
+    else cradle
+  where
+    addOption fp (BIOS.ComponentOptions os ds) = BIOS.ComponentOptions (os ++ [fp]) ds

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

@@ -132,15 +132,12 @@ loadCradle iniDynFlags (NewCradle fp) = do
   withProgress "Initialising Cradle" NotCancellable (initialiseCradle cradle)
 
  where
-  isStackCradle :: BIOS.Cradle -> Bool
-  isStackCradle c = BIOS.actionName (BIOS.cradleOptsProg c) == "stack"
-
   -- | Initialise the given cradle. This might fail and return an error via `IdeResultFail`.
   -- Reports its progress to the client.
   initialiseCradle :: (MonadIde m, HasGhcModuleCache m, GHC.GhcMonad m, MonadBaseControl IO m)
                   => BIOS.Cradle -> (Progress -> IO ()) -> m (IdeResult ())
   initialiseCradle cradle f = do
-    res <- BIOS.initializeFlagsWithCradleWithMessage (Just (toMessager f)) fp (fixCradle cradle)
+    res <- BIOS.initializeFlagsWithCradleWithMessage (Just (toMessager f)) fp cradle
     case res of
       BIOS.CradleNone -> return (IdeResultOk ())
       BIOS.CradleFail err -> do
@@ -173,19 +170,6 @@ loadCradle iniDynFlags (NewCradle fp) = do
           Right () ->
             IdeResultOk <$> setCurrentCradle cradle
 
-  -- The stack cradle doesn't return the target as well, so add the
-  -- FilePath onto the end of the options to make sure at least one target
-  -- is returned.
-  fixCradle :: BIOS.Cradle -> BIOS.Cradle
-  fixCradle cradle = do
-    if isStackCradle cradle
-      -- We need a lens
-      then cradle { BIOS.cradleOptsProg = (BIOS.cradleOptsProg cradle)
-                  { BIOS.runCradle = \fp' ->  fmap addOption <$> BIOS.runCradle (BIOS.cradleOptsProg cradle) fp' } }
-      else cradle
-    where
-      addOption (BIOS.ComponentOptions os ds) = BIOS.ComponentOptions (os ++ [fp]) ds
-
 -- | Sets the current cradle for caching.
 -- Retrieves the current GHC Module Graph, to find all modules
 -- that belong to this cradle.

src/Haskell/Ide/Engine/Plugin/Base.hs

@@ -20,7 +20,7 @@ import           Development.GitRev              (gitCommitCount)
 import           Distribution.System             (buildArch)
 import           Distribution.Text               (display)
 import           Haskell.Ide.Engine.MonadTypes
-import qualified HIE.Bios.Types as BIOS
+import qualified Haskell.Ide.Engine.Cradle (isStackCradle)
 import           Options.Applicative.Simple      (simpleVersion)
 import qualified Paths_haskell_ide_engine        as Meta
 
@@ -110,7 +110,7 @@ getProjectGhcVersion :: BIOS.Cradle -> IO String
 getProjectGhcVersion crdl = do
   isStackProject   <- doesFileExist "stack.yaml"
   isStackInstalled <- isJust <$> findExecutable "stack"
-  if BIOS.actionName (BIOS.cradleOptsProg crdl) == "stack" && isStackProject && isStackInstalled
+  if isStackCradle crdl && isStackProject && isStackInstalled
     then do
       L.infoM "hie" "Using stack GHC version"
       catch (tryCommand "stack ghc -- --numeric-version") $ \e -> do