Use hie-bios implicit cradle with a fallback to the cabal-helper one

cabal.project

@@ -13,6 +13,12 @@ source-repository-package
     location: https://github.com/peti/cabal-plan
     tag: 894b76c0b6bf8f7d2f881431df1f13959a8fce87
 
+-- See https://github.com/DanielG/cabal-helper/pull/117
+source-repository-package
+    type: git
+    location: https://github.com/jneira/cabal-helper
+    tag: 27736afc4360ec8e2f2e5e7cddf34e2289d3a2cb
+
 tests: true
 documentation: true
 

exe/Main.hs

@@ -62,6 +62,7 @@ import HIE.Bios.Environment                     (addCmdOpts, makeDynFlagsAbsolut
 import HIE.Bios.Types
 import HscTypes                                 (HscEnv(..), ic_dflags)
 import qualified Language.Haskell.LSP.Core as LSP
+import Ide.Cradle
 import Ide.Logger
 import Ide.Plugin
 import Ide.Plugin.Config
@@ -98,6 +99,7 @@ import Ide.Plugin.Ormolu                  as Ormolu
 import Ide.Plugin.Brittany                as Brittany
 #endif
 import Ide.Plugin.Pragmas                 as Pragmas
+import Data.Void (vacuous)
 
 
 -- ---------------------------------------------------------------------
@@ -296,7 +298,7 @@ setNameCache nc hsc = hsc { hsc_NC = nc }
 -- components mapping to the same hie,yaml file are mapped to the same
 -- HscEnv which is updated as new components are discovered.
 loadSession :: FilePath -> Action (FilePath -> Action (IdeResult HscEnvEq))
-loadSession dir = do
+loadSession _dir = do
   nc <- ideNc <$> getShakeExtras
   liftIO $ do
     -- Mapping from hie.yaml file to HscEnv, one per hie.yaml file
@@ -443,7 +445,7 @@ loadSession dir = do
                 -- throwing an async exception
                 void $ forkIO $ do
                   putStrLn $ "Consulting the cradle for " <> show file
-                  cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
+                  cradle <- maybe (implicitCradle cfp) (fmap vacuous . loadCradle) hieYaml
                   eopts <- cradleToSessionOpts cradle cfp
                   print eopts
                   case eopts of

src/Ide/Cradle.hs

@@ -32,6 +32,7 @@ import           System.Directory (getCurrentDirectory, canonicalizePath, findEx
 import           System.Exit
 import           System.FilePath
 import           System.Process (readCreateProcessWithExitCode, shell, CreateProcess(..))
+import Exception (tryIO)
 
 
 -- ---------------------------------------------------------------------
@@ -58,6 +59,38 @@ findLocalCradle fp = do
   logm $ "Module \"" ++ fp ++ "\" is loaded by Cradle: " ++ show crdl
   return crdl
 
+implicitCradle :: FilePath -> IO (Cradle CabalHelper)
+implicitCradle fp = cradleFallback main fallback
+  where main = loadImplicitCradle fp
+        fallback = cabalHelperCradle fp
+
+cradleFallback :: IO (Cradle CabalHelper) -> IO (Cradle CabalHelper) -> IO (Cradle CabalHelper)
+cradleFallback mainCradle fallbackCradle = do
+  crd@Cradle
+    { cradleOptsProg = CradleAction { actionName = mActionName, runCradle = mRunCradle}
+    } <- mainCradle
+  Cradle
+    { cradleOptsProg = CradleAction { actionName = fbActionName, runCradle = fbRunCradle}
+    } <- fallbackCradle
+  return $ crd {
+    cradleOptsProg =
+      CradleAction
+        { actionName = mActionName
+        , runCradle = \logF fp -> do
+            let fallback errMsg = do
+                  warningm $ "Error loading " ++ cradleDisplay crd
+                          ++ " using cradle action " ++ show mActionName ++ ": " ++ errMsg
+                  warningm $ "Fallback to cradle action " ++ show fbActionName
+                  fbRes <- fbRunCradle logF fp
+                  return fbRes
+            res <- tryIO $ mRunCradle logF fp
+            case res of
+              Left x -> fallback (show x)
+              Right (CradleFail (CradleError _ex stde)) -> fallback (unlines stde)
+              Right chRes -> return chRes
+        }
+  }
+
 -- | 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"@

stack-8.10.1.yaml

@@ -7,7 +7,9 @@ packages:
 
 extra-deps:
 - Cabal-3.2.0.0
-- cabal-helper-1.1.0.0
+# - cabal-helper-1.1.0.0
+- github: jneira/cabal-helper
+  commit: 27736afc4360ec8e2f2e5e7cddf34e2289d3a2cb
 # See https://github.com/haskell-hvr/cabal-plan/pull/55
 - github: peti/cabal-plan
   commit: 894b76c0b6bf8f7d2f881431df1f13959a8fce87

stack-8.6.4.yaml

@@ -11,7 +11,9 @@ extra-deps:
 - bytestring-trie-0.2.5.0
 - Cabal-3.0.2.0
 - cabal-doctest-1.0.8
-- cabal-helper-1.1.0.0
+# - cabal-helper-1.1.0.0
+- github: jneira/cabal-helper
+  commit: 27736afc4360ec8e2f2e5e7cddf34e2289d3a2cb
 - cabal-plan-0.5.0.0
 - constrained-dynamic-0.1.0.0
 # - ghcide-0.1.0

stack-8.6.5.yaml

@@ -10,7 +10,9 @@ extra-deps:
 - brittany-0.12.1.1@rev:2
 - butcher-1.3.3.1
 - Cabal-3.0.2.0
-- cabal-helper-1.1.0.0
+# - cabal-helper-1.1.0.0
+- github: jneira/cabal-helper
+  commit: 27736afc4360ec8e2f2e5e7cddf34e2289d3a2cb
 - cabal-plan-0.6.2.0
 - clock-0.7.2
 - extra-1.7.1

stack-8.8.2.yaml

@@ -7,7 +7,9 @@ packages:
 extra-deps:
 - apply-refact-0.7.0.0
 - bytestring-trie-0.2.5.0
-- cabal-helper-1.1.0.0
+# - cabal-helper-1.1.0.0
+- github: jneira/cabal-helper
+  commit: 27736afc4360ec8e2f2e5e7cddf34e2289d3a2cb
 - clock-0.7.2
 - constrained-dynamic-0.1.0.0
 - floskell-0.10.3

stack-8.8.3.yaml

@@ -7,7 +7,9 @@ packages:
 extra-deps:
 - apply-refact-0.7.0.0
 - bytestring-trie-0.2.5.0
-- cabal-helper-1.1.0.0
+# - cabal-helper-1.1.0.0
+- github: jneira/cabal-helper
+  commit: 27736afc4360ec8e2f2e5e7cddf34e2289d3a2cb
 - clock-0.7.2
 - constrained-dynamic-0.1.0.0
 - floskell-0.10.3