file-embed-lzma 0 → 0.0.1
raw patch · 5 files changed
+142/−93 lines, 5 filesdep −base-compatdep −th-lift-instancesdep ~basedep ~bytestringdep ~directorysetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies removed: base-compat, th-lift-instances
Dependency ranges changed: base, bytestring, directory, filepath, lzma, template-haskell, text, transformers
API changes (from Hackage documentation)
Files
- ChangeLog.md +9/−0
- Setup.hs +0/−2
- example/Example.hs +4/−3
- file-embed-lzma.cabal +49/−47
- src/FileEmbedLzma.hs +80/−41
ChangeLog.md view
@@ -1,5 +1,14 @@ # Revision history for file-embed-lzma +## 0.0.1++- Use `bytesPrimL` when available+- Drop GHC-7.x support.+ We no more depend on `th-lift-instances`,+ and use `TemplateHaskellQuotes` instead of `TemplateHaskell` for the lib+ itself.+- `embedRecursiveDir` sorts files, so the generated code is more deterministic+ ## 0 - First version. Released on an unsuspecting world.
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
example/Example.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} module Main (main) where -import Data.Foldable (for_)+import Data.Foldable (for_) import FileEmbedLzma (embedByteString, embedRecursiveDir) import qualified Data.ByteString as BS@@ -9,5 +10,5 @@ main :: IO () main = do BS.putStr $(embedByteString "example/example.txt")- for_ $(embedRecursiveDir "src") $ \(n, bs) ->+ for_ $(embedRecursiveDir "example") $ \(n, bs) -> print (n, BS.length bs)
file-embed-lzma.cabal view
@@ -1,8 +1,7 @@-cabal-version: 2.0-name: file-embed-lzma-version: 0--synopsis: Use Template Haskell to embed (LZMA compressed) data.+cabal-version: 2.0+name: file-embed-lzma+version: 0.0.1+synopsis: Use Template Haskell to embed (LZMA compressed) data. description: The @file-embed@ package let's embed file and dir contents. .@@ -11,61 +10,64 @@ . 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+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+ GHC ==8.0.2+ || ==8.2.2+ || ==8.4.4+ || ==8.6.5+ || ==8.8.4+ || ==8.10.7+ || ==9.0.2+ || ==9.2.4+ || ==9.4.1 source-repository head- type: git- location: https://github.com/phadej/file-embed-lzma.git+ type: git+ location: https://github.com/phadej/file-embed-lzma.git library- exposed-modules:- FileEmbedLzma+ 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+ base >=4.9.1.0 && <4.18+ , bytestring ^>=0.10.8.1 || ^>=0.11.1.0+ , directory ^>=1.3.0.0+ , filepath >=1.1.4.1 && <1.5+ , template-haskell >=2.11.1.0 && <2.20+ , text ^>=1.2.3.0 || ^>=2.0+ , transformers ^>=0.5.2.0 -- non bundled dependencies- build-depends:- lzma ^>=0.0.0.3- , th-lift-instances ^>=0.1.11-+ build-depends: lzma ^>=0.0.0.4 other-extensions:+ CPP OverloadedStrings- QuasiQuotes- TemplateHaskell- hs-source-dirs: src- default-language: Haskell2010+ TemplateHaskellQuotes + 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+ 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+ base+ , bytestring+ , file-embed-lzma
src/FileEmbedLzma.hs view
@@ -1,6 +1,6 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskellQuotes #-} ------------------------------------------------------------ -- | -- Module : FileEmbedLzma@@ -26,15 +26,13 @@ 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 Data.List (sort) import Language.Haskell.TH import Language.Haskell.TH.Syntax (qAddDependentFile) import System.Directory@@ -44,23 +42,34 @@ import qualified Codec.Compression.Lzma as LZMA import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy as LBS 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 qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LTE -import Instances.TH.Lift ()+#if MIN_VERSION_template_haskell(2,16,0)+import qualified Data.ByteString.Internal as BS.Internal -listRecursiveDirectoryFiles :: FilePath -> IO [(FilePath, BSL.ByteString)]+import Language.Haskell.TH.Syntax (Bytes (..))+#endif++-- $setup+-- >>> :set -XTemplateHaskell -dppr-cols=9999+-- >>> import qualified Data.ByteString.Lazy as LBS+-- >>> import qualified Data.ByteString as BS+-- >>> import qualified Data.Text.Lazy as LT+-- >>> import qualified Data.Text as T++listRecursiveDirectoryFiles :: FilePath -> IO [(FilePath, LBS.ByteString)] listRecursiveDirectoryFiles = listDirectoryFilesF listRecursiveDirectoryFiles -listDirectoryFiles :: FilePath -> IO [(FilePath, BSL.ByteString)]+listDirectoryFiles :: FilePath -> IO [(FilePath, LBS.ByteString)] listDirectoryFiles = listDirectoryFilesF (\_ -> return []) listDirectoryFilesF- :: (FilePath -> IO [(FilePath, BSL.ByteString)]) -- ^ what to do with a sub-directory- -> FilePath -> IO [(FilePath, BSL.ByteString)]+ :: (FilePath -> IO [(FilePath, LBS.ByteString)]) -- ^ what to do with a sub-directory+ -> FilePath -> IO [(FilePath, LBS.ByteString)] listDirectoryFilesF go topdir = do names <- getDirectoryContents topdir let properNames = filter (`notElem` [".", ".."]) names@@ -70,26 +79,26 @@ if isDirectory then go path else do- contents <- BSL.readFile path+ contents <- LBS.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.+-- | Makes lazy 'LBS.ByteString' expression. -- Embedded value is compressed with LZMA.-lazyBytestringE :: BSL.ByteString -> Q Exp+lazyBytestringE :: LBS.ByteString -> Q Exp lazyBytestringE lbs =- [| LZMA.decompress- $ BSL.fromStrict- $ unsafePerformIO- $ BS.Unsafe.unsafePackAddressLen $l $s- :: BSL.ByteString- |]+ [| LZMA.decompress . LBS.fromStrict . unsafePerformIO |] `appE`+ ([| BS.Unsafe.unsafePackAddressLen |] `appE` l `appE` s) where- bs = BSL.toStrict $ LZMA.compressWith params lbs+ bs = LBS.toStrict $ LZMA.compressWith params lbs+#if MIN_VERSION_template_haskell(2,16,0)+ s = litE $ bytesPrimL $ bsToBytes bs+#else s = litE $ stringPrimL $ BS.unpack bs+#endif l = litE $ integerL $ fromIntegral $ BS.length bs params = LZMA.defaultCompressParams@@ -99,22 +108,28 @@ } -} +#if MIN_VERSION_template_haskell(2,16,0)+bsToBytes :: BS.ByteString -> Bytes+bsToBytes (BS.Internal.PS fptr off len) = Bytes fptr (fromIntegral off) (fromIntegral len)+#endif+ makeEmbeddedEntry :: Name -> (FilePath, (Int64, Int64)) -> Q Exp-makeEmbeddedEntry name (path, (off, len)) =- [| (path, BSL.toStrict $ BSL.take len $ BSL.drop off $(varE name)) |]+makeEmbeddedEntry name (path, (off, len)) = do+ let y = [| LBS.toStrict . LBS.take len . LBS.drop off |] `appE` varE name+ [| (,) path |] `appE` y -concatEntries :: Traversable t => t BSL.ByteString -> (BSL.ByteString, t (Int64, Int64))-concatEntries xs = (bslEndo BSL.empty, ys)+concatEntries :: Traversable t => t LBS.ByteString -> (LBS.ByteString, t (Int64, Int64))+concatEntries xs = (bslEndo LBS.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))+ :: LBS.ByteString -- file bytestring+ -> (Int64, LBS.ByteString -> LBS.ByteString) -- current offset, buffer so far+ -> ((Int64, Int64), (Int64, LBS.ByteString -> LBS.ByteString))+ single bsl (off, endo) = ((off, l), (off + l, endo . LBS.append bsl)) where- l = fromIntegral $ BSL.length bsl+ l = fromIntegral $ LBS.length bsl ------------------------------------------------------------------------------- -- Directories@@ -128,7 +143,7 @@ let pairs = makeAllRelative topdir pairs' embedPairs pairs -embedPairs :: [(FilePath, BSL.ByteString)] -> Q Exp+embedPairs :: [(FilePath, LBS.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@@ -148,11 +163,19 @@ -- -- is an embedded (no data-files!) equivalent of -- staticApp $ defaultFileServerSettings "static" -- @+--+--+-- >>> $(embedRecursiveDir "example")+-- [("/Example.hs","..."),("/example.txt","Hello from the inside.\n")]+--+-- >>> :t $(embedRecursiveDir "example")+-- $(embedRecursiveDir "example") :: [(FilePath, BS.ByteString)]+-- embedRecursiveDir :: FilePath -> Q Exp embedRecursiveDir topdir = do pairs' <- runIO $ listRecursiveDirectoryFiles topdir for_ pairs' $ qAddDependentFile . fst- let pairs = makeAllRelative topdir pairs'+ let pairs = sort (makeAllRelative topdir pairs') embedPairs pairs -------------------------------------------------------------------------------@@ -160,26 +183,42 @@ ------------------------------------------------------------------------------- -- | Embed a lazy 'Data.ByteString.Lazy.ByteString' from a file.+--+-- >>> :t $(embedLazyByteString "file-embed-lzma.cabal")+-- $(embedLazyByteString "file-embed-lzma.cabal") :: LBS.ByteString+-- embedLazyByteString :: FilePath -> Q Exp embedLazyByteString fp = do qAddDependentFile fp- bsl <- runIO $ BSL.readFile fp+ bsl <- runIO $ LBS.readFile fp lazyBytestringE bsl -- | Embed a strict 'Data.ByteString.ByteString' from a file.+--+-- >>> :t $(embedByteString "file-embed-lzma.cabal")+-- $(embedByteString "file-embed-lzma.cabal") :: BS.ByteString+-- embedByteString :: FilePath -> Q Exp-embedByteString fp = [| BSL.toStrict $(embedLazyByteString fp) :: BS.ByteString |]+embedByteString fp = [| LBS.toStrict |] `appE` embedLazyByteString fp -- | Embed a lazy 'Data.Text.Lazy.Text' from a UTF8-encoded file.+--+-- >>> :t $(embedLazyText "file-embed-lzma.cabal")+-- $(embedLazyText "file-embed-lzma.cabal") :: LT.Text+-- embedLazyText :: FilePath -> Q Exp embedLazyText fp = do qAddDependentFile fp- bsl <- runIO $ BSL.readFile fp- case TLE.decodeUtf8' bsl of+ bsl <- runIO $ LBS.readFile fp+ case LTE.decodeUtf8' bsl of Left e -> reportError (show e) Right _ -> return ()- [| TLE.decodeUtf8 $ $(lazyBytestringE bsl) :: TL.Text |]+ [| LTE.decodeUtf8 |] `appE` lazyBytestringE bsl -- | Embed a strict 'Data.Text.Text' from a UTF8-encoded file.+--+-- >>> :t $(embedText "file-embed-lzma.cabal")+-- $(embedText "file-embed-lzma.cabal") :: T.Text+-- embedText :: FilePath -> Q Exp-embedText fp = [| TL.toStrict $(embedLazyText fp) :: T.Text |]+embedText fp = [| LT.toStrict |] `appE` embedLazyText fp