abcf901 · typeable/file-embed

git.iko.soy/typeable/file-embed

on master help sign in

Add makeRelativeToProject (fixes #18)

abcf901Michael Snoyman10 years ago

ChangeLog.md+4

compare with master

unifiedsplit

@@ -1,3 +1,7 @@

1+## 0.0.10

3+* `makeRelativeToProject`

1## 0.0.9

5## 0.0.9

3* embedStringFile [#14](https://github.com/snoyberg/file-embed/pull/14)

7* embedStringFile [#14](https://github.com/snoyberg/file-embed/pull/14)

Data/FileEmbed.hs+44−2

@@ -35,6 +35,8 @@ module Data.FileEmbed

35 , injectFile

36 , injectWith

37 , injectFileWith

38+ -- * Relative path manipulation

39+ , makeRelativeToProject

38 -- * Internal

40 -- * Internal

39 , stringToBs

41 , stringToBs

40 , bsToExp

42 , bsToExp

@@ -50,12 +52,13 @@ import Language.Haskell.TH.Syntax

50#endif

52#endif

51 , Q

53 , Q

52 , runIO

54 , runIO

55+ , qLocation, loc_filename

53#if MIN_VERSION_template_haskell(2,7,0)

56#if MIN_VERSION_template_haskell(2,7,0)

54 , Quasi(qAddDependentFile)

57 , Quasi(qAddDependentFile)

55#endif

58#endif

56 )

59 )

57import System.Directory (doesDirectoryExist, doesFileExist,

60import System.Directory (doesDirectoryExist, doesFileExist,

58− getDirectoryContents)

61+ getDirectoryContents, canonicalizePath)

59import Control.Exception (throw, ErrorCall(..))

62import Control.Exception (throw, ErrorCall(..))

60import Control.Monad (filterM)

63import Control.Monad (filterM)

61import qualified Data.ByteString as B

64import qualified Data.ByteString as B

@@ -64,7 +67,7 @@ import Control.Arrow ((&&&), second)

64import Control.Applicative ((<$>))

67import Control.Applicative ((<$>))

65import Data.ByteString.Unsafe (unsafePackAddressLen)

68import Data.ByteString.Unsafe (unsafePackAddressLen)

66import System.IO.Unsafe (unsafePerformIO)

69import System.IO.Unsafe (unsafePerformIO)

67−import System.FilePath ((</>))

70+import System.FilePath ((</>), takeDirectory, takeExtension)

68import Data.String (fromString)

71import Data.String (fromString)

69import Prelude as P

72import Prelude as P

@@ -336,3 +339,42 @@ the magic key. If you know for certain that there will only be one dummy space

336available, you can use the non-@With@ variants.

339available, you can use the non-@With@ variants.

337

340

338-}

341-}

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"

file-embed.cabal+1−1

@@ -1,5 +1,5 @@

1name: file-embed

2−version: 0.0.9.1

2+version: 0.0.10

3license: BSD3

4license-file: LICENSE

5author: Michael Snoyman <michael@snoyman.com>