diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for file-embed-lzma +## 0.1 + +- The default interface uses TTH (`Code`), + the previous untyped TH interface is in the `FileEmbedLzma.Untyped` module. +- Support GHC-9.0.2...9.10.1 + ## 0.0.1 - Use `bytesPrimL` when available diff --git a/example/Example.hs b/example/Example.hs --- a/example/Example.hs +++ b/example/Example.hs @@ -9,6 +9,6 @@ main :: IO () main = do - BS.putStr $(embedByteString "example/example.txt") - for_ $(embedRecursiveDir "example") $ \(n, bs) -> + BS.putStr $$(embedByteString "example/example.txt") + 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,6 +1,6 @@ cabal-version: 2.0 name: file-embed-lzma -version: 0.0.1 +version: 0.1 synopsis: Use Template Haskell to embed (LZMA compressed) data. description: The @file-embed@ package let's embed file and dir contents. @@ -24,35 +24,34 @@ example/example.txt tested-with: - 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 + GHC ==9.0.2 + || ==9.2.8 + || ==9.4.8 + || ==9.6.6 + || ==9.8.2 + || ==9.10.1 source-repository head type: git location: https://github.com/phadej/file-embed-lzma.git library - exposed-modules: FileEmbedLzma + exposed-modules: + FileEmbedLzma + FileEmbedLzma.Untyped -- GHC boot libraries build-depends: - 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 + base >=4.15.1.0 && <4.21 + , bytestring ^>=0.10.12.1 || ^>=0.11.1.0 || ^>=0.12.0.0 + , directory ^>=1.3.3.0 + , filepath ^>=1.4.2.1 || ^>=1.5.2.0 + , template-haskell >=2.17.0.0 && <2.23 + , text ^>=1.2.5.0 || ^>=2.0 || ^>=2.1 + , transformers ^>=0.5.6.2 || ^>=0.6.1.0 -- non bundled dependencies - build-depends: lzma ^>=0.0.0.4 + build-depends: lzma ^>=0.0.1.1 other-extensions: CPP OverloadedStrings diff --git a/src/FileEmbedLzma.hs b/src/FileEmbedLzma.hs --- a/src/FileEmbedLzma.hs +++ b/src/FileEmbedLzma.hs @@ -48,11 +48,9 @@ import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LTE -#if MIN_VERSION_template_haskell(2,16,0) import qualified Data.ByteString.Internal as BS.Internal -import Language.Haskell.TH.Syntax (Bytes (..)) -#endif +import Language.Haskell.TH.Syntax (Bytes (..), liftTyped) -- $setup -- >>> :set -XTemplateHaskell -dppr-cols=9999 @@ -88,18 +86,13 @@ -- | Makes lazy 'LBS.ByteString' expression. -- Embedded value is compressed with LZMA. -lazyBytestringE :: LBS.ByteString -> Q Exp +lazyBytestringE :: LBS.ByteString -> Code Q LBS.ByteString lazyBytestringE lbs = - [| LZMA.decompress . LBS.fromStrict . unsafePerformIO |] `appE` - ([| BS.Unsafe.unsafePackAddressLen |] `appE` l `appE` s) + [|| LZMA.decompress (LBS.fromStrict (unsafePerformIO (BS.Unsafe.unsafePackAddressLen $$(liftTyped l) $$(unsafeCodeCoerce s)))) ||] where 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 + l = BS.length bs params = LZMA.defaultCompressParams {- doesn't seem to affect much @@ -108,15 +101,12 @@ } -} -#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)) = do - let y = [| LBS.toStrict . LBS.take len . LBS.drop off |] `appE` varE name - [| (,) path |] `appE` y +makeEmbeddedEntry :: Code Q LBS.ByteString -> (FilePath, (Int64, Int64)) -> Code Q (FilePath, BS.ByteString) +makeEmbeddedEntry name (path, (off, len)) = + [|| (path, LBS.toStrict (LBS.take len (LBS.drop off $$name))) ||] concatEntries :: Traversable t => t LBS.ByteString -> (LBS.ByteString, t (Int64, Int64)) concatEntries xs = (bslEndo LBS.empty, ys) @@ -135,24 +125,14 @@ -- Directories ------------------------------------------------------------------------------- + -- | Embed a @[('FilePath', 'Data.ByteString.ByteString')]@ list, traversing given directory. -embedDir :: FilePath -> Q Exp -embedDir topdir = do +embedDir :: FilePath -> Code Q [(FilePath, BS.ByteString)] +embedDir topdir = joinCode $ do pairs' <- runIO $ listDirectoryFiles topdir for_ pairs' $ qAddDependentFile . fst let pairs = makeAllRelative topdir pairs' - embedPairs pairs - -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 - 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)] |] + return $ embedPairs pairs -- | Embed a @[('FilePath', 'Data.ByteString.ByteString')]@ list, recursively traversing given directory path. -- @@ -165,60 +145,79 @@ -- @ -- -- --- >>> $(embedRecursiveDir "example") +-- >>> $$(embedRecursiveDir "example") -- [("/Example.hs","..."),("/example.txt","Hello from the inside.\n")] -- --- >>> :t $(embedRecursiveDir "example") --- $(embedRecursiveDir "example") :: [(FilePath, BS.ByteString)] +-- >>> :t $$(embedRecursiveDir "example") +-- $$(embedRecursiveDir "example") :: [(FilePath, BS.ByteString)] -- -embedRecursiveDir :: FilePath -> Q Exp -embedRecursiveDir topdir = do +embedRecursiveDir :: FilePath -> Code Q [(FilePath, BS.ByteString)] +embedRecursiveDir topdir = joinCode $ do pairs' <- runIO $ listRecursiveDirectoryFiles topdir for_ pairs' $ qAddDependentFile . fst let pairs = sort (makeAllRelative topdir pairs') - embedPairs pairs + return $ embedPairs pairs +embedPairs :: [(FilePath, LBS.ByteString)] -> Code Q [(FilePath, BS.ByteString)] +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) + let e = [|| let embedded = $$(lazyBytestringE bsl) + in $$(typedListE (map (makeEmbeddedEntry [|| embedded ||]) offsets)) ||] + typedSigE e [t| [(FilePath, BS.ByteString)] |] + ------------------------------------------------------------------------------- -- Strings ------------------------------------------------------------------------------- -- | Embed a lazy 'Data.ByteString.Lazy.ByteString' from a file. -- --- >>> :t $(embedLazyByteString "file-embed-lzma.cabal") --- $(embedLazyByteString "file-embed-lzma.cabal") :: LBS.ByteString +-- >>> :t $$(embedLazyByteString "file-embed-lzma.cabal") +-- $$(embedLazyByteString "file-embed-lzma.cabal") :: LBS.ByteString -- -embedLazyByteString :: FilePath -> Q Exp -embedLazyByteString fp = do +embedLazyByteString :: FilePath -> Code Q LBS.ByteString +embedLazyByteString fp = joinCode $ do qAddDependentFile fp bsl <- runIO $ LBS.readFile fp - lazyBytestringE bsl + return $ lazyBytestringE bsl -- | Embed a strict 'Data.ByteString.ByteString' from a file. -- --- >>> :t $(embedByteString "file-embed-lzma.cabal") --- $(embedByteString "file-embed-lzma.cabal") :: BS.ByteString +-- >>> :t $$(embedByteString "file-embed-lzma.cabal") +-- $$(embedByteString "file-embed-lzma.cabal") :: BS...ByteString -- -embedByteString :: FilePath -> Q Exp -embedByteString fp = [| LBS.toStrict |] `appE` embedLazyByteString fp +embedByteString :: FilePath -> Code Q BS.ByteString +embedByteString fp = [|| LBS.toStrict $$(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 +-- >>> :t $$(embedLazyText "file-embed-lzma.cabal") +-- $$(embedLazyText "file-embed-lzma.cabal") :: LT.Text -- -embedLazyText :: FilePath -> Q Exp -embedLazyText fp = do +embedLazyText :: FilePath -> Code Q LT.Text +embedLazyText fp = joinCode $ do qAddDependentFile fp bsl <- runIO $ LBS.readFile fp case LTE.decodeUtf8' bsl of Left e -> reportError (show e) Right _ -> return () - [| LTE.decodeUtf8 |] `appE` lazyBytestringE bsl + return $ [|| LTE.decodeUtf8 $$(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 +-- >>> :t $$(embedText "file-embed-lzma.cabal") +-- $$(embedText "file-embed-lzma.cabal") :: T...Text -- -embedText :: FilePath -> Q Exp -embedText fp = [| LT.toStrict |] `appE` embedLazyText fp +embedText :: FilePath -> Code Q T.Text +embedText fp = [|| LT.toStrict $$(embedLazyText fp) ||] + +------------------------------------------------------------------------------- +-- TTH helpers +------------------------------------------------------------------------------- + +typedSigE :: Code Q a -> Q Type -> Code Q a +typedSigE x a = unsafeCodeCoerce $ sigE (unTypeCode x) a + +typedListE :: [Code Q a] -> Code Q [a] +typedListE xs = unsafeCodeCoerce $ listE $ map unTypeCode xs diff --git a/src/FileEmbedLzma/Untyped.hs b/src/FileEmbedLzma/Untyped.hs new file mode 100644 --- /dev/null +++ b/src/FileEmbedLzma/Untyped.hs @@ -0,0 +1,113 @@ +module FileEmbedLzma.Untyped ( + -- * Embed files + embedByteString, + embedLazyByteString, + embedText, + embedLazyText, + -- * Embed directories + embedDir, + embedRecursiveDir, + -- * Internal + -- ** Directory listing + listDirectoryFiles, + listRecursiveDirectoryFiles, + listDirectoryFilesF, + -- ** Template Haskell + lazyBytestringE, +) where + +import Language.Haskell.TH (Exp, Q, unTypeCode) + +import qualified Data.ByteString.Lazy as LBS +import qualified FileEmbedLzma + +-- $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 + +------------------------------------------------------------------------------- +-- Directories +------------------------------------------------------------------------------- + +-- | Embed a @[('FilePath', 'Data.ByteString.ByteString')]@ list, traversing given directory. +embedDir :: FilePath -> Q Exp +embedDir = unTypeCode . FileEmbedLzma.embedDir + +-- | 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 "example") +-- [("/Example.hs","..."),("/example.txt","Hello from the inside.\n")] +-- +-- >>> :t $(embedRecursiveDir "example") +-- $(embedRecursiveDir "example") :: [(FilePath, BS.ByteString)] +-- +embedRecursiveDir :: FilePath -> Q Exp +embedRecursiveDir = unTypeCode . FileEmbedLzma.embedRecursiveDir + +------------------------------------------------------------------------------- +-- Strings +------------------------------------------------------------------------------- + +-- | 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 = unTypeCode . FileEmbedLzma.embedLazyByteString + +-- | 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 = unTypeCode . FileEmbedLzma.embedByteString + +-- | 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 = unTypeCode . FileEmbedLzma.embedLazyText + +-- | 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 = unTypeCode . FileEmbedLzma.embedText + +------------------------------------------------------------------------------- +-- Implementation +------------------------------------------------------------------------------- + +-- | Makes lazy 'LBS.ByteString' expression. +-- Embedded value is compressed with LZMA. +lazyBytestringE :: LBS.ByteString -> Q Exp +lazyBytestringE = unTypeCode . FileEmbedLzma.lazyBytestringE + +listRecursiveDirectoryFiles :: FilePath -> IO [(FilePath, LBS.ByteString)] +listRecursiveDirectoryFiles = FileEmbedLzma.listRecursiveDirectoryFiles + +listDirectoryFiles :: FilePath -> IO [(FilePath, LBS.ByteString)] +listDirectoryFiles = FileEmbedLzma.listDirectoryFiles + +listDirectoryFilesF + :: (FilePath -> IO [(FilePath, LBS.ByteString)]) -- ^ what to do with a sub-directory + -> FilePath -> IO [(FilePath, LBS.ByteString)] +listDirectoryFilesF = FileEmbedLzma.listDirectoryFilesF