@@ -3,7 +3,7 @@
33{-# LANGUAGE OverloadedStrings #-}
44-- | This module uses template Haskell. Following is a simplified explanation of usage for those unfamiliar with calling Template Haskell functions.
55--
6−-- The function @embedFile@ in this modules embeds a file into the executable
6+-- The function @embedFile@ in this modules embeds a file into the exceutable
77-- that you can use it at runtime. A file is represented as a @ByteString@.
88-- However, as you can see below, the type signature indicates a value of type
99-- @Q Exp@ will be returned. In order to convert this into a @ByteString@, you
@@ -19,16 +19,10 @@
1919module Data.FileEmbed
2020 ( -- * Embed at compile time
2121 embedFile
22− , embedFileIfExists
2322 , embedOneFileOf
2423 , embedDir
25− , embedDirListing
2624 , getDir
27− -- * Embed as a IsString
28− , embedStringFile
29− , embedOneStringFileOf
3025 -- * Inject into an executable
31− -- $inject
3226#if MIN_VERSION_template_haskell(2,5,0)
3327 , dummySpace
3428 , dummySpaceWith
@@ -37,45 +31,35 @@ module Data.FileEmbed
3731 , injectFile
3832 , injectWith
3933 , injectFileWith
40− -- * Relative path manipulation
41− , makeRelativeToProject
42− , makeRelativeToLocationPredicate
4334 -- * Internal
4435 , stringToBs
4536 , bsToExp
46− , strToExp
4737 ) where
4838
4939import Language.Haskell.TH.Syntax
5040 ( Exp (AppE, ListE, LitE, TupE, SigE, VarE)
51− , Lit (..)
41+#if MIN_VERSION_template_haskell(2,5,0)
42+ , Lit (StringL, StringPrimL, IntegerL)
43+#else
44+ , Lit (StringL, IntegerL)
45+#endif
5246 , Q
5347 , runIO
54− , qLocation, loc_filename
5548#if MIN_VERSION_template_haskell(2,7,0)
5649 , Quasi(qAddDependentFile)
5750#endif
5851 )
59−#if MIN_VERSION_template_haskell(2,16,0)
60−import Language.Haskell.TH ( mkBytes, bytesPrimL )
61−import qualified Data.ByteString.Internal as B
62−#endif
6352import System.Directory (doesDirectoryExist, doesFileExist,
64− getDirectoryContents, canonicalizePath)
65−import Control.Exception (throw, tryJust, ErrorCall(..))
66−import Control.Monad (filterM, guard)
53+ getDirectoryContents)
54+import Control.Exception (throw, ErrorCall(..))
55+import Control.Monad (filterM)
6756import qualified Data.ByteString as B
6857import qualified Data.ByteString.Char8 as B8
6958import Control.Arrow ((&&&), second)
7059import Control.Applicative ((<$>))
7160import Data.ByteString.Unsafe (unsafePackAddressLen)
72−import System.IO.Error (isDoesNotExistError)
7361import System.IO.Unsafe (unsafePerformIO)
74−import System.FilePath ((</>), takeDirectory, takeExtension)
75−import Data.String (fromString)
76−import Prelude as P
77−import Data.List (sortBy)
78−import Data.Ord (comparing)
62+import System.FilePath ((</>))
7963
8064-- | Embed a single file in your source code.
8165--
@@ -90,40 +74,13 @@ embedFile fp =
9074#endif
9175 (runIO $ B.readFile fp) >>= bsToExp
9276
93−-- | Maybe embed a single file in your source code depending on whether or not file exists.
94−--
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.
97−--
98−-- > import qualified Data.ByteString
99−-- >
100−-- > maybeMyFile :: Maybe Data.ByteString.ByteString
101−-- > maybeMyFile = $(embedFileIfExists "dirName/fileName")
102−--
103−-- @since 0.0.14.0
104−embedFileIfExists :: FilePath -> Q Exp
105−embedFileIfExists fp = do
106− mbs <- runIO maybeFile
107− case mbs of
108− Nothing -> [| Nothing |]
109− Just bs -> do
110−#if MIN_VERSION_template_haskell(2,7,0)
111− qAddDependentFile fp
112−#endif
113− [| Just $(bsToExp bs) |]
114− where
115− maybeFile :: IO (Maybe B.ByteString)
116− maybeFile =
117− either (const Nothing) Just <$>
118− tryJust (guard . isDoesNotExistError) (B.readFile fp)
119−
12077-- | Embed a single existing file in your source code
12178-- out of list a list of paths supplied.
12279--
12380-- > import qualified Data.ByteString
12481-- >
12582-- > myFile :: Data.ByteString.ByteString
126−-- > myFile = $(embedOneFileOf [ "dirName/fileName", "src/dirName/fileName" ])
83+-- > myFile = $(embedFile' [ "dirName/fileName", "src/dirName/fileName" ])
12784embedOneFileOf :: [FilePath] -> Q Exp
12885embedOneFileOf ps =
12986 (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do
@@ -151,18 +108,6 @@ embedDir fp = do
151108 e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))
152109 return $ SigE e typ
153110
154−-- | Embed a directory listing recursively in your source code.
155−--
156−-- > myFiles :: [FilePath]
157−-- > myFiles = $(embedDirListing "dirName")
158−--
159−-- @since 0.0.11
160−embedDirListing :: FilePath -> Q Exp
161−embedDirListing fp = do
162− typ <- [t| [FilePath] |]
163− e <- ListE <$> ((runIO $ fmap fst <$> fileList fp) >>= mapM strToExp)
164− return $ SigE e typ
165−
166111-- | Get a directory tree in the IO monad.
167112--
168113-- This is the workhorse of 'embedDir'
@@ -175,11 +120,7 @@ pairToExp _root (path, bs) = do
175120 qAddDependentFile $ _root ++ '/' : path
176121#endif
177122 exp' <- bsToExp bs
178− return $! TupE
179−#if MIN_VERSION_template_haskell(2,16,0)
180− $ map Just
181−#endif
182− [LitE $ StringL path, exp']
123+ return $! TupE [LitE $ StringL path, exp']
183124
184125bsToExp :: B.ByteString -> Q Exp
185126#if MIN_VERSION_template_haskell(2, 5, 0)
@@ -187,11 +128,7 @@ bsToExp bs =
187128 return $ VarE 'unsafePerformIO
188129 `AppE` (VarE 'unsafePackAddressLen
189130 `AppE` LitE (IntegerL $ fromIntegral $ B8.length bs)
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)
131+#if MIN_VERSION_template_haskell(2, 8, 0)
195132 `AppE` LitE (StringPrimL $ B.unpack bs))
196133#else
197134 `AppE` LitE (StringPrimL $ B8.unpack bs))
@@ -206,51 +143,6 @@ bsToExp bs = do
206143stringToBs :: String -> B.ByteString
207144stringToBs = B8.pack
208145
209−-- | Embed a single file in your source code.
210−--
211−-- > import Data.String
212−-- >
213−-- > myFile :: IsString a => a
214−-- > myFile = $(embedStringFile "dirName/fileName")
215−--
216−-- Since 0.0.9
217−embedStringFile :: FilePath -> Q Exp
218−embedStringFile fp =
219−#if MIN_VERSION_template_haskell(2,7,0)
220− qAddDependentFile fp >>
221−#endif
222− (runIO $ P.readFile fp) >>= strToExp
223−
224−-- | Embed a single existing string file in your source code
225−-- out of list a list of paths supplied.
226−--
227−-- Since 0.0.9
228−embedOneStringFileOf :: [FilePath] -> Q Exp
229−embedOneStringFileOf ps =
230− (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do
231−#if MIN_VERSION_template_haskell(2,7,0)
232− qAddDependentFile path
233−#endif
234− strToExp content
235− where
236− readExistingFile :: [FilePath] -> IO ( FilePath, String )
237− readExistingFile xs = do
238− ys <- filterM doesFileExist xs
239− case ys of
240− (p:_) -> P.readFile p >>= \ c -> return ( p, c )
241− _ -> throw $ ErrorCall "Cannot find file to embed as resource"
242−
243−strToExp :: String -> Q Exp
244−#if MIN_VERSION_template_haskell(2, 5, 0)
245−strToExp s =
246− return $ VarE 'fromString
247− `AppE` LitE (StringL s)
248−#else
249−strToExp s = do
250− helper <- [| fromString |]
251− return $! AppE helper $! LitE $! StringL s
252−#endif
253−
254146notHidden :: FilePath -> Bool
255147notHidden ('.':_) = False
256148notHidden _ = True
@@ -266,7 +158,7 @@ fileList' realTop top = do
266158 mapM (liftPair2 . second B.readFile)
267159 dirs <- filterM (doesDirectoryExist . snd) all' >>=
268160 mapM (fileList' realTop . fst)
269− return $ sortBy (comparing fst) $ concat $ files : dirs
161+ return $ concat $ files : dirs
270162
271163liftPair2 :: Monad m => (a, m b) -> m (a, b)
272164liftPair2 (a, b) = b >>= \b' -> return (a, b')
@@ -290,8 +182,6 @@ padSize i =
290182 in replicate (sizeLen - length s) '0' ++ s
291183
292184#if MIN_VERSION_template_haskell(2,5,0)
293−-- | Allocate the given number of bytes in the generate executable. That space
294−-- can be filled up with the 'inject' and 'injectFile' functions.
295185dummySpace :: Int -> Q Exp
296186dummySpace = dummySpaceWith "MS"
297187
@@ -299,8 +189,6 @@ dummySpace = dummySpaceWith "MS"
299189-- order for this to work, the same postfix must be used by 'inject' /
300190-- 'injectFile'. This allows an executable to have multiple
301191-- 'ByteString's injected into it, without encountering collisions.
302−--
303−-- Since 0.0.8
304192dummySpaceWith :: B.ByteString -> Int -> Q Exp
305193dummySpaceWith postfix space = do
306194 let size = padSize space
@@ -316,17 +204,12 @@ dummySpaceWith postfix space = do
316204 [| getInner (B.drop magicLen (unsafePerformIO (unsafePackAddressLen len $(return chars)))) |]
317205#endif
318206
319−-- | Inject some raw data inside a @ByteString@ containing empty, dummy space
320−-- (allocated with @dummySpace@). Typically, the original @ByteString@ is an
321−-- executable read from the filesystem.
322207inject :: B.ByteString -- ^ bs to inject
323208 -> B.ByteString -- ^ original BS containing dummy
324209 -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space
325210inject = injectWith "MS"
326211
327212-- | Like 'inject', but takes a postfix for the magic string.
328−--
329−-- Since 0.0.8
330213injectWith :: B.ByteString -- ^ postfix of magic string
331214 -> B.ByteString -- ^ bs to inject
332215 -> B.ByteString -- ^ original BS containing dummy
@@ -345,9 +228,6 @@ injectWith postfix toInj orig =
345228 [] -> error $ "Data.FileEmbed (inject): Your dummy space has been corrupted. Size is: " ++ show sizeBS
346229 after = B.drop size rest'
347230
348−-- | Same as 'inject', but instead of performing the injecting in memory, read
349−-- the contents from the filesystem and write back to a different file on the
350−-- filesystem.
351231injectFile :: B.ByteString -- ^ bs to inject
352232 -> FilePath -- ^ template file
353233 -> FilePath -- ^ output file
@@ -355,8 +235,6 @@ injectFile :: B.ByteString -- ^ bs to inject
355235injectFile = injectFileWith "MS"
356236
357237-- | Like 'injectFile', but takes a postfix for the magic string.
358−--
359−-- Since 0.0.8
360238injectFileWith :: B.ByteString -- ^ postfix of magic string
361239 -> B.ByteString -- ^ bs to inject
362240 -> FilePath -- ^ template file
@@ -367,75 +245,3 @@ injectFileWith postfix inj srcFP dstFP = do
367245 case injectWith postfix inj src of
368246 Nothing -> error "Insufficient dummy space"
369247 Just dst -> B.writeFile dstFP dst
370−
371−{- $inject
372−
373−The inject system allows arbitrary content to be embedded inside a Haskell
374−executable, post compilation. Typically, file-embed allows you to read some
375−contents from the file system at compile time and embed them inside your
376−executable. Consider a case, instead, where you would want to embed these
377−contents after compilation. Two real-world examples are:
378−
379−* You would like to embed a hash of the executable itself, for sanity checking in a network protocol. (Obviously the hash will change after you embed the hash.)
380−
381−* You want to create a self-contained web server that has a set of content, but will need to update the content on machines that do not have access to GHC.
382−
383−The typical workflow use:
384−
385−* Use 'dummySpace' or 'dummySpaceWith' to create some empty space in your executable
386−
387−* Use 'injectFile' or 'injectFileWith' from a separate utility to modify that executable to have the updated content.
388−
389−The reason for the @With@-variant of the functions is for cases where you wish
390−to inject multiple different kinds of content, and therefore need control over
391−the magic key. If you know for certain that there will only be one dummy space
392−available, you can use the non-@With@ variants.
393−
394−-}
395−
396−-- | Take a relative file path and attach it to the root of the current
397−-- project.
398−--
399−-- The idea here is that, when building with Stack, the build will always be
400−-- executed with a current working directory of the root of the project (where
401−-- your .cabal file is located). However, if you load up multiple projects with
402−-- @stack ghci@, the working directory may be something else entirely.
403−--
404−-- This function looks at the source location of the Haskell file calling it,
405−-- finds the first parent directory with a .cabal file, and uses that as the
406−-- root directory for fixing the relative path.
407−--
408−-- @$(makeRelativeToProject "data/foo.txt" >>= embedFile)@
409−--
410−-- @since 0.0.10
411−makeRelativeToProject :: FilePath -> Q FilePath
412−makeRelativeToProject = makeRelativeToLocationPredicate $ (==) ".cabal" . takeExtension
413−
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
415−--
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.
419−--
420−-- @$(makeRelativeToLocationPredicate ((==) ".cabal" . takeExtension) "data/foo.txt" >>= embedFile)@
421−--
422−-- @since 0.0.15.0
423−makeRelativeToLocationPredicate :: (FilePath -> Bool) -> FilePath -> Q FilePath
424−makeRelativeToLocationPredicate isTargetFile rel = do
425− loc <- qLocation
426− runIO $ do
427− srcFP <- canonicalizePath $ loc_filename loc
428− mdir <- findProjectDir srcFP
429− case mdir of
430− Nothing -> error $ "Could not find .cabal file for path: " ++ srcFP
431− Just dir -> return $ dir </> rel
432− where
433− findProjectDir x = do
434− let dir = takeDirectory x
435− if dir == x
436− then return Nothing
437− else do
438− contents <- getDirectoryContents dir
439− if any isTargetFile contents
440− then return (Just dir)
441− else findProjectDir dir