file-embed 0.0.7 → 0.0.16.0
raw patch · 5 files changed
Files
- ChangeLog.md +61/−0
- Data/FileEmbed.hs +259/−32
- README.md +6/−0
- file-embed.cabal +12/−8
- test/main.hs +17/−3
+ ChangeLog.md view
@@ -0,0 +1,61 @@+# ChangeLog for file-embed++## 0.0.16.0++* Add `embedFileRelative`++## 0.0.15.0++* Add `makeRelativeToLocationPredicate`++## 0.0.14.0++* Add `embedFileIfExists`++## 0.0.13.0++* Ensure that directory listings are returned in sorted order for reproducibility [yesodweb/yesod#1684](https://github.com/yesodweb/yesod/issues/1684)++## 0.0.12.0++* Use the `Bytes` literal on newer GHCs to reduce memory usage during compilation [#36](https://github.com/snoyberg/file-embed/pull/36)++## 0.0.11.2++* Haddock markup fix++## 0.0.11.1++* Support GHC 8.10++## 0.0.11++* embedDirListing [#26](https://github.com/snoyberg/file-embed/pull/26)++## 0.0.10.1++* Minor doc improvements++## 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
@@ -1,8 +1,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} -- | 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 exceutable+-- 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@@ -18,44 +19,64 @@ module Data.FileEmbed ( -- * Embed at compile time embedFile+ , embedFileRelative+ , embedFileIfExists , embedOneFileOf , embedDir+ , embedDirListing , getDir+ -- * Embed as a IsString+ , embedStringFile+ , embedOneStringFileOf -- * Inject into an executable+ -- $inject #if MIN_VERSION_template_haskell(2,5,0) , dummySpace+ , dummySpaceWith #endif , inject , injectFile+ , injectWith+ , injectFileWith+ -- * Relative path manipulation+ , makeRelativeToProject+ , makeRelativeToLocationPredicate -- * Internal , stringToBs , bsToExp+ , strToExp ) where import Language.Haskell.TH.Syntax ( Exp (AppE, ListE, LitE, TupE, SigE, VarE)-#if MIN_VERSION_template_haskell(2,5,0)- , Lit (StringL, StringPrimL, IntegerL)-#else- , Lit (StringL, IntegerL)-#endif+ , Lit (..) , Q , runIO+ , qLocation, loc_filename #if MIN_VERSION_template_haskell(2,7,0) , Quasi(qAddDependentFile) #endif )+#if MIN_VERSION_template_haskell(2,16,0)+import Language.Haskell.TH ( mkBytes, bytesPrimL )+import qualified Data.ByteString.Internal as B+#endif import System.Directory (doesDirectoryExist, doesFileExist,- getDirectoryContents)-import Control.Exception (throw, ErrorCall(..))-import Control.Monad (filterM)+ getDirectoryContents, canonicalizePath)+import Control.Exception (throw, tryJust, ErrorCall(..))+import Control.Monad ((<=<), filterM, guard) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import Control.Arrow ((&&&), second) import Control.Applicative ((<$>)) import Data.ByteString.Unsafe (unsafePackAddressLen)+import System.IO.Error (isDoesNotExistError) import System.IO.Unsafe (unsafePerformIO)-import System.FilePath ((</>))+import System.FilePath ((</>), takeDirectory, takeExtension)+import Data.String (fromString)+import Prelude as P+import Data.List (sortBy)+import Data.Ord (comparing) -- | Embed a single file in your source code. --@@ -70,13 +91,46 @@ #endif (runIO $ B.readFile fp) >>= bsToExp +-- | Embed a single file in your source code.+-- Unlike 'embedFile', path is given relative to project root.+-- @since 0.0.16.0+embedFileRelative :: FilePath -> Q Exp+embedFileRelative = embedFile <=< makeRelativeToProject++-- | Maybe embed a single file in your source code depending on whether or not file exists.+--+-- Warning: When a build is compiled with the file missing, a recompile when the file exists might not trigger an embed of the file.+-- You might try to fix this by doing a clean build.+--+-- > import qualified Data.ByteString+-- >+-- > maybeMyFile :: Maybe Data.ByteString.ByteString+-- > maybeMyFile = $(embedFileIfExists "dirName/fileName")+--+-- @since 0.0.14.0+embedFileIfExists :: FilePath -> Q Exp+embedFileIfExists fp = do+ mbs <- runIO maybeFile+ case mbs of+ Nothing -> [| Nothing |]+ Just bs -> do+#if MIN_VERSION_template_haskell(2,7,0)+ qAddDependentFile fp+#endif+ [| Just $(bsToExp bs) |]+ where+ maybeFile :: IO (Maybe B.ByteString)+ maybeFile = + either (const Nothing) Just <$> + tryJust (guard . isDoesNotExistError) (B.readFile fp)+ -- | Embed a single existing file in your source code -- out of list a list of paths supplied. -- -- > import qualified Data.ByteString -- > -- > myFile :: Data.ByteString.ByteString--- > myFile = $(embedFile' [ "dirName/fileName", "src/dirName/fileName" ])+-- > myFile = $(embedOneFileOf [ "dirName/fileName", "src/dirName/fileName" ]) embedOneFileOf :: [FilePath] -> Q Exp embedOneFileOf ps = (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do@@ -104,6 +158,18 @@ e <- ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp)) return $ SigE e typ +-- | Embed a directory listing recursively in your source code.+--+-- > myFiles :: [FilePath]+-- > myFiles = $(embedDirListing "dirName")+--+-- @since 0.0.11+embedDirListing :: FilePath -> Q Exp+embedDirListing fp = do+ typ <- [t| [FilePath] |]+ e <- ListE <$> ((runIO $ fmap fst <$> fileList fp) >>= mapM strToExp)+ return $ SigE e typ+ -- | Get a directory tree in the IO monad. -- -- This is the workhorse of 'embedDir'@@ -116,7 +182,11 @@ qAddDependentFile $ _root ++ '/' : path #endif exp' <- bsToExp bs- return $! TupE [LitE $ StringL path, exp']+ return $! TupE+#if MIN_VERSION_template_haskell(2,16,0)+ $ map Just+#endif+ [LitE $ StringL path, exp'] bsToExp :: B.ByteString -> Q Exp #if MIN_VERSION_template_haskell(2, 5, 0)@@ -124,7 +194,11 @@ return $ VarE 'unsafePerformIO `AppE` (VarE 'unsafePackAddressLen `AppE` LitE (IntegerL $ fromIntegral $ B8.length bs)-#if MIN_VERSION_template_haskell(2, 8, 0)+#if MIN_VERSION_template_haskell(2, 16, 0)+ `AppE` LitE (bytesPrimL (+ let B.PS ptr off sz = bs+ in mkBytes ptr (fromIntegral off) (fromIntegral sz))))+#elif MIN_VERSION_template_haskell(2, 8, 0) `AppE` LitE (StringPrimL $ B.unpack bs)) #else `AppE` LitE (StringPrimL $ B8.unpack bs))@@ -139,6 +213,51 @@ stringToBs :: String -> B.ByteString stringToBs = B8.pack +-- | Embed a single file in your source code.+--+-- > import Data.String+-- >+-- > myFile :: IsString a => a+-- > myFile = $(embedStringFile "dirName/fileName")+--+-- Since 0.0.9+embedStringFile :: FilePath -> Q Exp+embedStringFile fp =+#if MIN_VERSION_template_haskell(2,7,0)+ qAddDependentFile fp >>+#endif+ (runIO $ P.readFile fp) >>= strToExp++-- | Embed a single existing string file in your source code+-- out of list a list of paths supplied.+--+-- Since 0.0.9+embedOneStringFileOf :: [FilePath] -> Q Exp+embedOneStringFileOf ps =+ (runIO $ readExistingFile ps) >>= \ ( path, content ) -> do+#if MIN_VERSION_template_haskell(2,7,0)+ qAddDependentFile path+#endif+ strToExp content+ where+ readExistingFile :: [FilePath] -> IO ( FilePath, String )+ readExistingFile xs = do+ ys <- filterM doesFileExist xs+ case ys of+ (p:_) -> P.readFile p >>= \ c -> return ( p, c )+ _ -> throw $ ErrorCall "Cannot find file to embed as resource"++strToExp :: String -> Q Exp+#if MIN_VERSION_template_haskell(2, 5, 0)+strToExp s =+ return $ VarE 'fromString+ `AppE` LitE (StringL s)+#else+strToExp s = do+ helper <- [| fromString |]+ return $! AppE helper $! LitE $! StringL s+#endif+ notHidden :: FilePath -> Bool notHidden ('.':_) = False notHidden _ = True@@ -154,20 +273,20 @@ mapM (liftPair2 . second B.readFile) dirs <- filterM (doesDirectoryExist . snd) all' >>= mapM (fileList' realTop . fst)- return $ concat $ files : dirs+ return $ sortBy (comparing fst) $ concat $ files : dirs liftPair2 :: Monad m => (a, m b) -> m (a, b) liftPair2 (a, b) = b >>= \b' -> return (a, b') -magic :: String-magic = concat ["fe", "MS"]+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.drop (length magic) 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."@@ -178,44 +297,152 @@ in replicate (sizeLen - length s) '0' ++ s #if MIN_VERSION_template_haskell(2,5,0)+-- | 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 space = do+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- let start = magic ++ size- let chars = LitE $ StringPrimL $+ 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'- let len = LitE $ IntegerL $ fromIntegral $ length start + space- upi <- [|unsafePerformIO|]- pack <- [|unsafePackAddressLen|]- getInner' <- [|getInner|]- return $ getInner' `AppE` (upi `AppE` (pack `AppE` len `AppE` chars))+ [| getInner (B.drop magicLen (unsafePerformIO (unsafePackAddressLen len $(return chars)))) |] #endif +-- | 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 toInj orig =+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, B8.pack magic, B8.pack $ padSize toInjL, toInj, B8.pack $ replicate (size - toInjL) '0', after]+ 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 (B8.pack magic) orig- (sizeBS, rest') = B.splitAt sizeLen $ B.drop (length magic) rest+ (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' -injectFile :: B.ByteString+-- | 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 inj srcFP dstFP = do+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 inject inj src of+ 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.++-}++-- | 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 = makeRelativeToLocationPredicate $ (==) ".cabal" . takeExtension++-- | 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+--+-- This function looks at the source location of the Haskell file calling it,+-- finds the first parent directory with a file matching the given predicate, and uses that as the+-- root directory for fixing the relative path.+--+-- @$(makeRelativeToLocationPredicate ((==) ".cabal" . takeExtension) "data/foo.txt" >>= embedFile)@+--+-- @since 0.0.15.0+makeRelativeToLocationPredicate :: (FilePath -> Bool) -> FilePath -> Q FilePath+makeRelativeToLocationPredicate isTargetFile 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 isTargetFile contents+ then return (Just dir)+ else findProjectDir dir
+ README.md view
@@ -0,0 +1,6 @@+## 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.
file-embed.cabal view
@@ -1,22 +1,25 @@ name: file-embed-version: 0.0.7-license: BSD3+version: 0.0.16.0+license: BSD2 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com> maintainer: Michael Snoyman <michael@snoyman.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, text) pairs embedded- in your haskell code.+ directory, and turn them into (path, bytestring) pairs+ embedded in your Haskell code. category: Data stability: Stable-cabal-version: >= 1.8+cabal-version: >= 1.10 build-type: Simple homepage: https://github.com/snoyberg/file-embed-extra-source-files: test/main.hs, test/sample/foo, test/sample/bar/baz+extra-source-files: test/main.hs, test/sample/foo, test/sample/bar/baz,+ ChangeLog.md+ README.md library- build-depends: base >= 4 && < 5+ default-language: Haskell2010+ build-depends: base >= 4.9.1 && < 5 , bytestring >= 0.9.1.4 , directory >= 1.0.0.3 , template-haskell@@ -25,12 +28,13 @@ ghc-options: -Wall test-suite test+ default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: main.hs hs-source-dirs: test build-depends: base+ , bytestring , file-embed- , HUnit , filepath source-repository head
test/main.hs view
@@ -1,14 +1,28 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} +import Control.Monad (unless)+import qualified Data.ByteString as B (ByteString, filter) import Data.FileEmbed-import Test.HUnit ((@?=)) import System.FilePath ((</>)) +infix 1 @?=++(@?=) :: (Eq a, Show a) => a -> a -> IO ()+actual @?= expected = unless (actual == expected) (error $ "expected: " ++ show expected ++ "\n but got: " ++ show actual)+ main :: IO () main = do let received = $(embedDir "test/sample") received @?=- [ ("foo", "foo\r\n")- , ("bar" </> "baz", "baz\r\n")+ [ ("bar" </> "baz", "baz\r\n")+ , ("foo", "foo\r\n") ]+ let str = $(embedStringFile "test/sample/foo") :: String+ filter (/= '\r') str @?= "foo\n"++ let mbs = $(embedFileIfExists "test/sample/foo")+ fmap (B.filter (/= fromIntegral (fromEnum '\r'))) mbs @?= Just "foo\n"++ let mbs2 = $(embedFileIfExists "test/sample/foo2") :: Maybe B.ByteString+ mbs2 @?= Nothing