5
5
6
6
module Haskell.Ide.Engine.Cradle where
7
7
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
11
12
import Distribution.Helper (Package , projectPackages , pUnits ,
12
13
pSourceDir , ChComponentInfo (.. ),
13
14
unChModuleName , Ex (.. ), ProjLoc (.. ),
14
15
QueryEnv , mkQueryEnv , runQuery ,
15
16
Unit , unitInfo , uiComponents ,
16
17
ChEntrypoint (.. ), UnitInfo (.. ))
17
18
import Distribution.Helper.Discover (findProjects , getDefaultDistDir )
18
- import Data.Char (toLower )
19
19
import Data.Function ((&) )
20
- import Data.List (isPrefixOf , isInfixOf , sortOn , find )
20
+ import Data.List (isPrefixOf , sortOn , find )
21
21
import qualified Data.List.NonEmpty as NonEmpty
22
22
import Data.List.NonEmpty (NonEmpty )
23
23
import qualified Data.Map as Map
@@ -32,6 +32,8 @@ import System.Directory (getCurrentDirectory, canonicalizePath, findEx
32
32
import System.Exit
33
33
import System.Process (readCreateProcessWithExitCode , shell )
34
34
35
+ import Haskell.Ide.Engine.Logger
36
+
35
37
-- | Find the cradle that the given File belongs to.
36
38
--
37
39
-- First looks for a "hie.yaml" file in the directory of the file
@@ -42,44 +44,49 @@ import System.Process (readCreateProcessWithExitCode, shell)
42
44
-- If no "hie.yaml" can be found, the implicit config is used.
43
45
-- The implicit config uses different heuristics to determine the type
44
46
-- of the project that may or may not be accurate.
45
- findLocalCradle :: FilePath -> IO Cradle
47
+ findLocalCradle :: FilePath -> IO ( Cradle CabalHelper )
46
48
findLocalCradle fp = do
47
- cradleConf <- BIOS . findCradle fp
48
- crdl <- case cradleConf of
49
+ cradleConf <- Bios . findCradle fp
50
+ crdl <- case cradleConf of
49
51
Just yaml -> do
50
52
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
53
56
logm $ " Module \" " ++ fp ++ " \" is loaded by Cradle: " ++ show crdl
54
57
return crdl
55
58
56
59
-- | Check if the given cradle is a stack cradle.
57
60
-- This might be used to determine the GHC version to use on the project.
58
61
-- If it is a stack-cradle, we have to use @"stack path --compiler-exe"@
59
62
-- 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
+
64
71
65
72
-- | Check if the given cradle is a cabal cradle.
66
73
-- This might be used to determine the GHC version to use on the project.
67
74
-- If it is a stack-cradle, we have to use @"stack path --compiler-exe"@
68
75
-- 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 )
83
90
84
91
-- | Execute @ghc@ that is based on the given cradle.
85
92
-- Output must be a single line. If an error is raised, e.g. the command
@@ -88,7 +95,7 @@ isCabalCradle =
88
95
--
89
96
-- E.g. for a stack cradle, we use @stack ghc@ and for a cabal cradle
90
97
-- 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 )
92
99
execProjectGhc crdl args = do
93
100
isStackInstalled <- isJust <$> findExecutable " stack"
94
101
-- isCabalInstalled <- isJust <$> findExecutable "cabal"
@@ -144,7 +151,7 @@ tryCommand cmd = do
144
151
145
152
146
153
-- | Get the directory of the libdir based on the project ghc.
147
- getProjectGhcLibDir :: Cradle -> IO (Maybe FilePath )
154
+ getProjectGhcLibDir :: Cradle CabalHelper -> IO (Maybe FilePath )
148
155
getProjectGhcLibDir crdl =
149
156
execProjectGhc crdl [" --print-libdir" ] >>= \ case
150
157
Nothing -> do
@@ -441,7 +448,7 @@ the compiler options obtained from Cabal-Helper are relative to the package
441
448
source directory, which is "\/Repo\/SubRepo".
442
449
443
450
-}
444
- cabalHelperCradle :: FilePath -> IO Cradle
451
+ cabalHelperCradle :: FilePath -> IO ( Cradle CabalHelper )
445
452
cabalHelperCradle file = do
446
453
projM <- findCabalHelperEntryPoint file
447
454
case projM of
@@ -451,7 +458,7 @@ cabalHelperCradle file = do
451
458
return
452
459
Cradle { cradleRootDir = cwd
453
460
, cradleOptsProg =
454
- CradleAction { actionName = " Direct"
461
+ CradleAction { actionName = Bios. Direct
455
462
, runCradle = \ _ _ ->
456
463
return
457
464
$ CradleSuccess
@@ -467,7 +474,7 @@ cabalHelperCradle file = do
467
474
let root = projectRootDir proj
468
475
-- Create a suffix for the cradle name.
469
476
-- Purpose is mainly for easier debugging.
470
- let actionNameSuffix = projectSuffix proj
477
+ let actionNameSuffix = projectType proj
471
478
debugm $ " Cabal-Helper dirs: " ++ show [root, file]
472
479
let dist_dir = getDefaultDistDir proj
473
480
env <- mkQueryEnv proj dist_dir
@@ -484,9 +491,7 @@ cabalHelperCradle file = do
484
491
return
485
492
Cradle { cradleRootDir = root
486
493
, cradleOptsProg =
487
- CradleAction { actionName = " Cabal-Helper-"
488
- ++ actionNameSuffix
489
- ++ " -None"
494
+ CradleAction { actionName = Bios. Other (projectNoneType proj)
490
495
, runCradle = \ _ _ -> return CradleNone
491
496
}
492
497
}
@@ -501,8 +506,7 @@ cabalHelperCradle file = do
501
506
return
502
507
Cradle { cradleRootDir = normalisedPackageLocation
503
508
, cradleOptsProg =
504
- CradleAction { actionName =
505
- " Cabal-Helper-" ++ actionNameSuffix
509
+ CradleAction { actionName = Bios. Other actionNameSuffix
506
510
, runCradle = \ _ fp -> cabalHelperAction
507
511
(Ex proj)
508
512
env
@@ -751,12 +755,19 @@ projectRootDir ProjLocV2File { plProjectDirV2 } = plProjectDirV2
751
755
projectRootDir ProjLocV2Dir { plProjectDirV2 } = plProjectDirV2
752
756
projectRootDir ProjLocStackYaml { plStackYaml } = takeDirectory plStackYaml
753
757
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
760
771
761
772
-- ----------------------------------------------------------------------------
762
773
--
@@ -867,14 +878,22 @@ relativeTo file sourceDirs =
867
878
868
879
-- | Returns a user facing display name for the cradle type,
869
880
-- e.g. "Stack project" or "GHC session"
870
- cradleDisplay :: IsString a => BIOS. Cradle -> a
881
+ cradleDisplay :: IsString a => Cradle CabalHelper -> a
871
882
cradleDisplay 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