Skip to content

Commit 993cc7d

Browse files
phadejphadej
committed
Single BSL for whole directory
1 parent 869edb7 commit 993cc7d

File tree

3 files changed

+70
-23
lines changed

3 files changed

+70
-23
lines changed

‎servant-swagger-ui.cabal

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -97,10 +97,10 @@ library
9797

9898
build-depends:
9999
base >=4.7 && <4.12
100+
, base-compat >=0.9.3 && <0.10
100101
, blaze-markup >=0.7.0.2 && <0.9
101102
, bytestring >=0.10.4.0 && <0.11
102103
, directory >=1.2.1.0 && <1.4
103-
, file-embed >=0.0.9 && <0.1
104104
, filepath >=1.3.0.2 && <1.5
105105
, http-media >=0.6.2 && <0.8
106106
, lzma >=0.0.0.3 && <0.1
@@ -111,11 +111,12 @@ library
111111
, swagger2 >=2.0.1 && <2.3
112112
, template-haskell >=2.9 && <2.14
113113
, text >=1.2.0.6 && <1.3
114+
, th-lift-instances >=0.1.11 && <0.2
115+
, transformers >=0.3 && <0.6
114116
, wai-app-static >=3.0.1.1 && <3.2
115117
if flag(servant-0-5)
116118
build-depends:
117119
servant >=0.5
118-
, transformers >=0.3 && <0.6
119120
, transformers-compat >=0.3 && <0.6
120121
else
121122
build-depends:

‎src/Servant/Swagger/UI.hs

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,6 @@ module Servant.Swagger.UI (
7070
) where
7171

7272
import Data.ByteString (ByteString)
73-
import Data.FileEmbed (embedStringFile)
7473
import Data.Swagger (Swagger)
7574
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
7675
import Network.Wai.Application.Static (embeddedSettings, staticApp)
@@ -190,13 +189,13 @@ swaggerSchemaUIServerImpl indexTemplate files swagger = return swagger
190189
staticApp $ embeddedSettings files
191190

192191
swaggerUiIndexTemplate :: T.Text
193-
swaggerUiIndexTemplate = $(embedStringFile "index.html.tmpl")
192+
swaggerUiIndexTemplate = $(embedText "index.html.tmpl")
194193

195194
swaggerUiFiles :: [(FilePath, ByteString)]
196195
swaggerUiFiles = $(mkRecursiveEmbedded "swagger-ui-dist-3.9.1")
197196

198197
jensolegIndexTemplate :: T.Text
199-
jensolegIndexTemplate = $(embedStringFile "jensoleg.index.html.tmpl")
198+
jensolegIndexTemplate = $(embedText "jensoleg.index.html.tmpl")
200199

201200
jensolegFiles :: [(FilePath, ByteString)]
202201
jensolegFiles = $(mkRecursiveEmbedded "jensoleg-dist")

‎src/Servant/Swagger/UI/Internal.hs

Lines changed: 65 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -11,24 +11,35 @@
1111
-- Originally from waitra package:
1212
-- <http://hackage.haskell.org/package/waitra-0.0.4.0/docs/Network-Waitra-Embedded.html>
1313
----------------------------------------------------------------------------
14-
module Servant.Swagger.UI.Internal (mkRecursiveEmbedded) where
14+
module Servant.Swagger.UI.Internal (mkRecursiveEmbedded, embedText) where
1515

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
22-
import Language.Haskell.TH
23-
import System.Directory
24-
(doesDirectoryExist, getDirectoryContents)
25-
import System.FilePath (makeRelative, (</>))
26-
import System.IO.Unsafe (unsafePerformIO)
16+
import Prelude ()
17+
import Prelude.Compat
18+
19+
import Control.Arrow (first)
20+
import Control.Monad (forM)
21+
import Control.Monad.Trans.State.Strict (runState, state)
22+
import Data.Functor.Compose (Compose (..))
23+
import Data.Int (Int64)
24+
import Language.Haskell.TH
25+
import System.Directory
26+
(doesDirectoryExist, getDirectoryContents)
27+
import System.FilePath (makeRelative, (</>))
28+
import System.IO.Unsafe (unsafePerformIO)
29+
30+
import qualified Codec.Compression.Lzma as LZMA
31+
import qualified Data.ByteString as BS
32+
import qualified Data.ByteString.Lazy as BSL
33+
import qualified Data.ByteString.Unsafe as BS.Unsafe
34+
import qualified Data.Text.Lazy as TL
35+
import qualified Data.Text.Lazy.Encoding as TLE
36+
37+
import Instances.TH.Lift ()
2738

2839
getRecursiveContents :: FilePath -> IO [(FilePath, BSL.ByteString)]
2940
getRecursiveContents topdir = do
3041
names <- getDirectoryContents topdir
31-
let properNames = Prelude.filter (`notElem` [".", ".."]) names
42+
let properNames = filter (`notElem` [".", ".."]) names
3243
paths <- forM properNames $ \name -> do
3344
let path = topdir </> name
3445
isDirectory <- doesDirectoryExist path
@@ -51,12 +62,33 @@ lazyBytestringE lbs =
5162
$ BS.Unsafe.unsafePackAddressLen $l $s
5263
|]
5364
where
54-
bs = BSL.toStrict $ LZMA.compress lbs
65+
bs = BSL.toStrict $ LZMA.compressWith params lbs
5566
s = litE $ stringPrimL $ BS.unpack bs
5667
l = litE $ integerL $ fromIntegral $ BS.length bs
5768

58-
makeEmbeddedEntry :: (FilePath, BSL.ByteString) -> Q Exp
59-
makeEmbeddedEntry (path, bs) = [| (path, BSL.toStrict $(lazyBytestringE bs)) |]
69+
params = LZMA.defaultCompressParams
70+
{- doesn't seem to affect much
71+
{ LZMA.compressLevel = LZMA.CompressionLevel9
72+
, LZMA.compressLevelExtreme = True
73+
}
74+
-}
75+
76+
makeEmbeddedEntry :: Name -> (FilePath, (Int64, Int64)) -> Q Exp
77+
makeEmbeddedEntry name (path, (off, len)) =
78+
[| (path, BSL.toStrict $ BSL.take len $ BSL.drop off $(varE name)) |]
79+
80+
concatEntries :: Traversable t => t BSL.ByteString -> (BSL.ByteString, t (Int64, Int64))
81+
concatEntries xs = (bslEndo BSL.empty, ys)
82+
where
83+
(ys, (_, bslEndo)) = runState (traverse (state . single) xs) (0, id)
84+
85+
single
86+
:: BSL.ByteString -- file bytestring
87+
-> (Int64, BSL.ByteString -> BSL.ByteString) -- current offset, buffer so far
88+
-> ((Int64, Int64), (Int64, BSL.ByteString -> BSL.ByteString))
89+
single bsl (off, endo) = ((off, l), (off + l, endo . BSL.append bsl))
90+
where
91+
l = fromIntegral $ BSL.length bsl
6092

6193
-- | Create a @[('FilePath', 'BSL.ByteString')]@ list, recursively traversing given directory path.
6294
--
@@ -65,5 +97,20 @@ makeEmbeddedEntry (path, bs) = [| (path, BSL.toStrict $(lazyBytestringE bs)) |]
6597
-- > staticApp $ defaultFileServerSettings "static"
6698
mkRecursiveEmbedded :: FilePath -> Q Exp
6799
mkRecursiveEmbedded topdir = do
68-
pairs <- runIO $ fmap (makeAllRelative topdir) $ getRecursiveContents topdir
69-
listE $ map makeEmbeddedEntry pairs
100+
pairs <- runIO $ fmap (makeAllRelative topdir) $ getRecursiveContents topdir
101+
-- we do a hop to only embed single big bytestring.
102+
-- it's beneficial as lzma have more stuff to compress
103+
let (bsl, Compose offsets) = concatEntries (Compose pairs)
104+
bslName <- newName "embedBsl"
105+
bslExpr <- lazyBytestringE bsl
106+
letE [ return $ ValD (VarP bslName) (NormalB bslExpr) [] ] $
107+
listE $ map (makeEmbeddedEntry bslName) offsets
108+
109+
-- | Create a textual 'T.Text' from a UTF8-encoded file.
110+
embedText :: FilePath -> Q Exp
111+
embedText fp = do
112+
bsl <- runIO $ BSL.readFile fp
113+
case TLE.decodeUtf8' bsl of
114+
Left e -> reportError (show e)
115+
Right _ -> return ()
116+
[| TL.toStrict $ TLE.decodeUtf8 $ $(lazyBytestringE bsl) |]

0 commit comments

Comments
 (0)