@@ -1,8 +1,9 @@
1{-# LANGUAGE TemplateHaskell #-}
1{-# LANGUAGE TemplateHaskell #-}
2{-# LANGUAGE CPP #-}
2{-# LANGUAGE CPP #-}
3+{-# LANGUAGE OverloadedStrings #-}
3-- | This module uses template Haskell. Following is a simplified explanation of usage for those unfamiliar with calling Template Haskell functions.
4-- | This module uses template Haskell. Following is a simplified explanation of usage for those unfamiliar with calling Template Haskell functions.
5−-- The function @embedFile@ in this modules embeds a file into the exceutable
6+-- The function @embedFile@ in this modules embeds a file into the executable
6-- that you can use it at runtime. A file is represented as a @ByteString@.
7-- that you can use it at runtime. A file is represented as a @ByteString@.
7-- However, as you can see below, the type signature indicates a value of type
8-- However, as you can see below, the type signature indicates a value of type
8-- @Q Exp@ will be returned. In order to convert this into a @ByteString@, you
9-- @Q Exp@ will be returned. In order to convert this into a @ByteString@, you
@@ -18,44 +19,63 @@
18module Data.FileEmbed
19module Data.FileEmbed
19 ( -- * Embed at compile time
20 ( -- * Embed at compile time
21 , embedOneFileOf
23 , embedOneFileOf
22 , embedDir
24 , embedDir
27+ -- * Embed as a IsString
29+ , embedOneStringFileOf
24 -- * Inject into an executable
30 -- * Inject into an executable
25#if MIN_VERSION_template_haskell(2,5,0)
32#if MIN_VERSION_template_haskell(2,5,0)
26 , dummySpace
33 , dummySpace
29 , injectFile
37 , injectFile
40+ -- * Relative path manipulation
41+ , makeRelativeToProject
42+ , makeRelativeToLocationPredicate
30 -- * Internal
43 -- * Internal
31 , stringToBs
44 , stringToBs
35import Language.Haskell.TH.Syntax
49import Language.Haskell.TH.Syntax
36 ( Exp (AppE, ListE, LitE, TupE, SigE, VarE)
50 ( Exp (AppE, ListE, LitE, TupE, SigE, VarE)
37−#if MIN_VERSION_template_haskell(2,5,0)
51+ , Lit (..)
38− , Lit (StringL, StringPrimL, IntegerL)
40− , Lit (StringL, IntegerL)
54+ , qLocation, loc_filename
44#if MIN_VERSION_template_haskell(2,7,0)
55#if MIN_VERSION_template_haskell(2,7,0)
45 , 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
48import System.Directory (doesDirectoryExist, doesFileExist,
63import System.Directory (doesDirectoryExist, doesFileExist,
49− getDirectoryContents)
64+ getDirectoryContents, canonicalizePath)
50−import Control.Exception (throw, ErrorCall(..))
65+import Control.Exception (throw, tryJust, ErrorCall(..))
51−import Control.Monad (filterM)
66+import Control.Monad (filterM, guard)
52import qualified Data.ByteString as B
67import qualified Data.ByteString as B
53import qualified Data.ByteString.Char8 as B8
68import qualified Data.ByteString.Char8 as B8
54import Control.Arrow ((&&&), second)
69import Control.Arrow ((&&&), second)
55import Control.Applicative ((<$>))
70import Control.Applicative ((<$>))
56import Data.ByteString.Unsafe (unsafePackAddressLen)
71import Data.ByteString.Unsafe (unsafePackAddressLen)
72+import System.IO.Error (isDoesNotExistError)
57import System.IO.Unsafe (unsafePerformIO)
73import System.IO.Unsafe (unsafePerformIO)
58−import System.FilePath ((</>))
74+import System.FilePath ((</>), takeDirectory, takeExtension)
75+import Data.String (fromString)
77+import Data.List (sortBy)
78+import Data.Ord (comparing)
60-- | Embed a single file in your source code.
80-- | Embed a single file in your source code.
@@ -70,13 +90,40 @@ embedFile fp =
71 (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)
73-- | Embed a single existing file in your source code
120-- | Embed a single existing file in your source code
74-- out of list a list of paths supplied.
121-- out of list a list of paths supplied.
76-- > import qualified Data.ByteString
123-- > import qualified Data.ByteString
78-- > myFile :: Data.ByteString.ByteString
125-- > myFile :: Data.ByteString.ByteString
79−-- > myFile = $(embedFile' [ "dirName/fileName", "src/dirName/fileName" ])
126+-- > myFile = $(embedOneFileOf [ "dirName/fileName", "src/dirName/fileName" ])
80embedOneFileOf :: [FilePath] -> Q Exp
127embedOneFileOf :: [FilePath] -> Q Exp
81embedOneFileOf ps =
128embedOneFileOf ps =
82 (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do
129 (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do
@@ -104,6 +151,18 @@ embedDir fp = do
104 e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))
151 e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))
105 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)
107-- | Get a directory tree in the IO monad.
166-- | Get a directory tree in the IO monad.
109-- This is the workhorse of 'embedDir'
168-- This is the workhorse of 'embedDir'
@@ -116,7 +175,11 @@ pairToExp _root (path, bs) = do
116 qAddDependentFile $ _root ++ '/' : path
175 qAddDependentFile $ _root ++ '/' : path
118 exp' <- bsToExp bs
177 exp' <- bsToExp bs
179+#if MIN_VERSION_template_haskell(2,16,0)
119− return $! TupE [LitE $ StringL path, exp']
182+ [LitE $ StringL path, exp']
121bsToExp :: B.ByteString -> Q Exp
184bsToExp :: B.ByteString -> Q Exp
122#if MIN_VERSION_template_haskell(2, 5, 0)
185#if MIN_VERSION_template_haskell(2, 5, 0)
@@ -124,7 +187,11 @@ bsToExp bs =
124 return $ VarE 'unsafePerformIO
187 return $ VarE 'unsafePerformIO
125 `AppE` (VarE 'unsafePackAddressLen
188 `AppE` (VarE 'unsafePackAddressLen
126 `AppE` LitE (IntegerL $ fromIntegral $ B8.length bs)
189 `AppE` LitE (IntegerL $ fromIntegral $ B8.length bs)
127−#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)
128 `AppE` LitE (StringPrimL $ B.unpack bs))
195 `AppE` LitE (StringPrimL $ B.unpack bs))
130 `AppE` LitE (StringPrimL $ B8.unpack bs))
197 `AppE` LitE (StringPrimL $ B8.unpack bs))
@@ -139,6 +206,51 @@ bsToExp bs = do
139stringToBs :: String -> B.ByteString
206stringToBs :: String -> B.ByteString
140stringToBs = B8.pack
207stringToBs = B8.pack
209+-- | Embed a single file in your source code.
211+-- > import Data.String
213+-- > myFile :: IsString a => a
214+-- > myFile = $(embedStringFile "dirName/fileName")
217+embedStringFile :: FilePath -> Q Exp
219+#if MIN_VERSION_template_haskell(2,7,0)
220+ qAddDependentFile fp >>
222+ (runIO $ P.readFile fp) >>= strToExp
224+-- | Embed a single existing string file in your source code
225+-- out of list a list of paths supplied.
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
236+ readExistingFile :: [FilePath] -> IO ( FilePath, String )
237+ readExistingFile xs = do
238+ ys <- filterM doesFileExist xs
240+ (p:_) -> P.readFile p >>= \ c -> return ( p, c )
241+ _ -> throw $ ErrorCall "Cannot find file to embed as resource"
243+strToExp :: String -> Q Exp
244+#if MIN_VERSION_template_haskell(2, 5, 0)
246+ return $ VarE 'fromString
247+ `AppE` LitE (StringL s)
250+ helper <- [| fromString |]
251+ return $! AppE helper $! LitE $! StringL s
142notHidden :: FilePath -> Bool
254notHidden :: FilePath -> Bool
143notHidden ('.':_) = False
255notHidden ('.':_) = False
144notHidden _ = True
256notHidden _ = True
@@ -154,20 +266,20 @@ fileList' realTop top = do
154 mapM (liftPair2 . second B.readFile)
266 mapM (liftPair2 . second B.readFile)
155 dirs <- filterM (doesDirectoryExist . snd) all' >>=
267 dirs <- filterM (doesDirectoryExist . snd) all' >>=
156 mapM (fileList' realTop . fst)
268 mapM (fileList' realTop . fst)
157− return $ concat $ files : dirs
269+ return $ sortBy (comparing fst) $ concat $ files : dirs
159liftPair2 :: Monad m => (a, m b) -> m (a, b)
271liftPair2 :: Monad m => (a, m b) -> m (a, b)
160liftPair2 (a, b) = b >>= \b' -> return (a, b')
272liftPair2 (a, b) = b >>= \b' -> return (a, b')
162−magic :: String
274+magic :: B.ByteString -> B.ByteString
163−magic = concat ["fe", "MS"]
275+magic x = B8.concat ["fe", x]
165sizeLen :: Int
277sizeLen :: Int
166sizeLen = 20
278sizeLen = 20
168getInner :: B.ByteString -> B.ByteString
280getInner :: B.ByteString -> B.ByteString
169getInner b =
281getInner b =
170− let (sizeBS, rest) = B.splitAt sizeLen $ B.drop (length magic) b
282+ let (sizeBS, rest) = B.splitAt sizeLen b
171 in case reads $ B8.unpack sizeBS of
283 in case reads $ B8.unpack sizeBS of
172 (i, _):_ -> B.take i rest
284 (i, _):_ -> B.take i rest
173 [] -> error "Data.FileEmbed (getInner): Your dummy space has been corrupted."
285 [] -> error "Data.FileEmbed (getInner): Your dummy space has been corrupted."
@@ -178,44 +290,152 @@ padSize i =
178 in replicate (sizeLen - length s) '0' ++ s
290 in replicate (sizeLen - length s) '0' ++ s
180#if MIN_VERSION_template_haskell(2,5,0)
292#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.
181dummySpace :: Int -> Q Exp
295dummySpace :: Int -> Q Exp
182−dummySpace space = do
296+dummySpace = dummySpaceWith "MS"
298+-- | Like 'dummySpace', but takes a postfix for the magic string. In
299+-- order for this to work, the same postfix must be used by 'inject' /
300+-- 'injectFile'. This allows an executable to have multiple
301+-- 'ByteString's injected into it, without encountering collisions.
304+dummySpaceWith :: B.ByteString -> Int -> Q Exp
305+dummySpaceWith postfix space = do
183 let size = padSize space
306 let size = padSize space
307+ magic' = magic postfix
184− let start = magic ++ size
308+ start = B8.unpack magic' ++ size
309+ magicLen = B8.length magic'
310+ len = magicLen + sizeLen + space
185− let chars = LitE $ StringPrimL $
311+ chars = LitE $ StringPrimL $
186#if MIN_VERSION_template_haskell(2,6,0)
312#if MIN_VERSION_template_haskell(2,6,0)
187 map (toEnum . fromEnum) $
313 map (toEnum . fromEnum) $
189 start ++ replicate space '0'
315 start ++ replicate space '0'
190− let len = LitE $ IntegerL $ fromIntegral $ length start + space
191− upi <- [|unsafePerformIO|]
192− pack <- [|unsafePackAddressLen|]
316+ [| getInner (B.drop magicLen (unsafePerformIO (unsafePackAddressLen len $(return chars)))) |]
193− getInner' <- [|getInner|]
194− return $ getInner' `AppE` (upi `AppE` (pack `AppE` len `AppE` chars))
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.
197inject :: B.ByteString -- ^ bs to inject
322inject :: B.ByteString -- ^ bs to inject
198 -> B.ByteString -- ^ original BS containing dummy
323 -> B.ByteString -- ^ original BS containing dummy
199 -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space
324 -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space
325+inject = injectWith "MS"
327+-- | Like 'inject', but takes a postfix for the magic string.
330+injectWith :: B.ByteString -- ^ postfix of magic string
331+ -> B.ByteString -- ^ bs to inject
332+ -> B.ByteString -- ^ original BS containing dummy
333+ -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space
200−inject toInj orig =
334+injectWith postfix toInj orig =
201 if toInjL > size
335 if toInjL > size
202 then Nothing
336 then Nothing
203− else Just $ B.concat [before, B8.pack magic, B8.pack $ padSize toInjL, toInj, B8.pack $ replicate (size - toInjL) '0', after]
337+ else Just $ B.concat [before, magic', B8.pack $ padSize toInjL, toInj, B8.pack $ replicate (size - toInjL) '0', after]
339+ magic' = magic postfix
205 toInjL = B.length toInj
340 toInjL = B.length toInj
206− (before, rest) = B.breakSubstring (B8.pack magic) orig
341+ (before, rest) = B.breakSubstring magic' orig
207− (sizeBS, rest') = B.splitAt sizeLen $ B.drop (length magic) rest
342+ (sizeBS, rest') = B.splitAt sizeLen $ B.drop (B8.length magic') rest
208 size = case reads $ B8.unpack sizeBS of
343 size = case reads $ B8.unpack sizeBS of
209 (i, _):_ -> i
344 (i, _):_ -> i
210 [] -> error $ "Data.FileEmbed (inject): Your dummy space has been corrupted. Size is: " ++ show sizeBS
345 [] -> error $ "Data.FileEmbed (inject): Your dummy space has been corrupted. Size is: " ++ show sizeBS
211 after = B.drop size rest'
346 after = B.drop size rest'
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
213−injectFile :: B.ByteString
351+injectFile :: B.ByteString -- ^ bs to inject
214 -> FilePath -- ^ template file
352 -> FilePath -- ^ template file
215 -> FilePath -- ^ output file
353 -> FilePath -- ^ output file
355+injectFile = injectFileWith "MS"
357+-- | Like 'injectFile', but takes a postfix for the magic string.
360+injectFileWith :: B.ByteString -- ^ postfix of magic string
361+ -> B.ByteString -- ^ bs to inject
362+ -> FilePath -- ^ template file
363+ -> FilePath -- ^ output file
217−injectFile inj srcFP dstFP = do
365+injectFileWith postfix inj srcFP dstFP = do
218 src <- B.readFile srcFP
366 src <- B.readFile srcFP
219− case inject inj src of
367+ case injectWith postfix inj src of
220 Nothing -> error "Insufficient dummy space"
368 Nothing -> error "Insufficient dummy space"
221 Just dst -> B.writeFile dstFP dst
369 Just dst -> B.writeFile dstFP dst
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:
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.)
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.
383+The typical workflow use:
385+* Use 'dummySpace' or 'dummySpaceWith' to create some empty space in your executable
387+* Use 'injectFile' or 'injectFileWith' from a separate utility to modify that executable to have the updated content.
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.
396+-- | Take a relative file path and attach it to the root of the current
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.
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.
408+-- @$(makeRelativeToProject "data/foo.txt" >>= embedFile)@
411+makeRelativeToProject :: FilePath -> Q FilePath
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
427+ srcFP <- canonicalizePath $ loc_filename loc
428+ mdir <- findProjectDir srcFP
430+ Nothing -> error $ "Could not find .cabal file for path: " ++ srcFP
431+ Just dir -> return $ dir </> rel
433+ findProjectDir x = do
434+ let dir = takeDirectory x
438+ contents <- getDirectoryContents dir
439+ if any isTargetFile contents
440+ then return (Just dir)
441+ else findProjectDir dir