@@ -1,13 +1,18 @@
1{-# LANGUAGE TemplateHaskell #-}
1{-# LANGUAGE TemplateHaskell #-}
2module Data.FileEmbed
2module Data.FileEmbed
3+ ( -- * Embed at compile time
3− ( embedFile
4+ embedFile
7+ -- * Inject into an executable
8import Language.Haskell.TH (runQ,
13import Language.Haskell.TH (runQ,
9 Exp (AppE, ListE, LitE, TupE),
14 Exp (AppE, ListE, LitE, TupE),
10− Lit (StringL),
15+ Lit (StringL, StringPrimL, IntegerL),
13import System.Directory (doesDirectoryExist, doesFileExist,
18import System.Directory (doesDirectoryExist, doesFileExist,
@@ -18,6 +23,8 @@ import qualified Data.ByteString.Char8 as B8
18import Control.Arrow ((&&&), second, first)
23import Control.Arrow ((&&&), second, first)
19import Control.Applicative ((<$>))
24import Control.Applicative ((<$>))
20import Data.Monoid (mappend)
25import Data.Monoid (mappend)
26+import Data.ByteString.Unsafe (unsafePackAddressLen)
27+import System.IO.Unsafe (unsafePerformIO)
22-- | Embed a single file in your source code.
29-- | Embed a single file in your source code.
@@ -78,3 +85,55 @@ fileList' realTop top = do
79liftPair2 :: Monad m => (a, m b) -> m (a, b)
86liftPair2 :: Monad m => (a, m b) -> m (a, b)
80liftPair2 (a, b) = b >>= \b' -> return (a, b')
87liftPair2 (a, b) = b >>= \b' -> return (a, b')
89+magic = concat ["fe", "MS"]
92+getInner :: B.ByteString -> B.ByteString
94+ let (sizeBS, rest) = B.splitAt sizeLen $ B.drop (length magic) b
95+ in case reads $ B8.unpack sizeBS of
96+ (i, _):_ -> B.take i rest
97+ [] -> error "Data.FileEmbed (getInner): Your dummy space has been corrupted."
99+padSize :: Int -> String
102+ in replicate (sizeLen - length s) '0' ++ s
104+dummySpace :: Int -> Q Exp
105+dummySpace space = do
106+ let size = padSize space
107+ let start = magic ++ size
108+ let chars = LitE $ StringPrimL $ start ++ replicate space '0'
109+ let len = LitE $ IntegerL $ fromIntegral $ length start + space
110+ upi <- [|unsafePerformIO|]
111+ pack <- [|unsafePackAddressLen|]
112+ getInner' <- [|getInner|]
113+ return $ getInner' `AppE` (upi `AppE` (pack `AppE` len `AppE` chars))
115+inject :: B.ByteString -- ^ bs to inject
116+ -> B.ByteString -- ^ original BS containing dummy
117+ -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space
121+ else Just $ B.concat [before, B8.pack magic, B8.pack $ padSize toInjL, toInj, B8.pack $ replicate (size - toInjL) '0', after]
123+ toInjL = B.length toInj
124+ (before, rest) = B.breakSubstring (B8.pack magic) orig
125+ (sizeBS, rest') = B.splitAt sizeLen $ B.drop (length magic) rest
126+ size = case reads $ B8.unpack sizeBS of
128+ [] -> error $ "Data.FileEmbed (inject): Your dummy space has been corrupted. Size is: " ++ show sizeBS
129+ (dummy, after) = B.splitAt size rest'
131+injectFile :: B.ByteString
132+ -> FilePath -- ^ template file
133+ -> FilePath -- ^ output file
135+injectFile inj srcFP dstFP = do
136+ src <- B.readFile srcFP
137+ case inject inj src of
138+ Nothing -> error "Insufficient dummy space"
139+ Just dst -> B.writeFile dstFP dst