file-embed 0.0.4.3 → 0.0.4.4

raw patch · 6 files changed

+233/−231 lines, 6 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/FileEmbed.hs +162/−160
• LICENSE +25/−25
• Setup.lhs +7/−7
• file-embed.cabal +32/−32
• test/main.hs +6/−6
• test/sample/foo +1/−1

@@ -1,160 +1,162 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE CPP #-}-module Data.FileEmbed-    ( -- * Embed at compile time-      embedFile-    , embedDir-    , getDir-      -- * Inject into an executable-#if MIN_VERSION_template_haskell(2,5,0)-    , dummySpace-#endif-    , inject-    , injectFile-    ) where--import Language.Haskell.TH.Syntax-    ( runQ-    , Exp (AppE, ListE, LitE, TupE)-#if MIN_VERSION_template_haskell(2,5,0)-    , Lit (StringL, StringPrimL, IntegerL)-#else-    , Lit (StringL, IntegerL)-#endif-    , Q-    , runIO-#if MIN_VERSION_template_haskell(2,7,0)-    , Quasi(qAddDependentFile)-#endif-    )-import System.Directory (doesDirectoryExist, doesFileExist,-                         getDirectoryContents)-import Control.Monad (filterM)-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import Control.Arrow ((&&&), second, first)-import Control.Applicative ((<$>))-import Data.Monoid (mappend)-import Data.ByteString.Unsafe (unsafePackAddressLen)-import System.IO.Unsafe (unsafePerformIO)---- | Embed a single file in your source code.------ > import qualified Data.ByteString--- >--- > myFile :: Data.ByteString.ByteString--- > myFile = $(embedFile "dirName/fileName")-embedFile :: FilePath -> Q Exp-embedFile fp =-#if MIN_VERSION_template_haskell(2,7,0)-    qAddDependentFile fp >>-#endif-  (runIO $ B.readFile fp) >>= bsToExp---- | Embed a directory recusrively in your source code.------ > import qualified Data.ByteString--- >--- > myDir :: [(FilePath, Data.ByteString.ByteString)]--- > myDir = $(embedDir "dirName")-embedDir :: FilePath -> Q Exp-embedDir fp = ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))---- | Get a directory tree in the IO monad.------ This is the workhorse of 'embedDir'-getDir :: FilePath -> IO [(FilePath, B.ByteString)]-getDir = fileList--pairToExp :: FilePath -> (FilePath, B.ByteString) -> Q Exp-pairToExp root (path, bs) = do-#if MIN_VERSION_template_haskell(2,7,0)-    qAddDependentFile $ root ++ '/' : path-#endif-    exp' <- bsToExp bs-    return $! TupE [LitE $ StringL path, exp']--bsToExp :: B.ByteString -> Q Exp-bsToExp bs = do-    helper <- [| stringToBs |]-    let chars = B8.unpack bs-    return $! AppE helper $! LitE $! StringL chars--stringToBs :: String -> B.ByteString-stringToBs = B8.pack--notHidden :: FilePath -> Bool-notHidden ('.':_) = False-notHidden _ = True--fileList :: FilePath -> IO [(FilePath, B.ByteString)]-fileList top = map (first tail) <$> fileList' top ""--fileList' :: FilePath -> FilePath -> IO [(FilePath, B.ByteString)]-fileList' realTop top = do-    let prefix1 = top ++ "/"-        prefix2 = realTop ++ prefix1-    allContents <- filter notHidden <$> getDirectoryContents prefix2-    let all' = map (mappend prefix1 &&& mappend prefix2) allContents-    files <- filterM (doesFileExist . snd) all' >>=-             mapM (liftPair2 . second B.readFile)-    dirs <- filterM (doesDirectoryExist . snd) all' >>=-            mapM (fileList' realTop . fst)-    return $ concat $ files : dirs--liftPair2 :: Monad m => (a, m b) -> m (a, b)-liftPair2 (a, b) = b >>= \b' -> return (a, b')--magic = concat ["fe", "MS"]-sizeLen = 20--getInner :: B.ByteString -> B.ByteString-getInner b =-    let (sizeBS, rest) = B.splitAt sizeLen $ B.drop (length magic) 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--#if MIN_VERSION_template_haskell(2,5,0)-dummySpace :: Int -> Q Exp-dummySpace space = do-    let size = padSize space-    let start = magic ++ size-    let chars = LitE $ StringPrimL $ 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))-#endif--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 =-    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]-  where-    toInjL = B.length toInj-    (before, rest) = B.breakSubstring (B8.pack magic) orig-    (sizeBS, rest') = B.splitAt sizeLen $ B.drop (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-    (dummy, after) = B.splitAt size rest'--injectFile :: B.ByteString-           -> FilePath -- ^ template file-           -> FilePath -- ^ output file-           -> IO ()-injectFile inj srcFP dstFP = do-    src <- B.readFile srcFP-    case inject inj src of-        Nothing -> error "Insufficient dummy space"-        Just dst -> B.writeFile dstFP dst+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE CPP #-}
+module Data.FileEmbed
+    ( -- * Embed at compile time
+      embedFile
+    , embedDir
+    , getDir
+      -- * Inject into an executable
+#if MIN_VERSION_template_haskell(2,5,0)
+    , dummySpace
+#endif
+    , inject
+    , injectFile
+    ) where
+
+import Language.Haskell.TH.Syntax
+    ( Exp (AppE, ListE, LitE, TupE)
+#if MIN_VERSION_template_haskell(2,5,0)
+    , Lit (StringL, StringPrimL, IntegerL)
+#else
+    , Lit (StringL, IntegerL)
+#endif
+    , Q
+    , runIO
+#if MIN_VERSION_template_haskell(2,7,0)
+    , Quasi(qAddDependentFile)
+#endif
+    )
+import System.Directory (doesDirectoryExist, doesFileExist,
+                         getDirectoryContents)
+import Control.Monad (filterM)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as B8
+import Control.Arrow ((&&&), second, first)
+import Control.Applicative ((<$>))
+import Data.Monoid (mappend)
+import Data.ByteString.Unsafe (unsafePackAddressLen)
+import System.IO.Unsafe (unsafePerformIO)
+
+-- | Embed a single file in your source code.
+--
+-- > import qualified Data.ByteString
+-- >
+-- > myFile :: Data.ByteString.ByteString
+-- > myFile = $(embedFile "dirName/fileName")
+embedFile :: FilePath -> Q Exp
+embedFile fp =
+#if MIN_VERSION_template_haskell(2,7,0)
+    qAddDependentFile fp >>
+#endif
+  (runIO $ B.readFile fp) >>= bsToExp
+
+-- | Embed a directory recusrively in your source code.
+--
+-- > import qualified Data.ByteString
+-- >
+-- > myDir :: [(FilePath, Data.ByteString.ByteString)]
+-- > myDir = $(embedDir "dirName")
+embedDir :: FilePath -> Q Exp
+embedDir fp = ListE <$> ((runIO $ fileList fp) >>= mapM (pairToExp fp))
+
+-- | Get a directory tree in the IO monad.
+--
+-- This is the workhorse of 'embedDir'
+getDir :: FilePath -> IO [(FilePath, B.ByteString)]
+getDir = fileList
+
+pairToExp :: FilePath -> (FilePath, B.ByteString) -> Q Exp
+pairToExp _root (path, bs) = do
+#if MIN_VERSION_template_haskell(2,7,0)
+    qAddDependentFile $ _root ++ '/' : path
+#endif
+    exp' <- bsToExp bs
+    return $! TupE [LitE $ StringL path, exp']
+
+bsToExp :: B.ByteString -> Q Exp
+bsToExp bs = do
+    helper <- [| stringToBs |]
+    let chars = B8.unpack bs
+    return $! AppE helper $! LitE $! StringL chars
+
+stringToBs :: String -> B.ByteString
+stringToBs = B8.pack
+
+notHidden :: FilePath -> Bool
+notHidden ('.':_) = False
+notHidden _ = True
+
+fileList :: FilePath -> IO [(FilePath, B.ByteString)]
+fileList top = map (first tail) <$> fileList' top ""
+
+fileList' :: FilePath -> FilePath -> IO [(FilePath, B.ByteString)]
+fileList' realTop top = do
+    let prefix1 = top ++ "/"
+        prefix2 = realTop ++ prefix1
+    allContents <- filter notHidden <$> getDirectoryContents prefix2
+    let all' = map (mappend prefix1 &&& mappend prefix2) allContents
+    files <- filterM (doesFileExist . snd) all' >>=
+             mapM (liftPair2 . second B.readFile)
+    dirs <- filterM (doesDirectoryExist . snd) all' >>=
+            mapM (fileList' realTop . fst)
+    return $ concat $ files : dirs
+
+liftPair2 :: Monad m => (a, m b) -> m (a, b)
+liftPair2 (a, b) = b >>= \b' -> return (a, b')
+
+magic :: [Char]
+magic = concat ["fe", "MS"]
+
+sizeLen :: Int
+sizeLen = 20
+
+getInner :: B.ByteString -> B.ByteString
+getInner b =
+    let (sizeBS, rest) = B.splitAt sizeLen $ B.drop (length magic) 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
+
+#if MIN_VERSION_template_haskell(2,5,0)
+dummySpace :: Int -> Q Exp
+dummySpace space = do
+    let size = padSize space
+    let start = magic ++ size
+    let chars = LitE $ StringPrimL $ 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))
+#endif
+
+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 =
+    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]
+  where
+    toInjL = B.length toInj
+    (before, rest) = B.breakSubstring (B8.pack magic) orig
+    (sizeBS, rest') = B.splitAt sizeLen $ B.drop (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
+           -> FilePath -- ^ template file
+           -> FilePath -- ^ output file
+           -> IO ()
+injectFile inj srcFP dstFP = do
+    src <- B.readFile srcFP
+    case inject inj src of
+        Nothing -> error "Insufficient dummy space"
+        Just dst -> B.writeFile dstFP dst

@@ -1,25 +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.+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.

@@ -1,7 +1,7 @@-#!/usr/bin/env runhaskell--> module Main where-> import Distribution.Simple--> main :: IO ()-> main = defaultMain+#!/usr/bin/env runhaskell
+
+> module Main where
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain

@@ -1,32 +1,32 @@-name:            file-embed-version:         0.0.4.3-license:         BSD3-license-file:    LICENSE-author:          Michael Snoyman <michael@snoyman.com>-maintainer:      Michael Snoyman <michael@snoyman.com>-synopsis:        Use Template Haskell to embed file contents directly.-category:        Data-stability:       Stable-cabal-version:   >= 1.8-build-type:      Simple-homepage:        https://github.com/snoyberg/file-embed-extra-source-files: test/main.hs, test/sample/foo--library-    build-depends:   base >= 4 && < 5,-                     bytestring >= 0.9.1.4 && < 0.10,-                     directory >= 1.0.0.3 && < 1.2,-                     template-haskell-    exposed-modules: Data.FileEmbed-    ghc-options:     -Wall--test-suite test-    type: exitcode-stdio-1.0-    main-is: main.hs-    hs-source-dirs: test-    build-depends: base-                 , file-embed--source-repository head-  type:     git-  location: https://github.com/snoyberg/file-embed+name:            file-embed
+version:         0.0.4.4
+license:         BSD3
+license-file:    LICENSE
+author:          Michael Snoyman <michael@snoyman.com>
+maintainer:      Michael Snoyman <michael@snoyman.com>
+synopsis:        Use Template Haskell to embed file contents directly.
+category:        Data
+stability:       Stable
+cabal-version:   >= 1.8
+build-type:      Simple
+homepage:        https://github.com/snoyberg/file-embed
+extra-source-files: test/main.hs, test/sample/foo
+
+library
+    build-depends:   base >= 4 && < 5,
+                     bytestring >= 0.9.1.4 && < 0.10,
+                     directory >= 1.0.0.3 && < 1.2,
+                     template-haskell
+    exposed-modules: Data.FileEmbed
+    ghc-options:     -Wall
+
+test-suite test
+    type: exitcode-stdio-1.0
+    main-is: main.hs
+    hs-source-dirs: test
+    build-depends: base
+                 , file-embed
+
+source-repository head
+  type:     git
+  location: https://github.com/snoyberg/file-embed

@@ -1,6 +1,6 @@-{-# LANGUAGE TemplateHaskell #-}--import Data.FileEmbed--main :: IO ()-main = print $(embedDir "test/sample")+{-# LANGUAGE TemplateHaskell #-}
+
+import Data.FileEmbed
+
+main :: IO ()
+main = print $(embedDir "test/sample")

@@ -1,1 +1,1 @@-foo+foo