diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/example/Example.hs b/example/Example.hs --- a/example/Example.hs +++ b/example/Example.hs @@ -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) diff --git a/file-embed-lzma.cabal b/file-embed-lzma.cabal --- a/file-embed-lzma.cabal +++ b/file-embed-lzma.cabal @@ -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 -maintainer: Oleg.Grenrus -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 +maintainer: Oleg.Grenrus +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 diff --git a/src/FileEmbedLzma.hs b/src/FileEmbedLzma.hs --- a/src/FileEmbedLzma.hs +++ b/src/FileEmbedLzma.hs @@ -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