@@ -1,5 +1,6 @@
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 exceutable
@@ -24,9 +25,12 @@ module Data.FileEmbed
24 -- * Inject into an executable
25 -- * Inject into an executable
25#if MIN_VERSION_template_haskell(2,5,0)
26#if MIN_VERSION_template_haskell(2,5,0)
26 , dummySpace
27 , dummySpace
29 , injectFile
31 , injectFile
30 -- * Internal
34 -- * Internal
31 , stringToBs
35 , stringToBs
@@ -159,15 +163,15 @@ fileList' realTop top = do
159liftPair2 :: Monad m => (a, m b) -> m (a, b)
163liftPair2 :: Monad m => (a, m b) -> m (a, b)
160liftPair2 (a, b) = b >>= \b' -> return (a, b')
164liftPair2 (a, b) = b >>= \b' -> return (a, b')
162−magic :: String
166+magic :: B.ByteString -> B.ByteString
163−magic = concat ["fe", "MS"]
167+magic x = B8.concat ["fe", x]
165sizeLen :: Int
169sizeLen :: Int
166sizeLen = 20
170sizeLen = 20
168getInner :: B.ByteString -> B.ByteString
172getInner :: B.ByteString -> B.ByteString
169getInner b =
173getInner b =
170− let (sizeBS, rest) = B.splitAt sizeLen $ B.drop (length magic) b
174+ let (sizeBS, rest) = B.splitAt sizeLen b
171 in case reads $ B8.unpack sizeBS of
175 in case reads $ B8.unpack sizeBS of
172 (i, _):_ -> B.take i rest
176 (i, _):_ -> B.take i rest
173 [] -> error "Data.FileEmbed (getInner): Your dummy space has been corrupted."
177 [] -> error "Data.FileEmbed (getInner): Your dummy space has been corrupted."
@@ -179,40 +183,65 @@ padSize i =
180#if MIN_VERSION_template_haskell(2,5,0)
184#if MIN_VERSION_template_haskell(2,5,0)
181dummySpace :: Int -> Q Exp
185dummySpace :: Int -> Q Exp
182−dummySpace space = do
186+dummySpace = dummySpaceWith "MS"
188+-- | Like 'dummySpace', but takes a postfix for the magic string. In
189+-- order for this to work, the same postfix must be used by 'inject' /
190+-- 'injectFile'. This allows an executable to have multiple
191+-- 'ByteString's injected into it, without encountering collisions.
192+dummySpaceWith :: B.ByteString -> Int -> Q Exp
193+dummySpaceWith postfix space = do
183 let size = padSize space
194 let size = padSize space
195+ magic' = magic postfix
184− let start = magic ++ size
196+ start = B8.unpack magic' ++ size
197+ magicLen = B8.length magic'
198+ len = magicLen + sizeLen + space
185− let chars = LitE $ StringPrimL $
199+ chars = LitE $ StringPrimL $
186#if MIN_VERSION_template_haskell(2,6,0)
200#if MIN_VERSION_template_haskell(2,6,0)
187 map (toEnum . fromEnum) $
201 map (toEnum . fromEnum) $
189 start ++ replicate space '0'
203 start ++ replicate space '0'
190− let len = fromIntegral $ length start + space :: Int
191− [| getInner (unsafePerformIO (unsafePackAddressLen len $(return chars))) |]
204+ [| getInner (B.drop magicLen (unsafePerformIO (unsafePackAddressLen len $(return chars)))) |]
194inject :: B.ByteString -- ^ bs to inject
207inject :: B.ByteString -- ^ bs to inject
195 -> B.ByteString -- ^ original BS containing dummy
208 -> B.ByteString -- ^ original BS containing dummy
196 -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space
209 -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space
210+inject = injectWith "MS"
212+-- | Like 'inject', but takes a postfix for the magic string.
213+injectWith :: B.ByteString -- ^ postfix of magic string
214+ -> B.ByteString -- ^ bs to inject
215+ -> B.ByteString -- ^ original BS containing dummy
216+ -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space
197−inject toInj orig =
217+injectWith postfix toInj orig =
198 if toInjL > size
218 if toInjL > size
199 then Nothing
219 then Nothing
200− else Just $ B.concat [before, B8.pack magic, B8.pack $ padSize toInjL, toInj, B8.pack $ replicate (size - toInjL) '0', after]
220+ else Just $ B.concat [before, magic', B8.pack $ padSize toInjL, toInj, B8.pack $ replicate (size - toInjL) '0', after]
222+ magic' = magic postfix
202 toInjL = B.length toInj
223 toInjL = B.length toInj
203− (before, rest) = B.breakSubstring (B8.pack magic) orig
224+ (before, rest) = B.breakSubstring magic' orig
204− (sizeBS, rest') = B.splitAt sizeLen $ B.drop (length magic) rest
225+ (sizeBS, rest') = B.splitAt sizeLen $ B.drop (B8.length magic') rest
205 size = case reads $ B8.unpack sizeBS of
226 size = case reads $ B8.unpack sizeBS of
206 (i, _):_ -> i
227 (i, _):_ -> i
207 [] -> error $ "Data.FileEmbed (inject): Your dummy space has been corrupted. Size is: " ++ show sizeBS
228 [] -> error $ "Data.FileEmbed (inject): Your dummy space has been corrupted. Size is: " ++ show sizeBS
208 after = B.drop size rest'
229 after = B.drop size rest'
210−injectFile :: B.ByteString
231+injectFile :: B.ByteString -- ^ bs to inject
211 -> FilePath -- ^ template file
232 -> FilePath -- ^ template file
212 -> FilePath -- ^ output file
233 -> FilePath -- ^ output file
235+injectFile = injectFileWith "MS"
237+-- | Like 'injectFile', but takes a postfix for the magic string.
238+injectFileWith :: B.ByteString -- ^ postfix of magic string
239+ -> B.ByteString -- ^ bs to inject
240+ -> FilePath -- ^ template file
241+ -> FilePath -- ^ output file
214−injectFile inj srcFP dstFP = do
243+injectFileWith postfix inj srcFP dstFP = do
215 src <- B.readFile srcFP
244 src <- B.readFile srcFP
216− case inject inj src of
245+ case injectWith postfix inj src of
217 Nothing -> error "Insufficient dummy space"
246 Nothing -> error "Insufficient dummy space"
218 Just dst -> B.writeFile dstFP dst
247 Just dst -> B.writeFile dstFP dst