@@ -13,17 +13,19 @@
1313----------------------------------------------------------------------------
1414module Servant.Swagger.UI.Internal (mkRecursiveEmbedded) where
1515
16−import Control.Arrow (first)
17−import Control.Monad (forM)
18−import qualified Data.ByteString as B
19−import qualified Data.ByteString.Char8 as B8
20−import qualified Data.ByteString.Lazy as BL
16+import qualified Codec.Compression.Lzma as LZMA
17+import Control.Arrow (first)
18+import Control.Monad (forM)
19+import qualified Data.ByteString as BS
20+import qualified Data.ByteString.Lazy as BSL
21+import qualified Data.ByteString.Unsafe as BS.Unsafe
2122import Language.Haskell.TH
2223import System.Directory
2324 (doesDirectoryExist, getDirectoryContents)
24−import System.FilePath (makeRelative, (</>))
25+import System.FilePath (makeRelative, (</>))
26+import System.IO.Unsafe (unsafePerformIO)
2527
26−getRecursiveContents :: FilePath -> IO [(FilePath, BL.ByteString)]
28+getRecursiveContents :: FilePath -> IO [(FilePath, BSL.ByteString)]
2729getRecursiveContents topdir = do
2830 names <- getDirectoryContents topdir
2931 let properNames = Prelude.filter (`notElem` [".", ".."]) names
@@ -32,21 +34,31 @@ getRecursiveContents topdir = do
3234 isDirectory <- doesDirectoryExist path
3335 if isDirectory
3436 then getRecursiveContents path
35− else do contents <- BL.readFile path
37+ else do contents <- BSL.readFile path
3638 return [(path, contents)]
3739 return (concat paths)
3840
3941makeAllRelative :: FilePath -> [(FilePath, a)] -> [(FilePath, a)]
4042makeAllRelative topdir = map (first (("/" ++) . makeRelative topdir))
4143
42−bytestringE :: B.ByteString -> Q Exp
43−bytestringE b = [| B8.pack $s |]
44− where s = litE $ stringL $ B8.unpack b
44+-- | Makes lazy 'BSL.ByteString' expression.
45+-- Embedded value is compressed with LZMA.
46+lazyBytestringE :: BSL.ByteString -> Q Exp
47+lazyBytestringE lbs =
48+ [| LZMA.decompress
49+ $ BSL.fromStrict
50+ $ unsafePerformIO
51+ $ BS.Unsafe.unsafePackAddressLen $l $s
52+ |]
53+ where
54+ bs = BSL.toStrict $ LZMA.compress lbs
55+ s = litE $ stringPrimL $ BS.unpack bs
56+ l = litE $ integerL $ fromIntegral $ BS.length bs
4557
46−makeEmbeddedEntry :: (FilePath, BL.ByteString) -> Q Exp
47−makeEmbeddedEntry (path, bs) = [| (path, $(bytestringE $ BL.toStrict bs)) |]
58+makeEmbeddedEntry :: (FilePath, BSL.ByteString) -> Q Exp
59+makeEmbeddedEntry (path, bs) = [| (path, BSL.toStrict $(lazyBytestringE bs)) |]
4860
49−-- | Create a @[('FilePath', 'BL.ByteString')]@ list, recursively traversing given directory path.
61+-- | Create a @[('FilePath', 'BSL.ByteString')]@ list, recursively traversing given directory path.
5062--
5163-- > staticApp $ embeddedSettings $(mkRecursiveEmbedded "static")
5264-- > -- is an in-memory equivalent of