{-# LANGUAGE CPP             #-}
{-# LANGUAGE TemplateHaskell #-}

module Development.IDE.Graph.Internal.Paths (readDataFileHTML) where

#ifndef FILE_EMBED
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           Data.FileEmbed

htmlDataFiles :: [(FilePath, BS.ByteString)]
htmlDataFiles =
  [
#ifdef __GHCIDE__
    ("profile.html",  $(embedFile "hls-graph/html/profile.html"))
  , ("shake.js",      $(embedFile "hls-graph/html/shake.js"))
#else
    ("profile.html",  $(embedFile "html/profile.html"))
  , ("shake.js",      $(embedFile "html/shake.js"))
#endif
  ]

readDataFileHTML :: FilePath -> IO LBS.ByteString
readDataFileHTML file = do
    case lookup file htmlDataFiles of
      Nothing -> fail $ "Could not find data file " ++ file ++ " in embedded data files!"
      Just x  -> pure (LBS.fromStrict x)

#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.

{-# NOINLINE dataDirs #-}
dataDirs :: [String]
dataDirs :: [FilePath]
dataDirs = IO [FilePath] -> [FilePath]
forall a. IO a -> a
unsafePerformIO (IO [FilePath] -> [FilePath]) -> IO [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ do
    FilePath
datdir <- IO FilePath
getDataDir
    FilePath
exedir <- FilePath -> FilePath
takeDirectory (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getExecutablePath IO FilePath -> (SomeException -> IO FilePath) -> IO FilePath
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException{} -> FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
""
    FilePath
curdir <- IO FilePath
getCurrentDirectory
    [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath
datdir] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
exedir | FilePath
exedir FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
""] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
curdir]


getDataFile :: FilePath -> IO FilePath
getDataFile :: FilePath -> IO FilePath
getDataFile FilePath
file = do
    let poss :: [FilePath]
poss = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
</> FilePath
file) [FilePath]
dataDirs
    [FilePath]
res <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist [FilePath]
poss
    case [FilePath]
res of
        [] -> FilePath -> IO FilePath
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath
"Could not find data file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
", looked in:") FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"  " ++) [FilePath]
poss
        FilePath
x:[FilePath]
_ -> FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
x

readDataFileHTML :: FilePath -> IO LBS.ByteString
readDataFileHTML :: FilePath -> IO ByteString
readDataFileHTML FilePath
file = FilePath -> IO ByteString
LBS.readFile (FilePath -> IO ByteString) -> IO FilePath -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO FilePath
getDataFile (FilePath
"html" FilePath -> FilePath -> FilePath
</> FilePath
file)

#endif