Skip to content

Commit b74bced

Browse files
rm41339rm41339
committed
fix bytes and cache error in parsing
1 parent 8adcdd5 commit b74bced

File tree

4 files changed

+235
-15
lines changed

4 files changed

+235
-15
lines changed

‎haskell-language-server.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -370,6 +370,8 @@ library hls-cabal-project-plugin
370370
, cabal-install
371371
, cabal-install-solver
372372
, haskell-language-server:hls-cabal-plugin
373+
, base16-bytestring
374+
, cryptohash-sha1
373375

374376

375377
hs-source-dirs: plugins/hls-cabal-project-plugin/src

‎plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -135,7 +135,8 @@ descriptor recorder plId =
135135
-- for development/debugging
136136
parseAndPrint :: FilePath -> IO ()
137137
parseAndPrint file = do
138-
(warnings, res) <- Parse.parseCabalProjectFileContents file
138+
bytes <- BS.readFile file
139+
(warnings, res) <- Parse.parseCabalProjectFileContents file bytes
139140

140141
mapM_ (putStrLn . ("[Cabal warning] " ++) . show) warnings
141142

@@ -200,19 +201,18 @@ cabalRules recorder plId = do
200201
if not (plcGlobalOn cfg && plcDiagnosticsOn cfg)
201202
then pure ([], Nothing)
202203
else do
203-
-- 1. Grab file contents (virtual-file or disk)
204-
(_hash, mRope) <- use_ GetFileContents file
205-
bytes <- case mRope of
206-
Just rope -> pure (Encoding.encodeUtf8 (Rope.toText rope))
207-
Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath file)
204+
-- whenever this key is marked as dirty (e.g., when a user writes stuff to it),
205+
-- we rerun this rule because this rule *depends* on GetModificationTime.
206+
(t, mRope) <- use_ GetFileContents file
207+
log' Debug $ LogModificationTime file t
208208

209-
-- 2. Run Cabal’s parser for cabal.project
210-
(pWarnings, pResult) <- liftIO $ Parse.parseCabalProjectFileContents (fromNormalizedFilePath file)
209+
bytes <- case mRope of
210+
Just sources -> pure (Encoding.encodeUtf8 (Rope.toText sources))
211+
Nothing -> liftIO $ BS.readFile (fromNormalizedFilePath file)
211212

212-
-- 3. Convert warnings
213+
(pWarnings, pResult) <- liftIO $ Parse.parseCabalProjectFileContents (fromNormalizedFilePath file) bytes
213214
let warnDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings
214215

215-
-- 4. Convert result or errors
216216
case pResult of
217217
Left (_specVer, pErrNE) -> do
218218
let errDiags = NE.toList $ NE.map (Diagnostics.errorDiagnostic file) pErrNE

‎plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Orphans.hs

Lines changed: 195 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,3 +22,198 @@ deriving instance NFData PCPath.ProjectConfigPath
2222
instance NFData PC.ProjectConfig where
2323
rnf !_ = ()
2424

25+
-- {-# OPTIONS_GHC -Wno-orphans #-}
26+
-- {-# LANGUAGE FlexibleInstances #-}
27+
-- {-# LANGUAGE RecordWildCards #-}
28+
29+
-- module Ide.Plugin.CabalProject.Orphans () where
30+
31+
-- import Control.DeepSeq ( NFData, rnf )
32+
-- import Distribution.Compat.Prelude ( genericRnf )
33+
-- import Distribution.Verbosity (Verbosity)
34+
-- import Distribution.Verbosity.Internal (VerbosityLevel(..), VerbosityFlag(..))
35+
-- import Ide.Plugin.Cabal.Orphans ()
36+
37+
-- import Distribution.Client.ProjectConfig.Types
38+
-- ( BuildTimeSettings(..) )
39+
-- import Distribution.Simple.InstallDirs.Internal
40+
-- ( PathComponent(..), PathTemplateVariable(..)
41+
-- )
42+
-- import Distribution.Simple.InstallDirs
43+
-- ( PathTemplate(..) )
44+
-- import Control.DeepSeq ( NFData(rnf) )
45+
-- import Distribution.Client.BuildReports.Types (ReportLevel)
46+
47+
-- import Distribution.Client.Types.Repo (RemoteRepo, LocalRepo)
48+
49+
-- -- PathTemplate
50+
-- instance NFData PathTemplate where
51+
-- rnf = genericRnf
52+
53+
-- instance NFData PathComponent where
54+
-- rnf = genericRnf
55+
56+
-- instance NFData PathTemplateVariable where
57+
-- rnf = genericRnf
58+
59+
-- -- Verbosity
60+
-- instance NFData Verbosity where
61+
-- rnf = genericRnf
62+
63+
-- -- instance NFData VerbosityLevel where
64+
-- -- rnf = genericRnf
65+
66+
-- -- instance NFData VerbosityFlag where
67+
-- -- rnf = genericRnf
68+
69+
-- -- ReportLevel
70+
-- instance NFData ReportLevel where
71+
-- rnf = genericRnf
72+
73+
-- -- RemoteRepo
74+
-- instance NFData RemoteRepo where
75+
-- rnf = genericRnf
76+
77+
-- instance NFData LocalRepo where
78+
-- rnf = genericRnf
79+
80+
-- instance NFData BuildTimeSettings where
81+
-- rnf bts =
82+
-- rnf (buildSettingDryRun bts)
83+
-- `seq` rnf (buildSettingOnlyDeps bts)
84+
-- `seq` rnf (buildSettingOnlyDownload bts)
85+
-- `seq` rnf (buildSettingSummaryFile bts)
86+
-- `seq` ()
87+
-- `seq` rnf (buildSettingLogVerbosity bts)
88+
-- `seq` rnf (buildSettingBuildReports bts)
89+
-- `seq` rnf (buildSettingReportPlanningFailure bts)
90+
-- `seq` rnf (buildSettingSymlinkBinDir bts)
91+
-- `seq` rnf (buildSettingNumJobs bts)
92+
-- `seq` rnf (buildSettingKeepGoing bts)
93+
-- `seq` rnf (buildSettingOfflineMode bts)
94+
-- `seq` rnf (buildSettingKeepTempFiles bts)
95+
-- `seq` rnf (buildSettingRemoteRepos bts)
96+
-- `seq` rnf (buildSettingLocalNoIndexRepos bts)
97+
-- `seq` rnf (buildSettingCacheDir bts)
98+
-- `seq` rnf (buildSettingHttpTransport bts)
99+
-- `seq` rnf (buildSettingIgnoreExpiry bts)
100+
-- `seq` rnf (buildSettingProgPathExtra bts)
101+
-- `seq` rnf (buildSettingHaddockOpen bts)
102+
-- `seq` ()
103+
-- {-# OPTIONS_GHC -Wno-orphans #-}
104+
-- module Ide.Plugin.CabalProject.Orphans () where
105+
106+
-- import Control.DeepSeq ( NFData, rnf)
107+
-- import Distribution.Compat.Prelude (genericRnf)
108+
-- import Ide.Plugin.Cabal.Orphans ()
109+
-- import Distribution.Client.ProjectConfig.Types (BuildTimeSettings(..))
110+
-- import GHC.Generics ( Generic )
111+
-- import Control.DeepSeq ( NFData(rnf) )
112+
-- import Distribution.Simple.InstallDirs ( PathTemplate )
113+
-- import Distribution.Verbosity ( Verbosity )
114+
-- import Distribution.Client.BuildReports.Types ( ReportLevel )
115+
-- import Distribution.Types.ParStrat ( ParStratInstall )
116+
-- import Distribution.Client.Types.Repo ( RemoteRepo, LocalRepo )
117+
118+
-- -- 1) Orphan NFData instances for all the “missing” imported types.
119+
-- instance NFData PathTemplate where rnf = genericRnf
120+
-- instance NFData Verbosity where rnf = genericRnf
121+
-- instance NFData ReportLevel where rnf = genericRnf
122+
-- instance NFData ParStratInstall where rnf = genericRnf
123+
-- instance NFData RemoteRepo where rnf = genericRnf
124+
-- instance NFData LocalRepo where rnf = genericRnf
125+
126+
-- instance NFData BuildTimeSettings where
127+
-- rnf bts =
128+
-- rnf (buildSettingDryRun bts)
129+
-- `seq` rnf (buildSettingOnlyDeps bts)
130+
-- `seq` rnf (buildSettingOnlyDownload bts)
131+
-- `seq` rnf (buildSettingSummaryFile bts)
132+
-- `seq` ()
133+
-- `seq` rnf (buildSettingLogVerbosity bts)
134+
-- `seq` rnf (buildSettingBuildReports bts)
135+
-- `seq` rnf (buildSettingReportPlanningFailure bts)
136+
-- `seq` rnf (buildSettingSymlinkBinDir bts)
137+
-- `seq` rnf (buildSettingNumJobs bts)
138+
-- `seq` rnf (buildSettingKeepGoing bts)
139+
-- `seq` rnf (buildSettingOfflineMode bts)
140+
-- `seq` rnf (buildSettingKeepTempFiles bts)
141+
-- `seq` rnf (buildSettingRemoteRepos bts)
142+
-- `seq` rnf (buildSettingLocalNoIndexRepos bts)
143+
-- `seq` rnf (buildSettingCacheDir bts)
144+
-- `seq` rnf (buildSettingHttpTransport bts)
145+
-- `seq` rnf (buildSettingIgnoreExpiry bts)
146+
-- `seq` rnf (buildSettingProgPathExtra bts)
147+
-- `seq` rnf (buildSettingHaddockOpen bts)
148+
-- `seq` ()
149+
150+
151+
-- import Control.DeepSeq (NFData(rnf))
152+
-- import qualified Data.Map as Map
153+
-- import qualified Data.Set as Set
154+
-- import Ide.Plugin.Cabal.Orphans ()
155+
156+
157+
-- import Distribution.Client.ProjectConfig.Types
158+
-- ( ProjectConfig(..)
159+
-- , ProjectConfigBuildOnly
160+
-- , ProjectConfigShared
161+
-- , ProjectConfigProvenance
162+
-- , PackageConfig
163+
-- , MapMappend(getMapMappend)
164+
-- )
165+
-- import Distribution.Client.Types.SourceRepo
166+
-- ( SourceRepoList )
167+
-- import Distribution.Types.PackageVersionConstraint
168+
-- ( PackageVersionConstraint )
169+
-- import Distribution.Types.PackageName
170+
-- ( PackageName )
171+
172+
-- -- | The only “deep” NFData: we pattern‐match on all ten fields and
173+
-- -- rnf them. For the Set we convert to a list so we don’t need
174+
-- -- a Set‐instance; for the MapMappend we unwrap to a list of pairs.
175+
-- instance NFData ProjectConfig where
176+
-- rnf (ProjectConfig
177+
-- pkgs
178+
-- pkgsOpt
179+
-- pkgsRepo
180+
-- pkgsNamed
181+
-- buildOnly
182+
-- shared
183+
-- prov
184+
-- allPkgs
185+
-- localPkgs
186+
-- specificM) =
187+
-- rnf pkgs
188+
-- `seq` rnf pkgsOpt
189+
-- `seq` rnf pkgsRepo
190+
-- `seq` rnf pkgsNamed
191+
-- `seq` rnf buildOnly
192+
-- `seq` rnf shared
193+
-- `seq` rnf (Set.toList prov)
194+
-- `seq` rnf allPkgs
195+
-- `seq` rnf localPkgs
196+
-- `seq` rnf (Map.toList (getMapMappend specificM))
197+
198+
-- -- Trivial NFData instances for all of the immediate field types
199+
-- -- so that the above rnf calls will compile.
200+
201+
-- instance NFData SourceRepoList where
202+
-- rnf _ = ()
203+
204+
-- instance NFData ProjectConfigBuildOnly where
205+
-- rnf _ = ()
206+
207+
-- instance NFData ProjectConfigShared where
208+
-- rnf _ = ()
209+
210+
-- instance NFData ProjectConfigProvenance where
211+
-- rnf _ = ()
212+
213+
-- instance NFData PackageConfig where
214+
-- rnf _ = ()
215+
216+
217+
------------------------------------------------- OLD
218+
219+

‎plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs

Lines changed: 28 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,10 @@ module Ide.Plugin.CabalProject.Parse
66
) where
77

88
import Control.Monad (unless)
9+
import qualified Crypto.Hash.SHA1 as H
910
import qualified Data.ByteString as BS
11+
import qualified Data.ByteString.Base16 as B16
12+
import qualified Data.ByteString.Char8 as B
1013
import Data.List.NonEmpty (NonEmpty (..))
1114
import qualified Data.List.NonEmpty as NE
1215
import qualified Data.Text as T
@@ -25,21 +28,30 @@ import Distribution.Types.Version (Version)
2528
import Distribution.Verbosity (normal)
2629
import qualified Ide.Plugin.CabalProject.Diagnostics as Diagnostics
2730
import System.Directory (doesFileExist)
28-
import System.FilePath (takeDirectory)
31+
import System.Directory.Extra (XdgDirectory (..),
32+
getXdgDirectory)
33+
import System.FilePath (takeBaseName,
34+
takeDirectory, (</>))
35+
-- import System.Directory.Extra as SD
36+
37+
38+
2939

3040
parseCabalProjectFileContents
3141
:: FilePath
42+
-> BS.ByteString
3243
-> IO ([PWarning]
3344
, Either (Maybe Version, NonEmpty PError) ProjectConfigSkeleton)
34-
parseCabalProjectFileContents fp = do
35-
bytes <- BS.readFile fp
45+
parseCabalProjectFileContents fp bytes = do
46+
cacheDir <- getCabalProjectCacheDir fp
47+
-- bytes <- BS.readFile fp
3648
let toParse = ProjectConfigToParse bytes
37-
rootDir = takeDirectory fp
49+
-- rootDir = takeDirectory fp
3850
verb = normal
3951
httpTransport <- configureTransport verb [fp] Nothing
4052

4153
parseRes :: PR.ParseResult ProjectConfigSkeleton
42-
<- parseProject rootDir fp httpTransport verb toParse
54+
<- parseProject fp cacheDir httpTransport verb toParse
4355

4456
pure (PR.runParseResult parseRes)
4557

@@ -57,3 +69,14 @@ readCabalProjectFields file contents =
5769

5870
(_warnings, Right fields) ->
5971
Right fields
72+
73+
getCabalProjectCacheDir :: FilePath -> IO FilePath
74+
getCabalProjectCacheDir fp = do
75+
getXdgDirectory XdgCache (cacheDir </> prefix ++ "-" ++ opts_hash)
76+
where
77+
prefix = takeBaseName $ takeDirectory fp
78+
-- Create a unique folder per cabal.project file
79+
opts_hash = B.unpack $ B16.encode $ H.finalize $ H.updates H.init [B.pack fp]
80+
81+
cacheDir :: String
82+
cacheDir = "ghcide"

0 commit comments

Comments
 (0)