@@ -19,8 +19,10 @@
19module Data.FileEmbed
19module Data.FileEmbed
20 ( -- * Embed at compile time
20 ( -- * Embed at compile time
22 , embedOneFileOf
23 , embedOneFileOf
23 , embedDir
24 , embedDir
25 -- * Embed as a IsString
27 -- * Embed as a IsString
26 , embedStringFile
28 , embedStringFile
@@ -37,6 +39,7 @@ module Data.FileEmbed
37 , injectFileWith
39 , injectFileWith
38 -- * Relative path manipulation
40 -- * Relative path manipulation
39 , makeRelativeToProject
41 , makeRelativeToProject
42+ , makeRelativeToLocationPredicate
40 -- * Internal
43 -- * Internal
41 , stringToBs
44 , stringToBs
@@ -45,11 +48,7 @@ module Data.FileEmbed
46import Language.Haskell.TH.Syntax
49import Language.Haskell.TH.Syntax
47 ( Exp (AppE, ListE, LitE, TupE, SigE, VarE)
50 ( Exp (AppE, ListE, LitE, TupE, SigE, VarE)
48−#if MIN_VERSION_template_haskell(2,5,0)
51+ , Lit (..)
49− , Lit (StringL, StringPrimL, IntegerL)
51− , Lit (StringL, IntegerL)
55 , qLocation, loc_filename
54 , qLocation, loc_filename
@@ -57,19 +56,26 @@ import Language.Haskell.TH.Syntax
57 , Quasi(qAddDependentFile)
56 , Quasi(qAddDependentFile)
59+#if MIN_VERSION_template_haskell(2,16,0)
60+import Language.Haskell.TH ( mkBytes, bytesPrimL )
61+import qualified Data.ByteString.Internal as B
60import System.Directory (doesDirectoryExist, doesFileExist,
63import System.Directory (doesDirectoryExist, doesFileExist,
61 getDirectoryContents, canonicalizePath)
64 getDirectoryContents, canonicalizePath)
62−import Control.Exception (throw, ErrorCall(..))
65+import Control.Exception (throw, tryJust, ErrorCall(..))
63−import Control.Monad (filterM)
66+import Control.Monad (filterM, guard)
64import qualified Data.ByteString as B
67import qualified Data.ByteString as B
65import qualified Data.ByteString.Char8 as B8
68import qualified Data.ByteString.Char8 as B8
66import Control.Arrow ((&&&), second)
69import Control.Arrow ((&&&), second)
67import Control.Applicative ((<$>))
70import Control.Applicative ((<$>))
68import Data.ByteString.Unsafe (unsafePackAddressLen)
71import Data.ByteString.Unsafe (unsafePackAddressLen)
72+import System.IO.Error (isDoesNotExistError)
69import System.IO.Unsafe (unsafePerformIO)
73import System.IO.Unsafe (unsafePerformIO)
70import System.FilePath ((</>), takeDirectory, takeExtension)
74import System.FilePath ((</>), takeDirectory, takeExtension)
71import Data.String (fromString)
75import Data.String (fromString)
72import Prelude as P
76import Prelude as P
77+import Data.List (sortBy)
78+import Data.Ord (comparing)
74-- | Embed a single file in your source code.
80-- | Embed a single file in your source code.
@@ -84,6 +90,33 @@ embedFile fp =
85 (runIO $ B.readFile fp) >>= bsToExp
91 (runIO $ B.readFile fp) >>= bsToExp
93+-- | Maybe embed a single file in your source code depending on whether or not file exists.
95+-- Warning: When a build is compiled with the file missing, a recompile when the file exists might not trigger an embed of the file.
96+-- You might try to fix this by doing a clean build.
98+-- > import qualified Data.ByteString
100+-- > maybeMyFile :: Maybe Data.ByteString.ByteString
101+-- > maybeMyFile = $(embedFileIfExists "dirName/fileName")
104+embedFileIfExists :: FilePath -> Q Exp
105+embedFileIfExists fp = do
106+ mbs <- runIO maybeFile
108+ Nothing -> [| Nothing |]
110+#if MIN_VERSION_template_haskell(2,7,0)
111+ qAddDependentFile fp
113+ [| Just $(bsToExp bs) |]
115+ maybeFile :: IO (Maybe B.ByteString)
117+ either (const Nothing) Just <$>
118+ tryJust (guard . isDoesNotExistError) (B.readFile fp)
87-- | Embed a single existing file in your source code
120-- | Embed a single existing file in your source code
88-- out of list a list of paths supplied.
121-- out of list a list of paths supplied.
@@ -118,6 +151,18 @@ embedDir fp = do
118 e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))
151 e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))
119 return $ SigE e typ
152 return $ SigE e typ
154+-- | Embed a directory listing recursively in your source code.
156+-- > myFiles :: [FilePath]
157+-- > myFiles = $(embedDirListing "dirName")
160+embedDirListing :: FilePath -> Q Exp
161+embedDirListing fp = do
162+ typ <- [t| [FilePath] |]
163+ e <- ListE <$> ((runIO $ fmap fst <$> fileList fp) >>= mapM strToExp)
121-- | Get a directory tree in the IO monad.
166-- | Get a directory tree in the IO monad.
123-- This is the workhorse of 'embedDir'
168-- This is the workhorse of 'embedDir'
@@ -130,7 +175,11 @@ pairToExp _root (path, bs) = do
130 qAddDependentFile $ _root ++ '/' : path
175 qAddDependentFile $ _root ++ '/' : path
132 exp' <- bsToExp bs
177 exp' <- bsToExp bs
179+#if MIN_VERSION_template_haskell(2,16,0)
133− return $! TupE [LitE $ StringL path, exp']
182+ [LitE $ StringL path, exp']
135bsToExp :: B.ByteString -> Q Exp
184bsToExp :: B.ByteString -> Q Exp
136#if MIN_VERSION_template_haskell(2, 5, 0)
185#if MIN_VERSION_template_haskell(2, 5, 0)
@@ -138,7 +187,11 @@ bsToExp bs =
138 return $ VarE 'unsafePerformIO
187 return $ VarE 'unsafePerformIO
139 `AppE` (VarE 'unsafePackAddressLen
188 `AppE` (VarE 'unsafePackAddressLen
140 `AppE` LitE (IntegerL $ fromIntegral $ B8.length bs)
189 `AppE` LitE (IntegerL $ fromIntegral $ B8.length bs)
141−#if MIN_VERSION_template_haskell(2, 8, 0)
190+#if MIN_VERSION_template_haskell(2, 16, 0)
191+ `AppE` LitE (bytesPrimL (
192+ let B.PS ptr off sz = bs
193+ in mkBytes ptr (fromIntegral off) (fromIntegral sz))))
194+#elif MIN_VERSION_template_haskell(2, 8, 0)
142 `AppE` LitE (StringPrimL $ B.unpack bs))
195 `AppE` LitE (StringPrimL $ B.unpack bs))
144 `AppE` LitE (StringPrimL $ B8.unpack bs))
197 `AppE` LitE (StringPrimL $ B8.unpack bs))
@@ -213,7 +266,7 @@ fileList' realTop top = do
213 mapM (liftPair2 . second B.readFile)
266 mapM (liftPair2 . second B.readFile)
214 dirs <- filterM (doesDirectoryExist . snd) all' >>=
267 dirs <- filterM (doesDirectoryExist . snd) all' >>=
215 mapM (fileList' realTop . fst)
268 mapM (fileList' realTop . fst)
216− return $ concat $ files : dirs
269+ return $ sortBy (comparing fst) $ concat $ files : dirs
218liftPair2 :: Monad m => (a, m b) -> m (a, b)
271liftPair2 :: Monad m => (a, m b) -> m (a, b)
219liftPair2 (a, b) = b >>= \b' -> return (a, b')
272liftPair2 (a, b) = b >>= \b' -> return (a, b')
@@ -352,13 +405,23 @@ available, you can use the non-@With@ variants.
352-- finds the first parent directory with a .cabal file, and uses that as the
405-- finds the first parent directory with a .cabal file, and uses that as the
353-- root directory for fixing the relative path.
406-- root directory for fixing the relative path.
356−-- $(makeRelativeToProject "data/foo.txt" >>= embedFile)
408+-- @$(makeRelativeToProject "data/foo.txt" >>= embedFile)@
359-- @since 0.0.10
410-- @since 0.0.10
360makeRelativeToProject :: FilePath -> Q FilePath
411makeRelativeToProject :: FilePath -> Q FilePath
361−makeRelativeToProject rel = do
412+makeRelativeToProject = makeRelativeToLocationPredicate $ (==) ".cabal" . takeExtension
414+-- | Take a predicate to infer the project root and a relative file path, the given file path is then attached to the inferred project root
416+-- This function looks at the source location of the Haskell file calling it,
417+-- finds the first parent directory with a file matching the given predicate, and uses that as the
418+-- root directory for fixing the relative path.
420+-- @$(makeRelativeToLocationPredicate ((==) ".cabal" . takeExtension) "data/foo.txt" >>= embedFile)@
423+makeRelativeToLocationPredicate :: (FilePath -> Bool) -> FilePath -> Q FilePath
424+makeRelativeToLocationPredicate isTargetFile rel = do
362 loc <- qLocation
425 loc <- qLocation
363 runIO $ do
426 runIO $ do
364 srcFP <- canonicalizePath $ loc_filename loc
427 srcFP <- canonicalizePath $ loc_filename loc
@@ -373,8 +436,6 @@ makeRelativeToProject rel = do
373 then return Nothing
436 then return Nothing
375 contents <- getDirectoryContents dir
438 contents <- getDirectoryContents dir
376− if any isCabalFile contents
439+ if any isTargetFile contents
377 then return (Just dir)
440 then return (Just dir)
378 else findProjectDir dir
441 else findProjectDir dir
380− isCabalFile fp = takeExtension fp == ".cabal"