file-embed-poly (empty) → 0.1.0
raw patch · 15 files changed
+499/−0 lines, 15 filesdep +basedep +bytestringdep +directorysetup-changedbinary-added
Dependencies added: base, bytestring, directory, file-embed, filepath, hspec, shelly, template-haskell
Files
- ChangeLog.md +30/−0
- Data/FileEmbed.hs +159/−0
- Data/FileEmbed/Inject.hs +141/−0
- LICENSE +25/−0
- README.md +4/−0
- Setup.lhs +7/−0
- file-embed-poly.cabal +53/−0
- test/injection-test/inject.hs +4/−0
- test/injection-test/template.hs +4/−0
- test/main.hs +69/−0
- test/sample/.hidden +0/−0
- test/sample/bar +1/−0
- test/sample/baz +1/−0
- test/sample/bin +1/−0
- test/sample/binary binary
+ ChangeLog.md view
@@ -0,0 +1,30 @@+## 0.1.0++* Injection has been moved to a submodule, "Data.FileEmbed.Inject".+* The ByteString-centric API has been shifted over to one that can produce any member of the IsString typeclass.+ * Correspondingly, the `embedString*` API has been removed, as it is now redundant.+* Several generally-unused internal functions are no longer exported.++## 0.0.10++* `makeRelativeToProject`++## 0.0.9++* embedStringFile [#14](https://github.com/snoyberg/file-embed/pull/14)++## 0.0.8.2++* Improve inject documentation [#11](https://github.com/snoyberg/file-embed/issues/11)++## 0.0.8.1++Minor cleanup++## 0.0.8++* Custom postfix for magic string [#7](https://github.com/snoyberg/file-embed/issues/7)++## 0.0.7.1++Minor cleanup
+ Data/FileEmbed.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+-- | This module uses template Haskell. Following is a simplified explanation of usage for those unfamiliar with calling Template Haskell functions.+--+-- The function @embedFile@ in this modules embeds a file into the executable+-- that you can use it at runtime. A file is represented as a @ByteString@.+-- However, as you can see below, the type signature indicates a value of type+-- @Q Exp@ will be returned. In order to convert this into a @ByteString@, you+-- must use Template Haskell syntax, e.g.:+--+-- > $(embedFile "myfile.txt")+--+-- This expression will have type @ByteString@. Be certain to enable the+-- TemplateHaskell language extension, usually by adding the following to the+-- top of your module:+--+-- > {-# LANGUAGE TemplateHaskell #-}+module Data.FileEmbed+ ( -- * Embed at compile time+ embedFile+ , embedOneFileOf+ , embedDir+ -- * Relative path manipulation+ , makeRelativeToProject+ ) where++import Language.Haskell.TH.Syntax+ ( Exp (AppE, ListE, LitE, TupE, SigE, VarE)+ , Lit (StringL)+ , Q+ , runIO+ , qLocation, loc_filename+#if MIN_VERSION_template_haskell(2, 7, 0)+ , Quasi(qAddDependentFile)+#endif+ )+import System.Directory (doesDirectoryExist, doesFileExist,+ getDirectoryContents, canonicalizePath)+import Control.Applicative ((<|>), (<$>))+import Control.Exception (throw, ErrorCall(..))+import Control.Monad (filterM)+import Control.Arrow ((&&&), second)+import System.FilePath ((</>), takeDirectory, takeExtension)+import Data.String (IsString, fromString)+import Prelude as P+++-- | Embed a single file in your source code.+--+-- > import Data.String+-- >+-- > myFile :: IsString a => a+-- > myFile = $(embedFile "dirName/fileName")+embedFile :: FilePath -> Q Exp+embedFile fp =+#if MIN_VERSION_template_haskell(2, 7, 0)+ qAddDependentFile fp >>+#endif+ (runIO $ readFile fp) >>= toExp++-- | Embed a single existing string file in your source code+-- out of list a list of paths supplied.+embedOneFileOf :: [FilePath] -> Q Exp+embedOneFileOf ps =+ (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do+#if MIN_VERSION_template_haskell(2, 7, 0)+ qAddDependentFile path+#endif+ toExp content+ where+ readExistingFile :: [FilePath] -> IO (FilePath, String)+ readExistingFile xs = do+ ys <- filterM doesFileExist xs+ case ys of+ (p:_) -> readFile p >>= \ c -> return ( p, c )+ _ -> throw $ ErrorCall "Cannot find file to embed as resource"++-- | Embed a directory recursively in your source code.+--+-- > import Data.String+-- >+-- > myDir :: IsString a => [(FilePath, a)]+-- > myDir = $(embedDir "dirName")+embedDir :: FilePath -> Q Exp+embedDir fp = do+ typ <- [t| forall a. IsString a => [(FilePath, a)] |]+ e <- ListE <$> ((runIO $ getDir) >>= mapM (pairToExp fp))+ return $ SigE e typ+ where + getDir = fileList fp ""++ pairToExp :: FilePath -> (FilePath, String) -> Q Exp+ pairToExp _root (path, bs) = do+#if MIN_VERSION_template_haskell(2, 7, 0)+ qAddDependentFile $ _root ++ '/' : path+#endif+ exp' <- toExp bs+ return $! TupE [LitE $ StringL path, exp']++fileList :: FilePath -> FilePath -> IO [(FilePath, String)]+fileList realTop top = do+ allContents <- filter notHidden <$> getDirectoryContents (realTop </> top)+ let all' = map ((top </>) &&& (\x -> realTop </> top </> x)) allContents+ files <- filterM (doesFileExist . snd) all' >>=+ mapM (liftPair2 . second readFile)+ dirs <- filterM (doesDirectoryExist . snd) all' >>=+ mapM (fileList realTop . fst)+ return $ concat $ files : dirs+ where+ notHidden :: FilePath -> Bool+ notHidden ('.':_) = False+ notHidden _ = True++ liftPair2 :: Monad m => (a, m b) -> m (a, b)+ liftPair2 (a, b) = b >>= \b' -> return (a, b')++toExp :: String -> Q Exp+toExp s =+ return $ VarE 'fromString+ `AppE` LitE (StringL s)++-- | Take a relative file path and attach it to the root of the current+-- project.+--+-- The idea here is that, when building with Stack, the build will always be+-- executed with a current working directory of the root of the project (where+-- your .cabal file is located). However, if you load up multiple projects with+-- @stack ghci@, the working directory may be something else entirely.+--+-- This function looks at the source location of the Haskell file calling it,+-- finds the first parent directory with a .cabal file, and uses that as the+-- root directory for fixing the relative path.+--+-- > $(makeRelativeToProject "data/foo.txt" >>= embedFile)+--+-- @since 0.0.10+makeRelativeToProject :: FilePath -> Q FilePath+makeRelativeToProject rel = do+ loc <- qLocation+ runIO $ do+ srcFP <- canonicalizePath $ loc_filename loc+ mdir <- findProjectDir srcFP+ case mdir of+ Nothing -> error $ "Could not find .cabal file for path: " ++ srcFP+ Just dir -> return $ dir </> rel+ where+ findProjectDir x = do+ let dir = takeDirectory x+ if dir == x+ then return Nothing+ else do+ contents <- getDirectoryContents dir+ if any isCabalFile contents+ then return (Just dir)+ else findProjectDir dir++ isCabalFile fp = takeExtension fp == ".cabal"
+ Data/FileEmbed/Inject.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.FileEmbed.Inject (+ -- * Inject into an executable+ -- $inject+ dummySpace+ , dummySpaceWith+ , inject+ , injectFile+ , injectWith+ , injectFileWith+ ) where++import Language.Haskell.TH.Syntax (Exp (LitE), Lit (StringPrimL), Q)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import Data.ByteString.Unsafe (unsafePackAddressLen)+import System.IO.Unsafe (unsafePerformIO)+import Prelude as P++magic :: B.ByteString -> B.ByteString+magic x = B8.concat ["fe", x]++sizeLen :: Int+sizeLen = 20++getInner :: B.ByteString -> B.ByteString+getInner b =+ let (sizeBS, rest) = B.splitAt sizeLen b+ in case reads $ B8.unpack sizeBS of+ (i, _):_ -> B.take i rest+ [] -> error "Data.FileEmbed (getInner): Your dummy space has been corrupted."++padSize :: Int -> String+padSize i =+ let s = show i+ in replicate (sizeLen - length s) '0' ++ s++-- | Allocate the given number of bytes in the generate executable. That space+-- can be filled up with the 'inject' and 'injectFile' functions.+dummySpace :: Int -> Q Exp+dummySpace = dummySpaceWith "MS"++-- | Like 'dummySpace', but takes a postfix for the magic string. In+-- order for this to work, the same postfix must be used by 'inject' /+-- 'injectFile'. This allows an executable to have multiple+-- 'ByteString's injected into it, without encountering collisions.+--+-- Since 0.0.8+dummySpaceWith :: B.ByteString -> Int -> Q Exp+dummySpaceWith postfix space = do+ let size = padSize space+ magic' = magic postfix+ start = B8.unpack magic' ++ size+ magicLen = B8.length magic'+ len = magicLen + sizeLen + space+ chars = LitE $ StringPrimL $+#if MIN_VERSION_template_haskell(2, 6, 0)+ map (toEnum . fromEnum) $+#endif+ start ++ replicate space '0'+ [| getInner (B.drop magicLen (unsafePerformIO (unsafePackAddressLen len $(return chars)))) |]++-- | Inject some raw data inside a @ByteString@ containing empty, dummy space+-- (allocated with @dummySpace@). Typically, the original @ByteString@ is an+-- executable read from the filesystem.+inject :: B.ByteString -- ^ bs to inject+ -> B.ByteString -- ^ original BS containing dummy+ -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space+inject = injectWith "MS"++-- | Like 'inject', but takes a postfix for the magic string.+--+-- Since 0.0.8+injectWith :: B.ByteString -- ^ postfix of magic string+ -> B.ByteString -- ^ bs to inject+ -> B.ByteString -- ^ original BS containing dummy+ -> Maybe B.ByteString -- ^ new BS, or Nothing if there is insufficient dummy space+injectWith postfix toInj orig =+ if toInjL > size+ then Nothing+ else Just $ B.concat [before, magic', B8.pack $ padSize toInjL, toInj, B8.pack $ replicate (size - toInjL) '0', after]+ where+ magic' = magic postfix+ toInjL = B.length toInj+ (before, rest) = B.breakSubstring magic' orig+ (sizeBS, rest') = B.splitAt sizeLen $ B.drop (B8.length magic') rest+ size = case reads $ B8.unpack sizeBS of+ (i, _):_ -> i+ [] -> error $ "Data.FileEmbed (inject): Your dummy space has been corrupted. Size is: " ++ show sizeBS+ after = B.drop size rest'++-- | Same as 'inject', but instead of performing the injecting in memory, read+-- the contents from the filesystem and write back to a different file on the+-- filesystem.+injectFile :: B.ByteString -- ^ bs to inject+ -> FilePath -- ^ template file+ -> FilePath -- ^ output file+ -> IO ()+injectFile = injectFileWith "MS"++-- | Like 'injectFile', but takes a postfix for the magic string.+--+-- Since 0.0.8+injectFileWith :: B.ByteString -- ^ postfix of magic string+ -> B.ByteString -- ^ bs to inject+ -> FilePath -- ^ template file+ -> FilePath -- ^ output file+ -> IO ()+injectFileWith postfix inj srcFP dstFP = do+ src <- B.readFile srcFP+ case injectWith postfix inj src of+ Nothing -> error "Insufficient dummy space"+ Just dst -> B.writeFile dstFP dst++{- $inject++The inject system allows arbitrary content to be embedded inside a Haskell+executable, post compilation. Typically, file-embed allows you to read some+contents from the file system at compile time and embed them inside your+executable. Consider a case, instead, where you would want to embed these+contents after compilation. Two real-world examples are:++* 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.)++* 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.++The typical workflow use:++* Use 'dummySpace' or 'dummySpaceWith' to create some empty space in your executable++* Use 'injectFile' or 'injectFileWith' from a separate utility to modify that executable to have the updated content.++The reason for the @With@-variant of the functions is for cases where you wish+to inject multiple different kinds of content, and therefore need control over+the magic key. If you know for certain that there will only be one dummy space+available, you can use the non-@With@ variants.++-}
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2008, Michael Snoyman. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,4 @@+## file-embed++Use Template Haskell to read a file or all the files in a directory, and turn+them into (path, bytestring) pairs embedded in your haskell code.
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ file-embed-poly.cabal view
@@ -0,0 +1,53 @@+name: file-embed-poly+version: 0.1.0+license: BSD3+license-file: LICENSE+author: Michael Snoyman <michael@snoyman.com>, Alexis Williams <sasinestro@gmail.com>+maintainer: Alexis Williams <sasinestro@gmail.com>+synopsis: Use Template Haskell to embed file contents directly.+description: Use Template Haskell to read a file or all the files in a+ directory, and turn them into (path, IsString) pairs+ embedded in your haskell code.++ This is a (hopefully temporary) fork of the original file-embed by Micheal Snoyman.+category: Data+stability: Stable+cabal-version: >= 1.8+build-type: Simple+homepage: https://github.com/sasinestro/file-embed+extra-source-files: test/injection-test/*.hs+ , test/sample/.hidden, test/sample/bar, test/sample/baz, test/sample/bin, test/sample/binary+ , ChangeLog.md+ README.md++flag test-injection+ description: Builds the test that ensures that embedded file injection works. It's mostly seperate and it pulls in more dependencies.+ default: False++library+ build-depends: base >= 4 && < 5+ , bytestring >= 0.9.1.4+ , directory >= 1.0.0.3+ , template-haskell >= 2.5.0.0+ , filepath+ exposed-modules: Data.FileEmbed+ , Data.FileEmbed.Inject+ ghc-options: -Wall++test-suite test+ type: exitcode-stdio-1.0+ main-is: main.hs+ hs-source-dirs: test+ build-depends: base+ , bytestring+ , directory+ , file-embed+ , filepath+ , hspec >= 2.1+ if flag(test-injection)+ build-depends: shelly >= 1.6.1+ cpp-options: -DTEST_INJECTION++source-repository head+ type: git+ location: https://github.com/sasinestro/file-embed
+ test/injection-test/inject.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE OverloadedStrings #-}+import Data.FileEmbed.Inject++main = injectFile "Hello World" "template" "injected"
+ test/injection-test/template.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE TemplateHaskell #-}+import Data.FileEmbed.Inject++main = print $(dummySpace 100)
+ test/main.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Main (main) where++import Test.Hspec++#ifdef TEST_INJECTION+import Shelly (shelly, silently, run, run_, findWhen, hasExt, toTextIgnore, pwd, chdir, get_env_text, setenv, appendToPath) +#endif ++import Control.Applicative ((<$>))+import Control.Arrow ((&&&), second)+import Control.Monad (filterM, mapM)+import Data.FileEmbed+import qualified Data.ByteString as B+import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents)+import System.FilePath ((</>))++getDir :: FilePath -> IO [(FilePath, B.ByteString)]+getDir top = getDir' top ""+ where+ notHidden :: FilePath -> Bool+ notHidden ('.':_) = False+ notHidden _ = True++ liftPair2 :: Monad m => (a, m b) -> m (a, b)+ liftPair2 (a, b) = b >>= \b' -> return (a, b')++ getDir' :: FilePath -> FilePath -> IO [(FilePath, B.ByteString)]+ getDir' realTop top = do+ allContents <- filter notHidden <$> getDirectoryContents (realTop </> top)+ let all' = map ((top </>) &&& (\x -> realTop </> top </> x)) allContents+ files <- filterM (doesFileExist . snd) all' >>=+ mapM (liftPair2 . second B.readFile)+ dirs <- filterM (doesDirectoryExist . snd) all' >>=+ mapM (getDir' realTop . fst)+ return $ concat $ files : dirs++shouldReturn' :: (Show a, Eq a) => a -> IO a -> Expectation+shouldReturn' = flip shouldReturn++main :: IO ()+main = hspec . describe "Data.FileEmbed" $ do+ describe "embedFile" $ do+ it "handles text files" $ ($(embedFile "test/sample/bar") :: B.ByteString) `shouldReturn'` B.readFile "test/sample/bar"+ it "handles binary files" $ ($(embedFile "test/sample/binary") :: B.ByteString) `shouldReturn'` B.readFile "test/sample/binary"+ + describe "embedDir" $ do+ let sampleDir = $(embedDir "test/sample") :: [(FilePath, B.ByteString)]+ correct <- runIO $ Main.getDir "test/sample"+ it "handles text and binary files" $ sampleDir `shouldBe` correct+#ifdef TEST_INJECTION+ describe "Data.FileEmbed.Inject" $ do+ it "correctly injects data into a binary" $ (shelly . chdir "test/injection-test" $ do+ path <- get_env_text "PATH"+ appendToPath =<< pwd+ -- Build template and run injector+ silently $ run_ "stack" ["ghc", "--", "template.hs"]+ run_ "stack" ["runghc", "--", "inject.hs"]+ -- Set injected file as executable and run it+ run_ "chmod" ["+x", "injected"]+ out <- silently $ run "injected" []+ -- Clean up+ run "rm" =<< (map toTextIgnore) <$> findWhen (return . not . hasExt "hs") "."+ setenv "PATH" path+ return out) `shouldReturn` "\"Hello World\"\n"+#endif
+ test/sample/bar view
@@ -0,0 +1,1 @@+bar bar bar
+ test/sample/baz view
@@ -0,0 +1,1 @@+baz baz baz
+ test/sample/bin view
@@ -0,0 +1,1 @@+bin bin bin
+ test/sample/binary view
binary file changed (absent → 7 bytes)