Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Merged
merged 4 commits into from Nov 25, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
2 changes: 1 addition & 1 deletion hls-graph/hls-graph.cabal
@@ -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>
Expand Down
40 changes: 13 additions & 27 deletions hls-graph/src/Development/IDE/Graph/Internal/Paths.hs
@@ -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"))
]

Expand All @@ -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.
Expand All @@ -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 changes: 1 addition & 3 deletions hls-graph/src/Development/IDE/Graph/Internal/Profile.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

{- HLINT ignore "Redundant bracket" -} -- a result of CPP expansion
Expand Down Expand Up @@ -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"
Expand Down