haskell/haskell-language-server
1
1
Fork 0
mirror of https://github.com/haskell/haskell-language-server.git synced 2024-09-11 08:45:35 +03:00
Code Issues Projects Releases Wiki Activity

Fix hls-graph build with embed-files flag (#2395)

Browse Source 
* [hls-graph] fix build with embed-files flag

* bump hls-graph version number

* fix build without the flag too
This commit is contained in:
Pepe Iborra 2021-11-25 23:21:25 +00:00 committed by GitHub
parent 4b7d139773
commit bd0046b708
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 15 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hls-graph/hls-graph.cabal
View File

@ -1,6 +1,6 @@
cabal-version: 2.4
name: hls-graph
version: 1.5.1.0
version: 1.5.1.1
synopsis: Haskell Language Server internal graph API
description:
Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>

40
hls-graph/src/Development/IDE/Graph/Internal/Paths.hs
View File

@ -1,31 +1,26 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module Development.IDE.Graph.Internal.Paths (getDataFile) where
import Paths_hls_graph
module Development.IDE.Graph.Internal.Paths (readDataFileHTML) where
#ifndef FILE_EMBED
import Control.Exception (SomeException (SomeException), catch)
import Control.Monad (filterM)
import System.Directory (doesFileExist, getCurrentDirectory)
import System.Environment (getExecutablePath)
import System.FilePath (takeDirectory, (</>))
import System.IO.Unsafe (unsafePerformIO)
import Control.Exception (SomeException (SomeException), catch)
import Control.Monad (filterM)
import Paths_hls_graph
import System.Directory (doesFileExist, getCurrentDirectory)
import System.Environment (getExecutablePath)
import System.FilePath (takeDirectory, (</>))
import System.IO.Unsafe (unsafePerformIO)
#endif
import qualified Data.ByteString.Lazy as LBS
#ifdef FILE_EMBED
import qualified Data.ByteString as BS
import qualified Data.ByteString as LBS
import qualified Data.ByteString as BS
import Data.FileEmbed
initDataDirectory :: IO ()
initDataDirectory = pure ()
htmlDataFiles :: [(FilePath, BS.ByteString)]
htmlDataFiles =
[ ("profile.html", $(embedFile "html/profile.html"))
, ("progress.html", $(embedFile "html/progress.html"))
, ("shake.js", $(embedFile "html/shake.js"))
]
@ -35,18 +30,6 @@ readDataFileHTML file = do
Nothing -> fail $ "Could not find data file " ++ file ++ " in embedded data files!"
Just x -> pure (LBS.fromStrict x)
manualDirData :: [(FilePath, BS.ByteString)]
manualDirData = $(embedDir "docs/manual")
hasManualData :: IO Bool
hasManualData = pure True
copyManualData :: FilePath -> IO ()
copyManualData dest = do
createDirectoryRecursive dest
forM_ manualDirData $ \(file, bs) -> do
BS.writeFile (dest </> file) bs
#else
-- We want getDataFileName to be relative to the current directory on program startup,
-- even if we issue a change directory command. Therefore, first call caches, future ones read.
@ -68,4 +51,7 @@ getDataFile file = do
[] -> fail $ unlines $ ("Could not find data file " ++ file ++ ", looked in:") : map (" " ++) poss
x:_ -> pure x
readDataFileHTML :: FilePath -> IO LBS.ByteString
readDataFileHTML file = LBS.readFile =<< getDataFile ("html" </> file)
#endif

4
hls-graph/src/Development/IDE/Graph/Internal/Profile.hs
View File

@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
{- HLINT ignore "Redundant bracket" -} -- a result of CPP expansion
@ -135,9 +136,6 @@ toReport db = do
alwaysRerunResult :: Step -> Result
alwaysRerunResult current = Result (Value $ toDyn "<alwaysRerun>") (Step 0) (Step 0) current (ResultDeps []) 0 mempty
readDataFileHTML :: FilePath -> IO LBS.ByteString
readDataFileHTML file = LBS.readFile =<< getDataFile ("html" </> file)
generateHTML :: Maybe [Int] -> [ProfileEntry] -> IO LBS.ByteString
generateHTML dirtyKeys xs = do
report <- readDataFileHTML "profile.html"