git.iko.soy/typeable/file-embed
on master help sign in
Injection
commit33188f2b138e0d013f96143704c8b64322b488a7 authorMichael Snoyman <michael@snoyman.com> dateFri 27 May 2011, 08:23 (15 years ago) parent307738a
5 files changed+71−3
Data/FileEmbed.hs+61−2 file-embed.cabal+1−1 inject.hs+4 template.hs+4 test-inject.sh+1
Data/FileEmbed.hs+61−2
@@ -1,13 +1,18 @@
11{-# LANGUAGE TemplateHaskell #-}
22module Data.FileEmbed
3− ( embedFile
3+ ( -- * Embed at compile time
4+ embedFile
45 , embedDir
56 , getDir
7+ -- * Inject into an executable
8+ , dummySpace
9+ , inject
10+ , injectFile
611 ) where
712
813import Language.Haskell.TH (runQ,
914 Exp (AppE, ListE, LitE, TupE),
10− Lit (StringL),
15+ Lit (StringL, StringPrimL, IntegerL),
1116 Q,
1217 runIO)
1318import System.Directory (doesDirectoryExist, doesFileExist,
@@ -18,6 +23,8 @@ import qualified Data.ByteString.Char8 as B8
1823import Control.Arrow ((&&&), second, first)
1924import Control.Applicative ((<$>))
2025import Data.Monoid (mappend)
26+import Data.ByteString.Unsafe (unsafePackAddressLen)
27+import System.IO.Unsafe (unsafePerformIO)
2128
2229-- | Embed a single file in your source code.
2330--
@@ -78,3 +85,55 @@ fileList' realTop top = do
7885
7986liftPair2 :: Monad m => (a, m b) -> m (a, b)
8087liftPair2 (a, b) = b >>= \b' -> return (a, b')
88+
89+magic = concat ["fe", "MS"]
90+sizeLen = 20
91+
92+getInner :: B.ByteString -> B.ByteString
93+getInner b =
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."
98+
99+padSize :: Int -> String
100+padSize i =
101+ let s = show i
102+ in replicate (sizeLen - length s) '0' ++ s
103+
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))
114+
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
118+inject toInj orig =
119+ if toInjL > size
120+ then Nothing
121+ else Just $ B.concat [before, B8.pack magic, B8.pack $ padSize toInjL, toInj, B8.pack $ replicate (size - toInjL) '0', after]
122+ where
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
127+ (i, _):_ -> i
128+ [] -> error $ "Data.FileEmbed (inject): Your dummy space has been corrupted. Size is: " ++ show sizeBS
129+ (dummy, after) = B.splitAt size rest'
130+
131+injectFile :: B.ByteString
132+ -> FilePath -- ^ template file
133+ -> FilePath -- ^ output file
134+ -> IO ()
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
file-embed.cabal+1−1
@@ -1,5 +1,5 @@
11name: file-embed
2−version: 0.0.3.1
2+version: 0.0.4
33license: BSD3
44license-file: LICENSE
55author: Michael Snoyman <michael@snoyman.com>
inject.hsnew file+4
@@ -0,0 +1,4 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+import Data.FileEmbed
3+
4+main = injectFile "Hello World" "template" "injected"
template.hsnew file+4
@@ -0,0 +1,4 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+import Data.FileEmbed
3+
4+main = print $(dummySpace 100)
test-inject.shnew file+1
@@ -0,0 +1 @@
1+ghc --make -fforce-recomp template.hs && runghc inject.hs && chmod +x injected && ./injected