@@ -35,6 +35,8 @@ module Data.FileEmbed
3535 , injectFile
3636 , injectWith
3737 , injectFileWith
38+ -- * Relative path manipulation
39+ , makeRelativeToProject
3840 -- * Internal
3941 , stringToBs
4042 , bsToExp
@@ -50,12 +52,13 @@ import Language.Haskell.TH.Syntax
5052#endif
5153 , Q
5254 , runIO
55+ , qLocation, loc_filename
5356#if MIN_VERSION_template_haskell(2,7,0)
5457 , Quasi(qAddDependentFile)
5558#endif
5659 )
5760import System.Directory (doesDirectoryExist, doesFileExist,
58− getDirectoryContents)
61+ getDirectoryContents, canonicalizePath)
5962import Control.Exception (throw, ErrorCall(..))
6063import Control.Monad (filterM)
6164import qualified Data.ByteString as B
@@ -64,7 +67,7 @@ import Control.Arrow ((&&&), second)
6467import Control.Applicative ((<$>))
6568import Data.ByteString.Unsafe (unsafePackAddressLen)
6669import System.IO.Unsafe (unsafePerformIO)
67−import System.FilePath ((</>))
70+import System.FilePath ((</>), takeDirectory, takeExtension)
6871import Data.String (fromString)
6972import Prelude as P
7073
@@ -336,3 +339,42 @@ the magic key. If you know for certain that there will only be one dummy space
336339available, you can use the non-@With@ variants.
337340
338341-}
342+
343+-- | Take a relative file path and attach it to the root of the current
344+-- project.
345+--
346+-- The idea here is that, when building with Stack, the build will always be
347+-- executed with a current working directory of the root of the project (where
348+-- your .cabal file is located). However, if you load up multiple projects with
349+-- @stack ghci@, the working directory may be something else entirely.
350+--
351+-- This function looks at the source location of the Haskell file calling it,
352+-- finds the first parent directory with a .cabal file, and uses that as the
353+-- root directory for fixing the relative path.
354+--
355+-- @@@
356+-- $(makeRelativeToProject "data/foo.txt" >>= fileEmbed)
357+-- @@@
358+--
359+-- @since 0.0.10
360+makeRelativeToProject :: FilePath -> Q FilePath
361+makeRelativeToProject rel = do
362+ loc <- qLocation
363+ runIO $ do
364+ srcFP <- canonicalizePath $ loc_filename loc
365+ mdir <- findProjectDir srcFP
366+ case mdir of
367+ Nothing -> error $ "Could not find .cabal file for path: " ++ srcFP
368+ Just dir -> return $ dir </> rel
369+ where
370+ findProjectDir x = do
371+ let dir = takeDirectory x
372+ if dir == x
373+ then return Nothing
374+ else do
375+ contents <- getDirectoryContents dir
376+ if any isCabalFile contents
377+ then return (Just dir)
378+ else findProjectDir dir
379+
380+ isCabalFile fp = takeExtension fp == ".cabal"