55
66module Haskell.Ide.Engine.Cradle where
77
8- import HIE.Bios as BIOS
9- import HIE.Bios.Types as BIOS
10- import Haskell.Ide.Engine.MonadFunctions
8+ import HIE.Bios as Bios
9+ import qualified HIE.Bios.Cradle as Bios
10+ import HIE.Bios.Types (CradleAction (.. ))
11+ import qualified HIE.Bios.Types as Bios
1112import Distribution.Helper (Package , projectPackages , pUnits ,
1213 pSourceDir , ChComponentInfo (.. ),
1314 unChModuleName , Ex (.. ), ProjLoc (.. ),
1415 QueryEnv , mkQueryEnv , runQuery ,
1516 Unit , unitInfo , uiComponents ,
1617 ChEntrypoint (.. ), UnitInfo (.. ))
1718import Distribution.Helper.Discover (findProjects , getDefaultDistDir )
18- import Data.Char (toLower )
1919import Data.Function ((&) )
20- import Data.List (isPrefixOf , isInfixOf , sortOn , find )
20+ import Data.List (isPrefixOf , sortOn , find )
2121import qualified Data.List.NonEmpty as NonEmpty
2222import Data.List.NonEmpty (NonEmpty )
2323import qualified Data.Map as Map
@@ -32,6 +32,8 @@ import System.Directory (getCurrentDirectory, canonicalizePath, findEx
3232import System.Exit
3333import System.Process (readCreateProcessWithExitCode , shell )
3434
35+ import Haskell.Ide.Engine.Logger
36+
3537-- | Find the cradle that the given File belongs to.
3638--
3739-- First looks for a "hie.yaml" file in the directory of the file
@@ -42,44 +44,49 @@ import System.Process (readCreateProcessWithExitCode, shell)
4244-- If no "hie.yaml" can be found, the implicit config is used.
4345-- The implicit config uses different heuristics to determine the type
4446-- of the project that may or may not be accurate.
45- findLocalCradle :: FilePath -> IO Cradle
47+ findLocalCradle :: FilePath -> IO ( Cradle CabalHelper )
4648findLocalCradle fp = do
47- cradleConf <- BIOS . findCradle fp
48- crdl <- case cradleConf of
49+ cradleConf <- Bios . findCradle fp
50+ crdl <- case cradleConf of
4951 Just yaml -> do
5052 debugm $ " Found \" " ++ yaml ++ " \" for \" " ++ fp ++ " \" "
51- BIOS. loadCradle yaml
52- Nothing -> cabalHelperCradle fp
53+ crdl <- Bios. loadCradle yaml
54+ return $ fmap (const CabalNone ) crdl
55+ Nothing -> cabalHelperCradle fp
5356 logm $ " Module \" " ++ fp ++ " \" is loaded by Cradle: " ++ show crdl
5457 return crdl
5558
5659-- | Check if the given cradle is a stack cradle.
5760-- This might be used to determine the GHC version to use on the project.
5861-- If it is a stack-cradle, we have to use @"stack path --compiler-exe"@
5962-- otherwise we may ask `ghc` directly what version it is.
60- isStackCradle :: Cradle -> Bool
61- isStackCradle = (`elem` [" stack" , " Cabal-Helper-Stack" , " Cabal-Helper-Stack-None" ])
62- . BIOS. actionName
63- . BIOS. cradleOptsProg
63+ isStackCradle :: Cradle CabalHelper -> Bool
64+ isStackCradle crdl = Bios. isStackCradle crdl || cabalHelperStackCradle crdl
65+ where
66+ cabalHelperStackCradle =
67+ (`elem` [Bios. Other Stack , Bios. Other StackNone ])
68+ . Bios. actionName
69+ . Bios. cradleOptsProg
70+
6471
6572-- | Check if the given cradle is a cabal cradle.
6673-- This might be used to determine the GHC version to use on the project.
6774-- If it is a stack-cradle, we have to use @"stack path --compiler-exe"@
6875-- otherwise we may ask @ghc@ directly what version it is.
69- isCabalCradle :: Cradle -> Bool
70- isCabalCradle =
71- ( `elem`
72- [ " cabal "
73- , " Cabal-Helper-Cabal-V1 "
74- , " Cabal-Helper-Cabal-V2 "
75- , " Cabal-Helper-Cabal-V1-Dir "
76- , " Cabal-Helper-Cabal-V2-Dir "
77- , " Cabal-Helper-Cabal-V2-None "
78- , " Cabal-Helper-Cabal-None "
79- ]
80- )
81- . BIOS. actionName
82- . BIOS. cradleOptsProg
76+ isCabalCradle :: Cradle CabalHelper -> Bool
77+ isCabalCradle crdl = Bios. isCabalCradle crdl || cabalHelperCabalCradle crdl
78+ where
79+ cabalHelperCabalCradle =
80+ ( `elem` [ Bios. Other CabalV2 , Bios. Other CabalNone ])
81+ . Bios. actionName
82+ . Bios. cradleOptsProg
83+
84+ data CabalHelper
85+ = Stack
86+ | StackNone
87+ | CabalV2
88+ | CabalNone
89+ deriving ( Show , Eq , Ord )
8390
8491-- | Execute @ghc@ that is based on the given cradle.
8592-- Output must be a single line. If an error is raised, e.g. the command
@@ -88,7 +95,7 @@ isCabalCradle =
8895--
8996-- E.g. for a stack cradle, we use @stack ghc@ and for a cabal cradle
9097-- we are taking the @ghc@ that is on the path.
91- execProjectGhc :: Cradle -> [String ] -> IO (Maybe String )
98+ execProjectGhc :: Cradle CabalHelper -> [String ] -> IO (Maybe String )
9299execProjectGhc crdl args = do
93100 isStackInstalled <- isJust <$> findExecutable " stack"
94101 -- isCabalInstalled <- isJust <$> findExecutable "cabal"
@@ -144,7 +151,7 @@ tryCommand cmd = do
144151
145152
146153-- | Get the directory of the libdir based on the project ghc.
147- getProjectGhcLibDir :: Cradle -> IO (Maybe FilePath )
154+ getProjectGhcLibDir :: Cradle CabalHelper -> IO (Maybe FilePath )
148155getProjectGhcLibDir crdl =
149156 execProjectGhc crdl [" --print-libdir" ] >>= \ case
150157 Nothing -> do
@@ -441,7 +448,7 @@ the compiler options obtained from Cabal-Helper are relative to the package
441448source directory, which is "\/Repo\/SubRepo".
442449
443450-}
444- cabalHelperCradle :: FilePath -> IO Cradle
451+ cabalHelperCradle :: FilePath -> IO ( Cradle CabalHelper )
445452cabalHelperCradle file = do
446453 projM <- findCabalHelperEntryPoint file
447454 case projM of
@@ -451,7 +458,7 @@ cabalHelperCradle file = do
451458 return
452459 Cradle { cradleRootDir = cwd
453460 , cradleOptsProg =
454- CradleAction { actionName = " Direct"
461+ CradleAction { actionName = Bios. Direct
455462 , runCradle = \ _ _ ->
456463 return
457464 $ CradleSuccess
@@ -467,7 +474,7 @@ cabalHelperCradle file = do
467474 let root = projectRootDir proj
468475 -- Create a suffix for the cradle name.
469476 -- Purpose is mainly for easier debugging.
470- let actionNameSuffix = projectSuffix proj
477+ let actionNameSuffix = projectType proj
471478 debugm $ " Cabal-Helper dirs: " ++ show [root, file]
472479 let dist_dir = getDefaultDistDir proj
473480 env <- mkQueryEnv proj dist_dir
@@ -484,9 +491,7 @@ cabalHelperCradle file = do
484491 return
485492 Cradle { cradleRootDir = root
486493 , cradleOptsProg =
487- CradleAction { actionName = " Cabal-Helper-"
488- ++ actionNameSuffix
489- ++ " -None"
494+ CradleAction { actionName = Bios. Other (projectNoneType proj)
490495 , runCradle = \ _ _ -> return CradleNone
491496 }
492497 }
@@ -501,8 +506,7 @@ cabalHelperCradle file = do
501506 return
502507 Cradle { cradleRootDir = normalisedPackageLocation
503508 , cradleOptsProg =
504- CradleAction { actionName =
505- " Cabal-Helper-" ++ actionNameSuffix
509+ CradleAction { actionName = Bios. Other actionNameSuffix
506510 , runCradle = \ _ fp -> cabalHelperAction
507511 (Ex proj)
508512 env
@@ -751,12 +755,19 @@ projectRootDir ProjLocV2File { plProjectDirV2 } = plProjectDirV2
751755projectRootDir ProjLocV2Dir { plProjectDirV2 } = plProjectDirV2
752756projectRootDir ProjLocStackYaml { plStackYaml } = takeDirectory plStackYaml
753757
754- projectSuffix :: ProjLoc qt -> FilePath
755- projectSuffix ProjLocV1CabalFile {} = " Cabal-V1"
756- projectSuffix ProjLocV1Dir {} = " Cabal-V1-Dir"
757- projectSuffix ProjLocV2File {} = " Cabal-V2"
758- projectSuffix ProjLocV2Dir {} = " Cabal-V2-Dir"
759- projectSuffix ProjLocStackYaml {} = " Stack"
758+ projectType :: ProjLoc qt -> CabalHelper
759+ projectType ProjLocV1CabalFile {} = CabalV2
760+ projectType ProjLocV1Dir {} = CabalV2
761+ projectType ProjLocV2File {} = CabalV2
762+ projectType ProjLocV2Dir {} = CabalV2
763+ projectType ProjLocStackYaml {} = Stack
764+
765+ projectNoneType :: ProjLoc qt -> CabalHelper
766+ projectNoneType ProjLocV1CabalFile {} = CabalNone
767+ projectNoneType ProjLocV1Dir {} = CabalNone
768+ projectNoneType ProjLocV2File {} = CabalNone
769+ projectNoneType ProjLocV2Dir {} = CabalNone
770+ projectNoneType ProjLocStackYaml {} = StackNone
760771
761772-- ----------------------------------------------------------------------------
762773--
@@ -867,14 +878,22 @@ relativeTo file sourceDirs =
867878
868879-- | Returns a user facing display name for the cradle type,
869880-- e.g. "Stack project" or "GHC session"
870- cradleDisplay :: IsString a => BIOS. Cradle -> a
881+ cradleDisplay :: IsString a => Cradle CabalHelper -> a
871882cradleDisplay cradle = fromString result
872- where
873- result
874- | " stack" `isInfixOf` name = " Stack project"
875- | " cabal-v1" `isInfixOf` name = " Cabal (V1) project"
876- | " cabal" `isInfixOf` name = " Cabal project"
877- | " direct" `isInfixOf` name = " GHC session"
878- | " multi" `isInfixOf` name = " Multi Component project"
879- | otherwise = " project"
880- name = map toLower $ BIOS. actionName (BIOS. cradleOptsProg cradle)
883+ where
884+ result
885+ | Bios. isStackCradle cradle
886+ || name
887+ `elem` [Bios. Other Stack , Bios. Other StackNone ]
888+ = " Stack project"
889+ | Bios. isCabalCradle cradle
890+ || name
891+ `elem` [Bios. Other CabalV2 , Bios. Other CabalNone ]
892+ = " Cabal project"
893+ | Bios. isDirectCradle cradle
894+ = " GHC session"
895+ | Bios. isMultiCradle cradle
896+ = " Multi Component project"
897+ | otherwise
898+ = " project"
899+ name = Bios. actionName (Bios. cradleOptsProg cradle)
0 commit comments