41d693a · ghcide · git.iko.soy

git.iko.soy/ghcide

on master help sign in

Introduce a newtype for file paths with normalized slashes (#1633)

41d693aMoritz Kiefer7 years ago

src/Development/IDE/Functions/Compile.hs+1−1

compare with master

unifiedsplit

@@ -92,7 +92,7 @@ getSrcSpanInfos

92 :: IdeOptions

93 -> ParsedModule

94 -> HscEnv

95− -> [(Located ModuleName, Maybe FilePath)]

95+ -> [(Located ModuleName, Maybe NormalizedFilePath)]

96 -> TcModuleResult

97 -> IO [SpanInfo]

98getSrcSpanInfos opt mod env imports tc =

src/Development/IDE/Functions/DependencyInformation.hs+22−20

@@ -36,20 +36,20 @@ import Module

37-- | Unprocessed results that we get from following all imports recursively starting from a module.

38data RawDependencyInformation = RawDependencyInformation

39− { moduleDependencies :: Map FilePath (Either ModuleParseError [(Located ModuleName, Maybe FilePath)])

39+ { moduleDependencies :: Map NormalizedFilePath (Either ModuleParseError [(Located ModuleName, Maybe NormalizedFilePath)])

40− , pkgDependencies :: Map FilePath (Set InstalledUnitId)

40+ , pkgDependencies :: Map NormalizedFilePath (Set InstalledUnitId)

41 -- ^ Transitive dependencies on pkgs of this file, i.e. immidiate package dependencies and the

42 -- transitive package dependencies of those packages.

43 }

45data DependencyInformation =

46 DependencyInformation

47− { depErrorNodes :: Map FilePath (NonEmpty NodeError)

47+ { depErrorNodes :: Map NormalizedFilePath (NonEmpty NodeError)

48 -- ^ Nodes that cannot be processed correctly.

49− , depModuleDeps :: Map FilePath (Set FilePath)

49+ , depModuleDeps :: Map NormalizedFilePath (Set NormalizedFilePath)

50 -- ^ For a non-error node, this contains the set of module immediate dependencies

51 -- in the same package.

52− , depPkgDeps :: Map FilePath (Set InstalledUnitId)

52+ , depPkgDeps :: Map NormalizedFilePath (Set InstalledUnitId)

53 -- ^ For a non-error node, this contains the set of immediate pkg deps.

54 } deriving (Show, Generic)

@@ -69,7 +69,7 @@ instance NFData LocateError

70-- | An error attached to a node in the dependency graph.

71data NodeError

72− = PartOfCycle (Located ModuleName) [FilePath]

72+ = PartOfCycle (Located ModuleName) [NormalizedFilePath]

73 -- ^ This module is part of an import cycle. The module name corresponds

74 -- to the import that enters the cycle starting from this module.

75 -- The list of filepaths represents the elements

@@ -94,10 +94,12 @@ instance NFData NodeError where

94-- `ErrorNode`. Otherwise it is a `SuccessNode`.

95data NodeResult

96 = ErrorNode (NonEmpty NodeError)

97− | SuccessNode [(Located ModuleName, FilePath)]

97+ | SuccessNode [(Located ModuleName, NormalizedFilePath)]

98 deriving Show

100+partitionNodeResults

101+ :: [(a, NodeResult)]

100−partitionNodeResults :: [(a, NodeResult)] -> ([(a, NonEmpty NodeError)], [(a, [(Located ModuleName, FilePath)])])

102+ -> ([(a, NonEmpty NodeError)], [(a, [(Located ModuleName, NormalizedFilePath)])])

101partitionNodeResults = partitionEithers . map f

103partitionNodeResults = partitionEithers . map f

102 where f (a, ErrorNode errs) = Left (a, errs)

104 where f (a, ErrorNode errs) = Left (a, errs)

103 f (a, SuccessNode imps) = Right (a, imps)

105 f (a, SuccessNode imps) = Right (a, imps)

@@ -116,7 +118,7 @@ processDependencyInformation rawResults =

116 , depPkgDeps = pkgDependencies rawResults

118 , depPkgDeps = pkgDependencies rawResults

117 }

119 }

118 where resultGraph = buildResultGraph rawResults

120 where resultGraph = buildResultGraph rawResults

119− successEdges :: [(FilePath, FilePath, [FilePath])]

121+ successEdges :: [(NormalizedFilePath, NormalizedFilePath, [NormalizedFilePath])]

120 successEdges = map (\(k,ks) -> (k,k,ks)) $ MS.toList $

122 successEdges = map (\(k,ks) -> (k,k,ks)) $ MS.toList $

121 MS.map (map snd) $ MS.mapMaybe successNode resultGraph

123 MS.map (map snd) $ MS.mapMaybe successNode resultGraph

122 moduleDeps =

124 moduleDeps =

@@ -131,22 +133,22 @@ processDependencyInformation rawResults =

131-- 2. Mark each node that has a parse error as an error node.

133-- 2. Mark each node that has a parse error as an error node.

132-- 3. Mark each node whose immediate children could not be located as an error.

134-- 3. Mark each node whose immediate children could not be located as an error.

133-- 4. Recursively propagate errors to parents if they are not already error nodes.

135-- 4. Recursively propagate errors to parents if they are not already error nodes.

134−buildResultGraph :: RawDependencyInformation -> Map FilePath NodeResult

136+buildResultGraph :: RawDependencyInformation -> Map NormalizedFilePath NodeResult

135buildResultGraph g = propagatedErrors

137buildResultGraph g = propagatedErrors

136 where

138 where

137 sccs = stronglyConnComp (graphEdges g)

139 sccs = stronglyConnComp (graphEdges g)

138 (_, cycles) = partitionSCC sccs

140 (_, cycles) = partitionSCC sccs

139− cycleErrors :: Map FilePath NodeResult

141+ cycleErrors :: Map NormalizedFilePath NodeResult

140 cycleErrors = MS.unionsWith (<>) $ map errorsForCycle cycles

142 cycleErrors = MS.unionsWith (<>) $ map errorsForCycle cycles

141− errorsForCycle :: [FilePath] -> Map FilePath NodeResult

143+ errorsForCycle :: [NormalizedFilePath] -> Map NormalizedFilePath NodeResult

142 errorsForCycle files =

144 errorsForCycle files =

143 MS.fromListWith (<>) (concatMap (cycleErrorsForFile files) files)

145 MS.fromListWith (<>) (concatMap (cycleErrorsForFile files) files)

144− cycleErrorsForFile :: [FilePath] -> FilePath -> [(FilePath,NodeResult)]

146+ cycleErrorsForFile :: [NormalizedFilePath] -> NormalizedFilePath -> [(NormalizedFilePath,NodeResult)]

145 cycleErrorsForFile cycle f =

147 cycleErrorsForFile cycle f =

146 let entryPoints = mapMaybe (findImport f) cycle

148 let entryPoints = mapMaybe (findImport f) cycle

147 in map (\imp -> (f, ErrorNode (PartOfCycle imp cycle :| []))) entryPoints

149 in map (\imp -> (f, ErrorNode (PartOfCycle imp cycle :| []))) entryPoints

148 otherErrors = MS.map otherErrorsForFile (moduleDependencies g)

150 otherErrors = MS.map otherErrorsForFile (moduleDependencies g)

149− otherErrorsForFile :: Either ModuleParseError [(Located ModuleName, Maybe FilePath)] -> NodeResult

151+ otherErrorsForFile :: Either ModuleParseError [(Located ModuleName, Maybe NormalizedFilePath)] -> NodeResult

150 otherErrorsForFile (Left err) = ErrorNode (ParseError err :| [])

152 otherErrorsForFile (Left err) = ErrorNode (ParseError err :| [])

151 otherErrorsForFile (Right imports) =

153 otherErrorsForFile (Right imports) =

152 let toEither (imp, Nothing) = Left imp

154 let toEither (imp, Nothing) = Left imp

@@ -171,17 +173,17 @@ buildResultGraph g = propagatedErrors

171 in case nonEmpty errs of

173 in case nonEmpty errs of

172 Nothing -> n

174 Nothing -> n

173 Just errs' -> ErrorNode (NonEmpty.map (ParentOfErrorNode . fst) errs')

175 Just errs' -> ErrorNode (NonEmpty.map (ParentOfErrorNode . fst) errs')

174− findImport :: FilePath -> FilePath -> Maybe (Located ModuleName)

176+ findImport :: NormalizedFilePath -> NormalizedFilePath -> Maybe (Located ModuleName)

175 findImport file importedFile =

177 findImport file importedFile =

176 case moduleDependencies g MS.! file of

178 case moduleDependencies g MS.! file of

177 Left _ -> error "Tried to call findImport on a module with a parse error"

179 Left _ -> error "Tried to call findImport on a module with a parse error"

178 Right imports ->

180 Right imports ->

179 fmap fst $ find (\(_, resolvedImp) -> resolvedImp == Just importedFile) imports

181 fmap fst $ find (\(_, resolvedImp) -> resolvedImp == Just importedFile) imports

180

182

181−graphEdges :: RawDependencyInformation -> [(FilePath, FilePath, [FilePath])]

183+graphEdges :: RawDependencyInformation -> [(NormalizedFilePath, NormalizedFilePath, [NormalizedFilePath])]

182graphEdges g =

184graphEdges g =

183 map (\(k, ks) -> (k, k, ks)) $ MS.toList $ MS.map deps $ moduleDependencies g

185 map (\(k, ks) -> (k, k, ks)) $ MS.toList $ MS.map deps $ moduleDependencies g

184− where deps :: Either e [(i, Maybe FilePath)] -> [FilePath]

186+ where deps :: Either e [(i, Maybe NormalizedFilePath)] -> [NormalizedFilePath]

185 deps (Left _) = []

187 deps (Left _) = []

186 deps (Right imports) = mapMaybe snd imports

188 deps (Right imports) = mapMaybe snd imports

187

189

@@ -190,17 +192,17 @@ partitionSCC (CyclicSCC xs:rest) = second (xs:) $ partitionSCC rest

190partitionSCC (AcyclicSCC x:rest) = first (x:) $ partitionSCC rest

192partitionSCC (AcyclicSCC x:rest) = first (x:) $ partitionSCC rest

191partitionSCC [] = ([], [])

193partitionSCC [] = ([], [])

192

194

193−transitiveDeps :: DependencyInformation -> FilePath -> Maybe TransitiveDependencies

195+transitiveDeps :: DependencyInformation -> NormalizedFilePath -> Maybe TransitiveDependencies

194transitiveDeps DependencyInformation{..} f = do

196transitiveDeps DependencyInformation{..} f = do

195 reachableVs <- Set.delete f . Set.fromList . map (fst3 . fromVertex) . reachable g <$> toVertex f

197 reachableVs <- Set.delete f . Set.fromList . map (fst3 . fromVertex) . reachable g <$> toVertex f

196 let transitiveModuleDeps = filter (\v -> v `Set.member` reachableVs) $ map (fst3 . fromVertex) vs

198 let transitiveModuleDeps = filter (\v -> v `Set.member` reachableVs) $ map (fst3 . fromVertex) vs

197 let transitivePkgDeps = Set.toList $ foldMap (\f -> MS.findWithDefault Set.empty f depPkgDeps) (f : transitiveModuleDeps)

199 let transitivePkgDeps = Set.toList $ foldMap (\f -> MS.findWithDefault Set.empty f depPkgDeps) (f : transitiveModuleDeps)

198− pure $ TransitiveDependencies {..}

200+ pure TransitiveDependencies {..}

199 where (g, fromVertex, toVertex) = graphFromEdges (map (\(f, fs) -> (f, f, Set.toList fs)) $ MS.toList depModuleDeps)

201 where (g, fromVertex, toVertex) = graphFromEdges (map (\(f, fs) -> (f, f, Set.toList fs)) $ MS.toList depModuleDeps)

200 vs = topSort g

202 vs = topSort g

201

203

202data TransitiveDependencies = TransitiveDependencies

204data TransitiveDependencies = TransitiveDependencies

203− { transitiveModuleDeps :: [FilePath]

205+ { transitiveModuleDeps :: [NormalizedFilePath]

204 -- ^ Transitive module dependencies in topological order.

206 -- ^ Transitive module dependencies in topological order.

205 -- The module itself is not included.

207 -- The module itself is not included.

206 , transitivePkgDeps :: [InstalledUnitId]

208 , transitivePkgDeps :: [InstalledUnitId]

src/Development/IDE/Functions/FindImports.hs+6−5

@@ -11,6 +11,7 @@ module Development.IDE.Functions.FindImports

12import Development.IDE.Functions.GHCError as ErrUtils

13import Development.IDE.Orphans()

14+import Development.IDE.Types.Diagnostics

14-- GHC imports

15-- GHC imports

15import BasicTypes (StringLiteral(..))

16import BasicTypes (StringLiteral(..))

16import DynFlags

17import DynFlags

@@ -30,7 +31,7 @@ import qualified Control.Monad.Trans.Except as Ex

30import System.FilePath

31import System.FilePath

32data Import

33data Import

33− = FileImport FilePath

34+ = FileImport NormalizedFilePath

34 | PackageImport M.InstalledUnitId

35 | PackageImport M.InstalledUnitId

35 deriving (Show)

36 deriving (Show)

@@ -67,11 +68,11 @@ getImportsParsed dflags (L loc parsed) = do

67locateModuleFile :: MonadIO m

68locateModuleFile :: MonadIO m

68 => DynFlags

69 => DynFlags

69 -> [String]

70 -> [String]

70− -> (FilePath -> m Bool)

71+ -> (NormalizedFilePath -> m Bool)

71 -> ModuleName

72 -> ModuleName

72− -> m (Maybe FilePath)

73+ -> m (Maybe NormalizedFilePath)

73locateModuleFile dflags exts doesExist modName = do

74locateModuleFile dflags exts doesExist modName = do

74− let candidates = [ prefix </> M.moduleNameSlashes modName <.> ext | prefix <- importPaths dflags, ext <- exts]

75+ let candidates = [ toNormalizedFilePath (prefix </> M.moduleNameSlashes modName <.> ext) | prefix <- importPaths dflags, ext <- exts]

75 findM doesExist candidates

76 findM doesExist candidates

77-- | locate a module in either the file system or the package database. Where we go from *daml to

78-- | locate a module in either the file system or the package database. Where we go from *daml to

@@ -80,7 +81,7 @@ locateModule

80 :: MonadIO m

81 :: MonadIO m

81 => DynFlags

82 => DynFlags

82 -> [String]

83 -> [String]

83− -> (FilePath -> m Bool)

84+ -> (NormalizedFilePath -> m Bool)

84 -> Located ModuleName

85 -> Located ModuleName

85 -> Maybe FastString

86 -> Maybe FastString

86 -> m (Either [FileDiagnostic] Import)

87 -> m (Either [FileDiagnostic] Import)

src/Development/IDE/Functions/GHCError.hs+2−2

@@ -50,7 +50,7 @@ mkDiag dflags src e =

50 case toDSeverity $ errMsgSeverity e of

51 Nothing -> Nothing

52 Just bSeverity ->

53− Just $ (srcSpanToFilename $ errMsgSpan e,)

53+ Just $ (toNormalizedFilePath $ srcSpanToFilename (errMsgSpan e),)

54 Diagnostic

55 { _range = srcSpanToRange $ errMsgSpan e

56 , _severity = Just bSeverity

@@ -78,7 +78,7 @@ srcSpanToFilename (RealSrcSpan real) = FS.unpackFS $ srcSpanFile real

79srcSpanToLocation :: SrcSpan -> Location

80srcSpanToLocation src =

81− Location (fromNormalizedUri $ D.filePathToUri' $ srcSpanToFilename src) (srcSpanToRange src)

81+ Location (filePathToUri $ srcSpanToFilename src) (srcSpanToRange src)

83-- | Convert a GHC severity to a DAML compiler Severity. Severities below

84-- "Warning" level are dropped (returning Nothing).

src/Development/IDE/Functions/SpanInfo.hs+7−6

@@ -21,6 +21,7 @@ import Desugar

21import GHC

22import GhcMonad

23import FastString (mkFastString)

24+import Development.IDE.Types.Diagnostics

24import Development.IDE.Types.SpanInfo

25import Development.IDE.Types.SpanInfo

25import Development.IDE.Functions.GHCError (zeroSpan)

26import Development.IDE.Functions.GHCError (zeroSpan)

26import Prelude hiding (mod)

27import Prelude hiding (mod)

@@ -29,7 +30,7 @@ import Var

30-- | Get ALL source spans in the module.

31-- | Get ALL source spans in the module.

31getSpanInfo :: GhcMonad m

32getSpanInfo :: GhcMonad m

32− => [(Located ModuleName, Maybe FilePath)] -- ^ imports

33+ => [(Located ModuleName, Maybe NormalizedFilePath)] -- ^ imports

33 -> TypecheckedModule

34 -> TypecheckedModule

34 -> m [SpanInfo]

35 -> m [SpanInfo]

35getSpanInfo mods tcm =

36getSpanInfo mods tcm =

@@ -94,17 +95,17 @@ getTypeLPat _ pat =

94 (Named (dataConName dc), spn)

95 (Named (dataConName dc), spn)

95 getSpanSource _ = (NoSource, noSrcSpan)

96 getSpanSource _ = (NoSource, noSrcSpan)

97−importInfo :: [(Located ModuleName, Maybe FilePath)]

98+importInfo :: [(Located ModuleName, Maybe NormalizedFilePath)]

98 -> [(SpanSource, SrcSpan, Maybe Type)]

99 -> [(SpanSource, SrcSpan, Maybe Type)]

99importInfo = mapMaybe (uncurry wrk) where

100importInfo = mapMaybe (uncurry wrk) where

100− wrk :: Located ModuleName -> Maybe FilePath -> Maybe (SpanSource, SrcSpan, Maybe Type)

101+ wrk :: Located ModuleName -> Maybe NormalizedFilePath -> Maybe (SpanSource, SrcSpan, Maybe Type)

101 wrk modName = \case

102 wrk modName = \case

102 Nothing -> Nothing

103 Nothing -> Nothing

103− Just afp -> Just (afpToSpanSource afp, getLoc modName, Nothing)

104+ Just fp -> Just (fpToSpanSource $ fromNormalizedFilePath fp, getLoc modName, Nothing)

104

105

105 -- TODO make this point to the module name

106 -- TODO make this point to the module name

106− afpToSpanSource :: FilePath -> SpanSource

107+ fpToSpanSource :: FilePath -> SpanSource

107− afpToSpanSource afp = Span $ RealSrcSpan $ zeroSpan $ mkFastString afp

108+ fpToSpanSource fp = Span $ RealSrcSpan $ zeroSpan $ mkFastString fp

108

109

109-- | Get ALL source spans in the source.

110-- | Get ALL source spans in the source.

110listifyAllSpans :: Typeable a

111listifyAllSpans :: Typeable a

src/Development/IDE/State/FileStore.hs+10−8

@@ -97,7 +97,7 @@ getFileExistsRule vfs =

97 alwaysRerun

98 res <- liftIO $ handle (\(_ :: IOException) -> return False) $

99 (isJust <$> getVirtualFile vfs (filePathToUri' file)) ||^

100− Dir.doesFileExist file

100+ Dir.doesFileExist (fromNormalizedFilePath file)

101 return (Just $ if res then BS.singleton '1' else BS.empty, ([], Just res))

102

103

@@ -107,14 +107,16 @@ showTimePrecise UTCTime{..} = show (toModifiedJulianDay utctDay, diffTimeToPicos

107getModificationTimeRule :: VFSHandle -> Rules ()

108getModificationTimeRule vfs =

109 defineEarlyCutoff $ \GetModificationTime file -> do

110+ let file' = fromNormalizedFilePath file

110 let wrap time = (Just $ BS.pack $ showTimePrecise time, ([], Just $ ModificationTime time))

111 let wrap time = (Just $ BS.pack $ showTimePrecise time, ([], Just $ ModificationTime time))

111 alwaysRerun

112 alwaysRerun

112 mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file

113 mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file

113 case mbVirtual of

114 case mbVirtual of

114 Just (VirtualFile ver _ _) -> pure (Just $ BS.pack $ show ver, ([], Just $ VFSVersion ver))

115 Just (VirtualFile ver _ _) -> pure (Just $ BS.pack $ show ver, ([], Just $ VFSVersion ver))

115− Nothing -> liftIO $ fmap wrap (Dir.getModificationTime file) `catch` \(e :: IOException) -> do

116+ Nothing -> liftIO $ fmap wrap (Dir.getModificationTime file')

117+ `catch` \(e :: IOException) -> do

116− let err | isDoesNotExistError e = "File does not exist: " ++ file

118+ let err | isDoesNotExistError e = "File does not exist: " ++ file'

117− | otherwise = "IO error while reading " ++ file ++ ", " ++ displayException e

119+ | otherwise = "IO error while reading " ++ file' ++ ", " ++ displayException e

118 return (Nothing, ([ideErrorText file $ T.pack err], Nothing))

120 return (Nothing, ([ideErrorText file $ T.pack err], Nothing))

119

121

120

122

@@ -127,16 +129,16 @@ getFileContentsRule vfs =

127 mbVirtual <- getVirtualFile vfs $ filePathToUri' file

129 mbVirtual <- getVirtualFile vfs $ filePathToUri' file

128 case mbVirtual of

130 case mbVirtual of

129 Just (VirtualFile _ rope _) -> return $ textToStringBuffer $ Rope.toText rope

131 Just (VirtualFile _ rope _) -> return $ textToStringBuffer $ Rope.toText rope

130− Nothing -> hGetStringBuffer file

132+ Nothing -> hGetStringBuffer (fromNormalizedFilePath file)

131 case res of

133 case res of

132 Left err -> return ([err], Nothing)

134 Left err -> return ([err], Nothing)

133 Right contents -> return ([], Just (time, contents))

135 Right contents -> return ([], Just (time, contents))

134

136

135

137

136−getFileContents :: FilePath -> Action (FileVersion, StringBuffer)

138+getFileContents :: NormalizedFilePath -> Action (FileVersion, StringBuffer)

137getFileContents = use_ GetFileContents

139getFileContents = use_ GetFileContents

138

140

139−getFileExists :: FilePath -> Action Bool

141+getFileExists :: NormalizedFilePath -> Action Bool

140getFileExists =

142getFileExists =

141 -- we deliberately and intentionally wrap the file as an FilePath WITHOUT mkAbsolute

143 -- we deliberately and intentionally wrap the file as an FilePath WITHOUT mkAbsolute

142 -- so that if the file doesn't exist, is on a shared drive that is unmounted etc we get a properly

144 -- so that if the file doesn't exist, is on a shared drive that is unmounted etc we get a properly

@@ -153,7 +155,7 @@ fileStoreRules vfs = do

153

155

154

156

155-- | Notify the compiler service of a modified buffer

157-- | Notify the compiler service of a modified buffer

156−setBufferModified :: IdeState -> FilePath -> Maybe T.Text -> IO ()

158+setBufferModified :: IdeState -> NormalizedFilePath -> Maybe T.Text -> IO ()

157setBufferModified state absFile mbContents = do

159setBufferModified state absFile mbContents = do

158 VFSHandle{..} <- getIdeGlobalState state

160 VFSHandle{..} <- getIdeGlobalState state

159 case mbContents of

161 case mbContents of

src/Development/IDE/State/Rules.hs+17−20

@@ -74,41 +74,38 @@ defineNoFile f = define $ \k file -> do

76-- | Get GHC Core for the supplied file.

77−getGhcCore :: FilePath -> Action (Maybe [CoreModule])

77+getGhcCore :: NormalizedFilePath -> Action (Maybe [CoreModule])

78getGhcCore file = eitherToMaybe <$> runExceptT (coresForFile file)

80-- | Generate the GHC Core for the supplied file and its dependencies.

81−coresForFile :: FilePath -> ExceptT [FileDiagnostic] Action [CoreModule]

81+coresForFile :: NormalizedFilePath -> ExceptT [FileDiagnostic] Action [CoreModule]

82coresForFile file = do

83 files <- transitiveModuleDeps <$> useE GetDependencies file

84 pms <- usesE GetParsedModule $ files ++ [file]

85− fs <- liftIO

86− . mapM fileFromParsedModule

87− $ pms

88− cores <- usesE GenerateCore fs

85+ cores <- usesE GenerateCore $ map fileFromParsedModule pms

89 pure (map Compile.gmCore cores)

86 pure (map Compile.gmCore cores)

93-- | Get all transitive file dependencies of a given module.

90-- | Get all transitive file dependencies of a given module.

94-- Does not include the file itself.

91-- Does not include the file itself.

95−getDependencies :: FilePath -> Action (Maybe [FilePath])

92+getDependencies :: NormalizedFilePath -> Action (Maybe [NormalizedFilePath])

96getDependencies file =

93getDependencies file =

97 eitherToMaybe <$>

94 eitherToMaybe <$>

98 (runExceptT $ transitiveModuleDeps <$> useE GetDependencies file)

95 (runExceptT $ transitiveModuleDeps <$> useE GetDependencies file)

100−getDalfDependencies :: FilePath -> Action (Maybe [InstalledUnitId])

97+getDalfDependencies :: NormalizedFilePath -> Action (Maybe [InstalledUnitId])

101getDalfDependencies file =

98getDalfDependencies file =

102 eitherToMaybe <$>

99 eitherToMaybe <$>

103 (runExceptT $ transitivePkgDeps <$> useE GetDependencies file)

100 (runExceptT $ transitivePkgDeps <$> useE GetDependencies file)

104

101

105-- | Documentation at point.

102-- | Documentation at point.

106−getAtPoint :: FilePath -> Position -> Action (Maybe (Maybe Range, [HoverText]))

103+getAtPoint :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [HoverText]))

107getAtPoint file pos = do

104getAtPoint file pos = do

108 fmap (either (const Nothing) id) . runExceptT $ getAtPointForFile file pos

105 fmap (either (const Nothing) id) . runExceptT $ getAtPointForFile file pos

109

106

110-- | Goto Definition.

107-- | Goto Definition.

111−getDefinition :: FilePath -> Position -> Action (Maybe Location)

108+getDefinition :: NormalizedFilePath -> Position -> Action (Maybe Location)

112getDefinition file pos = do

109getDefinition file pos = do

113 fmap (either (const Nothing) id) . runExceptT $ getDefinitionForFile file pos

110 fmap (either (const Nothing) id) . runExceptT $ getDefinitionForFile file pos

114

111

@@ -118,18 +115,18 @@ getDefinition file pos = do

118

115

119useE

116useE

120 :: IdeRule k v

117 :: IdeRule k v

121− => k -> FilePath -> ExceptT [FileDiagnostic] Action v

118+ => k -> NormalizedFilePath -> ExceptT [FileDiagnostic] Action v

122useE k = ExceptT . fmap toIdeResultSilent . use k

119useE k = ExceptT . fmap toIdeResultSilent . use k

123

120

124-- picks the first error

121-- picks the first error

125usesE

122usesE

126 :: IdeRule k v

123 :: IdeRule k v

127− => k -> [FilePath] -> ExceptT [FileDiagnostic] Action [v]

124+ => k -> [NormalizedFilePath] -> ExceptT [FileDiagnostic] Action [v]

128usesE k = ExceptT . fmap (mapM toIdeResultSilent) . uses k

125usesE k = ExceptT . fmap (mapM toIdeResultSilent) . uses k

129

126

130-- | Try to get hover text for the name under point.

127-- | Try to get hover text for the name under point.

131getAtPointForFile

128getAtPointForFile

132− :: FilePath

129+ :: NormalizedFilePath

133 -> Position

130 -> Position

134 -> ExceptT [FileDiagnostic] Action (Maybe (Maybe Range, [HoverText]))

131 -> ExceptT [FileDiagnostic] Action (Maybe (Maybe Range, [HoverText]))

135getAtPointForFile file pos = do

132getAtPointForFile file pos = do

@@ -138,7 +135,7 @@ getAtPointForFile file pos = do

138 spans <- useE GetSpanInfo file

135 spans <- useE GetSpanInfo file

139 return $ AtPoint.atPoint (map Compile.tmrModule tms) spans pos

136 return $ AtPoint.atPoint (map Compile.tmrModule tms) spans pos

140

137

141−getDefinitionForFile :: FilePath -> Position -> ExceptT [FileDiagnostic] Action (Maybe Location)

138+getDefinitionForFile :: NormalizedFilePath -> Position -> ExceptT [FileDiagnostic] Action (Maybe Location)

142getDefinitionForFile file pos = do

139getDefinitionForFile file pos = do

143 spans <- useE GetSpanInfo file

140 spans <- useE GetSpanInfo file

144 pkgState <- useE GhcSession ""

141 pkgState <- useE GhcSession ""

@@ -167,7 +164,7 @@ getParsedModuleRule =

167 (_, contents) <- getFileContents file

164 (_, contents) <- getFileContents file

168 packageState <- use_ GhcSession ""

165 packageState <- use_ GhcSession ""

169 opt <- getOpts

166 opt <- getOpts

170− liftIO $ Compile.parseModule opt packageState file contents

167+ liftIO $ Compile.parseModule opt packageState (fromNormalizedFilePath file) contents

171

168

172getLocatedImportsRule :: Rules ()

169getLocatedImportsRule :: Rules ()

173getLocatedImportsRule =

170getLocatedImportsRule =

@@ -185,7 +182,7 @@ getLocatedImportsRule =

185

182

186-- | Given a target file path, construct the raw dependency results by following

183-- | Given a target file path, construct the raw dependency results by following

187-- imports recursively.

184-- imports recursively.

188−rawDependencyInformation :: FilePath -> ExceptT [FileDiagnostic] Action RawDependencyInformation

185+rawDependencyInformation :: NormalizedFilePath -> ExceptT [FileDiagnostic] Action RawDependencyInformation

189rawDependencyInformation f = go (Set.singleton f) Map.empty Map.empty

186rawDependencyInformation f = go (Set.singleton f) Map.empty Map.empty

190 where go fs !modGraph !pkgs =

187 where go fs !modGraph !pkgs =

191 case Set.minView fs of

188 case Set.minView fs of

@@ -242,7 +239,7 @@ reportImportCyclesRule =

242 , _relatedInformation = Nothing

239 , _relatedInformation = Nothing

243 }

240 }

244 where loc = srcSpanToLocation (getLoc imp)

241 where loc = srcSpanToLocation (getLoc imp)

245− fp = srcSpanToFilename (getLoc imp)

242+ fp = toNormalizedFilePath $ srcSpanToFilename (getLoc imp)

246 getModuleName file = do

243 getModuleName file = do

247 pm <- useE GetParsedModule file

244 pm <- useE GetParsedModule file

248 pure (moduleNameString . moduleName . ms_mod $ pm_mod_summary pm)

245 pure (moduleNameString . moduleName . ms_mod $ pm_mod_summary pm)

@@ -324,12 +321,12 @@ mainRule = do

324

321

325------------------------------------------------------------

322------------------------------------------------------------

326

323

327−fileFromParsedModule :: ParsedModule -> IO FilePath

324+fileFromParsedModule :: ParsedModule -> NormalizedFilePath

328−fileFromParsedModule = pure . ms_hspp_file . pm_mod_summary

325+fileFromParsedModule = toNormalizedFilePath . ms_hspp_file . pm_mod_summary

329

326

330fileImports ::

327fileImports ::

331 [(Located ModuleName, Maybe Import)]

328 [(Located ModuleName, Maybe Import)]

332− -> [(Located ModuleName, Maybe FilePath)]

329+ -> [(Located ModuleName, Maybe NormalizedFilePath)]

333fileImports = mapMaybe $ \case

330fileImports = mapMaybe $ \case

334 (modName, Nothing) -> Just (modName, Nothing)

331 (modName, Nothing) -> Just (modName, Nothing)

335 (modName, Just (FileImport absFile)) -> Just (modName, Just absFile)

332 (modName, Just (FileImport absFile)) -> Just (modName, Just absFile)

src/Development/IDE/State/Service.hs+3−2

@@ -27,6 +27,7 @@ import qualified Development.IDE.Logger as Logger

27import Data.Set (Set)

28import qualified Data.Set as Set

29import Development.IDE.Functions.GHCError

30+import Development.IDE.Types.Diagnostics (NormalizedFilePath)

30import Development.Shake hiding (Diagnostic, Env, newCache)

31import Development.Shake hiding (Diagnostic, Env, newCache)

31import qualified Language.Haskell.LSP.Messages as LSP

32import qualified Language.Haskell.LSP.Messages as LSP

@@ -39,7 +40,7 @@ import Development.IDE.State.Shake

39data Env = Env

40data Env = Env

40 { envOptions :: IdeOptions

41 { envOptions :: IdeOptions

41 -- ^ Compiler options.

42 -- ^ Compiler options.

42− , envOfInterestVar :: Var (Set FilePath)

43+ , envOfInterestVar :: Var (Set NormalizedFilePath)

43 -- ^ The files of interest.

44 -- ^ The files of interest.

44 , envUniqSupplyVar :: Var UniqSupply

45 , envUniqSupplyVar :: Var UniqSupply

45 -- ^ The unique supply of names used by the compiler.

46 -- ^ The unique supply of names used by the compiler.

@@ -107,7 +108,7 @@ runActions x = join . shakeRun x

107

108

109

109-- | Set the files-of-interest which will be built and kept-up-to-date.

110-- | Set the files-of-interest which will be built and kept-up-to-date.

110−setFilesOfInterest :: IdeState -> Set FilePath -> IO ()

111+setFilesOfInterest :: IdeState -> Set NormalizedFilePath -> IO ()

111setFilesOfInterest state files = do

112setFilesOfInterest state files = do

112 Env{..} <- getIdeGlobalState state

113 Env{..} <- getIdeGlobalState state

113 -- update vars synchronously

114 -- update vars synchronously

src/Development/IDE/State/Shake.hs+16−16

@@ -119,7 +119,7 @@ getIdeGlobalState = getIdeGlobalExtras . shakeExtras

119

120

121-- | The state of the all values - nested so you can easily find all errors at a given file.

122−type Values = Map.HashMap (FilePath, Key) (Maybe Dynamic)

122+type Values = Map.HashMap (NormalizedFilePath, Key) (Maybe Dynamic)

123

124-- | Key type

125data Key = forall k . (Typeable k, Hashable k, Eq k, Show k) => Key k

@@ -195,7 +195,7 @@ profileCounter = unsafePerformIO $ newVar 0

195setValues :: IdeRule k v

196 => Var Values

197 -> k

198− -> FilePath

198+ -> NormalizedFilePath

199 -> Maybe v

200 -> IO ()

201setValues state key file val = modifyVar_ state $

@@ -204,7 +204,7 @@ setValues state key file val = modifyVar_ state $

204-- | The outer Maybe is Nothing if this function hasn't been computed before

205-- the inner Maybe is Nothing if the result of the previous computation failed to produce

206-- a value

207−getValues :: forall k v. IdeRule k v => Var Values -> k -> FilePath -> IO (Maybe (Maybe v))

207+getValues :: forall k v. IdeRule k v => Var Values -> k -> NormalizedFilePath -> IO (Maybe (Maybe v))

208getValues state key file = do

209 vs <- readVar state

210 return $ do

@@ -255,7 +255,7 @@ shakeRun IdeState{shakeExtras=ShakeExtras{..}, ..} acts = modifyVar shakeAbort $

255-- | Use the last stale value, if it's ever been computed.

256useStale

257 :: IdeRule k v

258− => IdeState -> k -> FilePath -> IO (Maybe v)

258+ => IdeState -> k -> NormalizedFilePath -> IO (Maybe v)

259useStale IdeState{shakeExtras=ShakeExtras{state}} k fp =

260 join <$> getValues state k fp

261

@@ -271,7 +271,7 @@ unsafeClearAllDiagnostics IdeState{shakeExtras = ShakeExtras{diagnostics}} =

271 writeVar diagnostics emptyDiagnostics

272

273-- | Clear the results for all files that do not match the given predicate.

274−garbageCollect :: (FilePath -> Bool) -> Action ()

274+garbageCollect :: (NormalizedFilePath -> Bool) -> Action ()

275garbageCollect keep = do

276 ShakeExtras{state, diagnostics} <- getShakeExtras

277 liftIO $

@@ -280,17 +280,17 @@ garbageCollect keep = do

280

281define

282 :: IdeRule k v

283− => (k -> FilePath -> Action (IdeResult v)) -> Rules ()

283+ => (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()

284define op = defineEarlyCutoff $ \k v -> (Nothing,) <$> op k v

285

286use :: IdeRule k v

287− => k -> FilePath -> Action (Maybe v)

287+ => k -> NormalizedFilePath -> Action (Maybe v)

288use key file = head <$> uses key [file]

289

290−use_ :: IdeRule k v => k -> FilePath -> Action v

290+use_ :: IdeRule k v => k -> NormalizedFilePath -> Action v

291use_ key file = head <$> uses_ key [file]

292

293−uses_ :: IdeRule k v => k -> [FilePath] -> Action [v]

293+uses_ :: IdeRule k v => k -> [NormalizedFilePath] -> Action [v]

294uses_ key files = do

295 res <- uses key files

296 case sequence res of

@@ -321,7 +321,7 @@ isBadDependency x

321 | otherwise = False

322

323

324−newtype Q k = Q (k, FilePath)

324+newtype Q k = Q (k, NormalizedFilePath)

325 deriving (Eq,Hashable,NFData)

326

327-- Using Database we don't need Binary instances for keys

@@ -330,7 +330,7 @@ instance Binary (Q k) where

330 get = fail "Binary.get not defined for type Development.IDE.State.Shake.Q"

331

332instance Show k => Show (Q k) where

333− show (Q (k, file)) = show k ++ "; " ++ file

333+ show (Q (k, file)) = show k ++ "; " ++ fromNormalizedFilePath file

334

335-- | Invariant: the 'v' must be in normal form (fully evaluated).

336-- Otherwise we keep repeatedly 'rnf'ing values taken from the Shake database

@@ -346,12 +346,12 @@ type instance RuleResult (Q k) = A (RuleResult k)

346

347-- | Compute the value

348uses :: IdeRule k v

349− => k -> [FilePath] -> Action [Maybe v]

349+ => k -> [NormalizedFilePath] -> Action [Maybe v]

350uses key files = map (\(A value _) -> value) <$> apply (map (Q . (key,)) files)

351

352defineEarlyCutoff

353 :: IdeRule k v

354− => (k -> FilePath -> Action (Maybe BS.ByteString, IdeResult v))

354+ => (k -> NormalizedFilePath -> Action (Maybe BS.ByteString, IdeResult v))

355 -> Rules ()

356defineEarlyCutoff op = addBuiltinRule noLint noIdentity $ \(Q (key, file)) old mode -> do

357 extras@ShakeExtras{state} <- getShakeExtras

@@ -383,7 +383,7 @@ defineEarlyCutoff op = addBuiltinRule noLint noIdentity $ \(Q (key, file)) old m

383 unwrap x = if BS.null x then Nothing else Just $ BS.tail x

384

385updateFileDiagnostics ::

386− FilePath

386+ NormalizedFilePath

387 -> Key

388 -> ShakeExtras

389 -> [Diagnostic] -- ^ current results

@@ -397,13 +397,13 @@ updateFileDiagnostics fp k ShakeExtras{diagnostics, state} current = do

397 let newDiags = getFileDiagnostics fp newDiagsStore

398 pure (newDiagsStore, (newDiags, oldDiags))

399 when (newDiags /= oldDiags) $

400− sendEvent $ publishDiagnosticsNotification fp newDiags

400+ sendEvent $ publishDiagnosticsNotification (fromNormalizedFilePath fp) newDiags

401

402publishDiagnosticsNotification :: FilePath -> [Diagnostic] -> LSP.FromServerMessage

403publishDiagnosticsNotification fp diags =

404 LSP.NotPublishDiagnostics $

405 LSP.NotificationMessage "2.0" LSP.TextDocumentPublishDiagnostics $

406− LSP.PublishDiagnosticsParams (fromNormalizedUri $ filePathToUri' fp) (List diags)

406+ LSP.PublishDiagnosticsParams (LSP.filePathToUri fp) (List diags)

407

408setPriority :: (Enum a) => a -> Action ()

409setPriority p =

src/Development/IDE/Types/Diagnostics.hs+46−16

@@ -21,6 +21,9 @@ module Development.IDE.Types.Diagnostics (

21 NormalizedUri,

22 LSP.toNormalizedUri,

23 LSP.fromNormalizedUri,

24+ NormalizedFilePath,

25+ toNormalizedFilePath,

26+ fromNormalizedFilePath,

24 noLocation,

27 noLocation,

25 noRange,

28 noRange,

26 noFilePath,

29 noFilePath,

@@ -31,6 +34,7 @@ module Development.IDE.Types.Diagnostics (

31 showDiagnostics,

34 showDiagnostics,

32 showDiagnosticsColored,

35 showDiagnosticsColored,

33 defDiagnostic,

36 defDiagnostic,

37+ filePathToUri,

34 filePathToUri',

38 filePathToUri',

35 uriToFilePath',

39 uriToFilePath',

36 ProjectDiagnostics,

40 ProjectDiagnostics,

@@ -42,14 +46,18 @@ module Development.IDE.Types.Diagnostics (

42 prettyDiagnostics

46 prettyDiagnostics

43 ) where

47 ) where

49+import Control.DeepSeq

45import Control.Exception

50import Control.Exception

46import Data.Either.Combinators

51import Data.Either.Combinators

47import Data.Maybe as Maybe

52import Data.Maybe as Maybe

48import Data.Foldable

53import Data.Foldable

54+import Data.Hashable

49import qualified Data.Map as Map

55import qualified Data.Map as Map

56+import Data.String

50import qualified Data.Text as T

57import qualified Data.Text as T

51import Data.Text.Prettyprint.Doc.Syntax

58import Data.Text.Prettyprint.Doc.Syntax

52import qualified Data.SortedList as SL

59import qualified Data.SortedList as SL

60+import System.FilePath

53import qualified Text.PrettyPrint.Annotated.HughesPJClass as Pretty

61import qualified Text.PrettyPrint.Annotated.HughesPJClass as Pretty

54import qualified Language.Haskell.LSP.Types as LSP

62import qualified Language.Haskell.LSP.Types as LSP

55import Language.Haskell.LSP.Types as LSP (

63import Language.Haskell.LSP.Types as LSP (

@@ -67,6 +75,26 @@ import Language.Haskell.LSP.Diagnostics

68import Development.IDE.Types.Location

76import Development.IDE.Types.Location

78+-- | Newtype wrapper around FilePath that always has normalized slashes.

79+newtype NormalizedFilePath = NormalizedFilePath FilePath

80+ deriving (Eq, Ord, Show, Hashable, NFData)

81+

82+instance IsString NormalizedFilePath where

83+ fromString = toNormalizedFilePath

84+

85+toNormalizedFilePath :: FilePath -> NormalizedFilePath

86+toNormalizedFilePath "" = NormalizedFilePath ""

87+toNormalizedFilePath fp = NormalizedFilePath $ normalise' fp

88+ where

89+ -- We do not use System.FilePath’s normalise here since that

90+ -- also normalises things like the case of the drive letter

91+ -- which NormalizedUri does not normalise so we get VFS lookup failures.

92+ normalise' :: FilePath -> FilePath

93+ normalise' = map (\c -> if isPathSeparator c then pathSeparator else c)

94+

95+fromNormalizedFilePath :: NormalizedFilePath -> FilePath

96+fromNormalizedFilePath (NormalizedFilePath fp) = fp

97+

70-- | We use an empty string as a filepath when we don’t have a file.

98-- | We use an empty string as a filepath when we don’t have a file.

71-- However, haskell-lsp doesn’t support that in uriToFilePath and given

99-- However, haskell-lsp doesn’t support that in uriToFilePath and given

72-- that it is not a valid filepath it does not make sense to upstream a fix.

100-- that it is not a valid filepath it does not make sense to upstream a fix.

@@ -76,16 +104,16 @@ uriToFilePath' uri

76 | uri == filePathToUri "" = Just ""

104 | uri == filePathToUri "" = Just ""

77 | otherwise = LSP.uriToFilePath uri

105 | otherwise = LSP.uriToFilePath uri

106

79−filePathToUri' :: FilePath -> NormalizedUri

107+filePathToUri' :: NormalizedFilePath -> NormalizedUri

80−filePathToUri' fp = toNormalizedUri $ filePathToUri fp

108+filePathToUri' = toNormalizedUri . filePathToUri . fromNormalizedFilePath

109

82−ideErrorText :: FilePath -> T.Text -> FileDiagnostic

110+ideErrorText :: NormalizedFilePath -> T.Text -> FileDiagnostic

83ideErrorText fp = errorDiag fp "Ide Error"

111ideErrorText fp = errorDiag fp "Ide Error"

112

85−ideErrorPretty :: Pretty.Pretty e => FilePath -> e -> FileDiagnostic

113+ideErrorPretty :: Pretty.Pretty e => NormalizedFilePath -> e -> FileDiagnostic

86ideErrorPretty fp = ideErrorText fp . T.pack . Pretty.prettyShow

114ideErrorPretty fp = ideErrorText fp . T.pack . Pretty.prettyShow

115

88−errorDiag :: FilePath -> T.Text -> T.Text -> FileDiagnostic

116+errorDiag :: NormalizedFilePath -> T.Text -> T.Text -> FileDiagnostic

89errorDiag fp src msg =

117errorDiag fp src msg =

90 (fp, diagnostic noRange LSP.DsError src msg)

118 (fp, diagnostic noRange LSP.DsError src msg)

119

@@ -119,9 +147,11 @@ defDiagnostic _range _message = LSP.Diagnostic {

119 , _relatedInformation = Nothing

147 , _relatedInformation = Nothing

120 }

148 }

121

149

122−ideTryIOException :: FilePath -> IO a -> IO (Either FileDiagnostic a)

150+ideTryIOException :: NormalizedFilePath -> IO a -> IO (Either FileDiagnostic a)

123ideTryIOException fp act =

151ideTryIOException fp act =

152+ mapLeft

124− mapLeft (\(e :: IOException) -> ideErrorText fp $ T.pack $ show e) <$> try act

153+ (\(e :: IOException) -> ideErrorText fp $ T.pack $ show e)

154+ <$> try act

125

155

126-- | Human readable diagnostics for a specific file.

156-- | Human readable diagnostics for a specific file.

127--

157--

@@ -129,8 +159,8 @@ ideTryIOException fp act =

129-- along with the related source location so that we can display the error

159-- along with the related source location so that we can display the error

130-- on either the console or in the IDE at the right source location.

160-- on either the console or in the IDE at the right source location.

131--

161--

132−type FileDiagnostics = (FilePath, [Diagnostic])

162+type FileDiagnostics = (NormalizedFilePath, [Diagnostic])

133−type FileDiagnostic = (FilePath, Diagnostic)

163+type FileDiagnostic = (NormalizedFilePath, Diagnostic)

134

164

135prettyRange :: Range -> Doc SyntaxClass

165prettyRange :: Range -> Doc SyntaxClass

136prettyRange Range{..} = f _start <> "-" <> f _end

166prettyRange Range{..} = f _start <> "-" <> f _end

@@ -152,7 +182,7 @@ prettyDiagnostics = vcat . map prettyDiagnostic

152prettyDiagnostic :: FileDiagnostic -> Doc SyntaxClass

182prettyDiagnostic :: FileDiagnostic -> Doc SyntaxClass

153prettyDiagnostic (fp, LSP.Diagnostic{..}) =

183prettyDiagnostic (fp, LSP.Diagnostic{..}) =

154 vcat

184 vcat

155− [ slabel_ "File: " $ pretty fp

185+ [ slabel_ "File: " $ pretty (fromNormalizedFilePath fp)

156 , slabel_ "Range: " $ prettyRange _range

186 , slabel_ "Range: " $ prettyRange _range

157 , slabel_ "Source: " $ pretty _source

187 , slabel_ "Source: " $ pretty _source

158 , slabel_ "Severity:" $ pretty $ show sev

188 , slabel_ "Severity:" $ pretty $ show sev

@@ -185,7 +215,7 @@ emptyDiagnostics = ProjectDiagnostics mempty

185-- if you want to clear the diagnostics call this with an empty list

215-- if you want to clear the diagnostics call this with an empty list

186setStageDiagnostics ::

216setStageDiagnostics ::

187 Show stage =>

217 Show stage =>

188− FilePath ->

218+ NormalizedFilePath ->

189 Maybe Int ->

219 Maybe Int ->

190 -- ^ the time that the file these diagnostics originate from was last edited

220 -- ^ the time that the file these diagnostics originate from was last edited

191 stage ->

221 stage ->

@@ -198,8 +228,8 @@ setStageDiagnostics fp timeM stage diags (ProjectDiagnostics ds) =

198 diagsBySource = Map.singleton (Just $ T.pack $ show stage) (SL.toSortedList diags)

228 diagsBySource = Map.singleton (Just $ T.pack $ show stage) (SL.toSortedList diags)

199 uri = filePathToUri' fp

229 uri = filePathToUri' fp

200

230

201−fromUri :: LSP.NormalizedUri -> FilePath

231+fromUri :: LSP.NormalizedUri -> NormalizedFilePath

202−fromUri = fromMaybe noFilePath . uriToFilePath' . fromNormalizedUri

232+fromUri = toNormalizedFilePath . fromMaybe noFilePath . uriToFilePath' . fromNormalizedUri

203

233

204getAllDiagnostics ::

234getAllDiagnostics ::

205 ProjectDiagnostics stage ->

235 ProjectDiagnostics stage ->

@@ -208,7 +238,7 @@ getAllDiagnostics =

208 concatMap (\(k,v) -> map (fromUri k,) $ getDiagnosticsFromStore v) . Map.toList . getStore

238 concatMap (\(k,v) -> map (fromUri k,) $ getDiagnosticsFromStore v) . Map.toList . getStore

209

239

210getFileDiagnostics ::

240getFileDiagnostics ::

211− FilePath ->

241+ NormalizedFilePath ->

212 ProjectDiagnostics stage ->

242 ProjectDiagnostics stage ->

213 [LSP.Diagnostic]

243 [LSP.Diagnostic]

214getFileDiagnostics fp ds =

244getFileDiagnostics fp ds =

@@ -217,10 +247,10 @@ getFileDiagnostics fp ds =

217 getStore ds

247 getStore ds

218

248

219filterDiagnostics ::

249filterDiagnostics ::

220− (FilePath -> Bool) ->

250+ (NormalizedFilePath -> Bool) ->

221 ProjectDiagnostics stage ->

251 ProjectDiagnostics stage ->

222 ProjectDiagnostics stage

252 ProjectDiagnostics stage

223filterDiagnostics keep =

253filterDiagnostics keep =

224 ProjectDiagnostics .

254 ProjectDiagnostics .

225− Map.filterWithKey (\uri _ -> maybe True keep $ uriToFilePath' $ fromNormalizedUri uri) .

255+ Map.filterWithKey (\uri _ -> maybe True (keep . toNormalizedFilePath) $ uriToFilePath' $ fromNormalizedUri uri) .

226 getStore

256 getStore

src/Development/IDE/Types/LSP.hs+3−3

@@ -10,7 +10,7 @@ module Development.IDE.Types.LSP

11import Control.DeepSeq

12import qualified Data.Text as T

13−import Development.IDE.Types.Diagnostics (uriToFilePath')

13+import Development.IDE.Types.Diagnostics

14import GHC.Generics

15import Language.Haskell.LSP.Messages

16import Language.Haskell.LSP.Types

@@ -30,9 +30,9 @@ getHoverTextContent = \case

31-- | Virtual resources

32data VirtualResource = VRScenario

33− { vrScenarioFile :: !FilePath

33+ { vrScenarioFile :: !NormalizedFilePath

34 , vrScenarioName :: !T.Text

35− } deriving (Eq, Ord, Read, Show, Generic)

35+ } deriving (Eq, Ord, Show, Generic)

36 -- ^ VRScenario identifies a scenario in a given file.

37 -- This virtual resource is associated with the HTML result of

38 -- interpreting the corresponding scenario.

test/Demo.hs+2−2

@@ -35,7 +35,7 @@ import GHC.Paths

36main :: IO ()

37main = do

38− (ghcOptions, files) <- getCmdLine

38+ (ghcOptions, map toNormalizedFilePath -> files) <- getCmdLine

40 -- lock to avoid overlapping output on stdout

41 lock <- newLock

@@ -66,7 +66,7 @@ main = do

66-- | Print an LSP event.

67showEvent :: Lock -> FromServerMessage -> IO ()

68showEvent _ (EventFileDiagnostics _ []) = return ()

69−showEvent lock (EventFileDiagnostics file diags) =

69+showEvent lock (EventFileDiagnostics (toNormalizedFilePath -> file) diags) =

70 withLock lock $ T.putStrLn $ showDiagnosticsColored $ map (file,) diags

71showEvent lock e = withLock lock $ print e