file-embed-lzma (empty) → 0

raw patch · 7 files changed

+307/−0 lines, 7 filesdep +basedep +base-compatdep +bytestringsetup-changed

Dependencies added: base, base-compat, bytestring, directory, file-embed-lzma, filepath, lzma, template-haskell, text, th-lift-instances, transformers

Files

ChangeLog.md +5/−0
LICENSE +30/−0
Setup.hs +2/−0
example/Example.hs +13/−0
example/example.txt +1/−0
file-embed-lzma.cabal +71/−0
src/FileEmbedLzma.hs +185/−0

+ ChangeLog.md view

@@ -0,0 +1,5 @@+# Revision history for file-embed-lzma++## 0++- First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2017, Oleg Grenrus++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.++    * Neither the name of Oleg Grenrus nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ example/Example.hs view

@@ -0,0 +1,13 @@+{-# LANGUAGE TemplateHaskell #-}+module Main (main) where++import Data.Foldable  (for_)+import FileEmbedLzma (embedByteString, embedRecursiveDir)++import qualified Data.ByteString as BS++main :: IO ()+main = do+    BS.putStr $(embedByteString "example/example.txt")+    for_ $(embedRecursiveDir "src") $ \(n, bs) ->+        print (n, BS.length bs)

+ example/example.txt view

@@ -0,0 +1,1 @@+Hello from the inside.

+ file-embed-lzma.cabal view

@@ -0,0 +1,71 @@+cabal-version:       2.0+name:                file-embed-lzma+version:             0++synopsis:            Use Template Haskell to embed (LZMA compressed) data.+description:+  The @file-embed@ package let's embed file and dir contents.+  .+  This package is similar, but also compresses the embedded contents with LZMA.+  That makes resulting object files smaller, at the cost of start up decompression.+  .+  There's also an 'embedRecursiveDir' function.++homepage:            https://github.com/phadej/file-embed-lzma+bug-reports:         https://github.com/phadej/file-embed-lzma/issues+license:             BSD3+license-file:        LICENSE+author:              Oleg Grenrus <oleg.grenrus@iki.fi>+maintainer:          Oleg.Grenrus <oleg.grenrus@iki.fi>+copyright:           (c) 2015-2018 Futurice, 2018 Oleg Grenrus+category:            Data+build-type:          Simple++extra-source-files:  ChangeLog.md example/example.txt++tested-with:+  GHC==7.8.4,+  GHC==7.10.3,+  GHC==8.0.2,+  GHC==8.2.2,+  GHC==8.4.1++source-repository head+  type:      git+  location:  https://github.com/phadej/file-embed-lzma.git++library+  exposed-modules:+    FileEmbedLzma++  -- GHC boot libraries+  build-depends:+      base              >=4.7      && <4.12+    , base-compat       >=0.9.3    && <0.10+    , template-haskell  >=2.9      && <2.14+    , bytestring        >=0.10.4.0 && <0.11+    , transformers      >=0.3.0.0  && <0.6+    , directory         >=1.2.1.0  && <1.4+    , filepath          >=1.3.0.2  && <1.5+    , text              >=1.2.3.0  && <1.3++  -- non bundled dependencies+  build-depends:+      lzma              ^>=0.0.0.3+    , th-lift-instances ^>=0.1.11++  other-extensions:+    OverloadedStrings+    QuasiQuotes+    TemplateHaskell+  hs-source-dirs:      src+  default-language:    Haskell2010++test-suite example+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  main-is:             Example.hs+  hs-source-dirs:      example+  ghc-options:         -Wall+  build-depends:+    base, file-embed-lzma, bytestring

+ src/FileEmbedLzma.hs view

@@ -0,0 +1,185 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE TemplateHaskell   #-}+------------------------------------------------------------+-- |+-- Module      :  FileEmbedLzma+-- Copyright   :  (c) 2015-2018 Futurice, 2018 Oleg Grenrus+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+----------------------------------------------------------------------------+module FileEmbedLzma (+    -- * Embed files+    embedByteString,+    embedLazyByteString,+    embedText,+    embedLazyText,+    -- * Embed directories+    embedDir,+    embedRecursiveDir,+    -- * Internal+    -- ** Directory listing+    listDirectoryFiles,+    listRecursiveDirectoryFiles,+    listDirectoryFilesF,+    -- ** Template Haskell+    lazyBytestringE,+    ) where++import Prelude ()+import Prelude.Compat++import Control.Arrow                    (first)+import Control.Monad                    (forM)+import Control.Monad.Trans.State.Strict (runState, state)+import Data.Foldable                    (for_)+import Data.Functor.Compose             (Compose (..))+import Data.Int                         (Int64)+import Language.Haskell.TH+import Language.Haskell.TH.Syntax       (qAddDependentFile)+import System.Directory+       (doesDirectoryExist, getDirectoryContents)+import System.FilePath                  (makeRelative, (</>))+import System.IO.Unsafe                 (unsafePerformIO)++import qualified Codec.Compression.Lzma  as LZMA+import qualified Data.ByteString         as BS+import qualified Data.ByteString.Lazy    as BSL+import qualified Data.ByteString.Unsafe  as BS.Unsafe+import qualified Data.Text               as T+import qualified Data.Text.Lazy          as TL+import qualified Data.Text.Lazy.Encoding as TLE++import Instances.TH.Lift ()++listRecursiveDirectoryFiles :: FilePath -> IO [(FilePath, BSL.ByteString)]+listRecursiveDirectoryFiles = listDirectoryFilesF listRecursiveDirectoryFiles++listDirectoryFiles  :: FilePath -> IO [(FilePath, BSL.ByteString)]+listDirectoryFiles = listDirectoryFilesF (\_ -> return [])++listDirectoryFilesF+    :: (FilePath -> IO [(FilePath, BSL.ByteString)]) -- ^ what to do with a sub-directory+    -> FilePath -> IO [(FilePath, BSL.ByteString)]+listDirectoryFilesF go topdir = do+    names <- getDirectoryContents topdir+    let properNames = filter (`notElem` [".", ".."]) names+    paths <- forM properNames $ \name -> do+        let path = topdir </> name+        isDirectory <- doesDirectoryExist path+        if isDirectory+        then go path+        else do+            contents <- BSL.readFile path+            return [(path, contents)]+    return (concat paths)++makeAllRelative :: FilePath -> [(FilePath, a)] -> [(FilePath, a)]+makeAllRelative topdir = map (first (("/" ++) . makeRelative topdir))++-- | Makes lazy 'BSL.ByteString' expression.+-- Embedded value is compressed with LZMA.+lazyBytestringE :: BSL.ByteString -> Q Exp+lazyBytestringE lbs =+    [| LZMA.decompress+    $ BSL.fromStrict+    $ unsafePerformIO+    $ BS.Unsafe.unsafePackAddressLen $l $s+    :: BSL.ByteString+    |]+  where+    bs = BSL.toStrict $ LZMA.compressWith params lbs+    s = litE $ stringPrimL $ BS.unpack bs+    l = litE $ integerL $ fromIntegral $ BS.length bs++    params = LZMA.defaultCompressParams+        {- doesn't seem to affect much+        { LZMA.compressLevel = LZMA.CompressionLevel9+        , LZMA.compressLevelExtreme = True+        }+        -}++makeEmbeddedEntry :: Name -> (FilePath, (Int64, Int64)) -> Q Exp+makeEmbeddedEntry name (path, (off, len)) =+    [| (path, BSL.toStrict $ BSL.take len $ BSL.drop off $(varE name)) |]++concatEntries :: Traversable t => t BSL.ByteString -> (BSL.ByteString, t (Int64, Int64))+concatEntries xs = (bslEndo BSL.empty, ys)+  where+    (ys, (_, bslEndo)) = runState (traverse (state . single) xs) (0, id)++    single+        :: BSL.ByteString                             -- file bytestring+        -> (Int64, BSL.ByteString -> BSL.ByteString)  -- current offset, buffer so far+        -> ((Int64, Int64), (Int64, BSL.ByteString -> BSL.ByteString))+    single bsl (off, endo) = ((off, l), (off + l, endo . BSL.append bsl))+      where+        l = fromIntegral $ BSL.length bsl++-------------------------------------------------------------------------------+-- Directories+-------------------------------------------------------------------------------++-- | Embed a @[('FilePath', 'Data.ByteString.ByteString')]@ list, traversing given directory.+embedDir :: FilePath -> Q Exp+embedDir topdir = do+    pairs' <- runIO $ listDirectoryFiles topdir+    for_ pairs' $ qAddDependentFile . fst+    let pairs = makeAllRelative topdir pairs'+    embedPairs pairs++embedPairs :: [(FilePath, BSL.ByteString)] -> Q Exp+embedPairs pairs = do+    -- we do a hop to only embed single big bytestring.+    -- it's beneficial as lzma have more stuff to compress+    let (bsl, Compose offsets) = concatEntries (Compose pairs)+    bslName <- newName "embedBsl"+    bslExpr <- lazyBytestringE bsl+    let e = letE [ return $ ValD (VarP bslName) (NormalB bslExpr) [] ] $+                listE $ map (makeEmbeddedEntry bslName) offsets+    sigE e [t| [(FilePath, BS.ByteString)] |]++-- | Embed a @[('FilePath', 'Data.ByteString.ByteString')]@ list, recursively traversing given directory path.+--+-- For example, with @wai-static-app@ this can be used as:+--+-- @+-- staticApp $ embeddedSettings $('embedRecursiveDir' "static")+-- -- is an embedded (no data-files!) equivalent of+-- staticApp $ defaultFileServerSettings "static"+-- @+embedRecursiveDir :: FilePath -> Q Exp+embedRecursiveDir topdir = do+    pairs' <- runIO $ listRecursiveDirectoryFiles topdir+    for_ pairs' $ qAddDependentFile . fst+    let pairs = makeAllRelative topdir pairs'+    embedPairs pairs++-------------------------------------------------------------------------------+-- Strings+-------------------------------------------------------------------------------++-- | Embed a lazy 'Data.ByteString.Lazy.ByteString' from a file.+embedLazyByteString :: FilePath -> Q Exp+embedLazyByteString fp = do+    qAddDependentFile fp+    bsl <- runIO $ BSL.readFile fp+    lazyBytestringE bsl++-- | Embed a strict 'Data.ByteString.ByteString' from a file.+embedByteString :: FilePath -> Q Exp+embedByteString fp = [| BSL.toStrict $(embedLazyByteString fp) :: BS.ByteString |]++-- | Embed a lazy 'Data.Text.Lazy.Text' from a UTF8-encoded file.+embedLazyText :: FilePath -> Q Exp+embedLazyText fp = do+    qAddDependentFile fp+    bsl <- runIO $ BSL.readFile fp+    case TLE.decodeUtf8' bsl of+        Left e  -> reportError (show e)+        Right _ -> return ()+    [| TLE.decodeUtf8 $ $(lazyBytestringE bsl) :: TL.Text |]++-- | Embed a strict 'Data.Text.Text' from a UTF8-encoded file.+embedText :: FilePath -> Q Exp+embedText fp = [| TL.toStrict $(embedLazyText fp) :: T.Text |]