@@ -1,57 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE QuasiQuotes #-}
3−{-# LANGUAGE TemplateHaskell #-}
4−------------------------------------------------------------
5−-- |
6−-- Module : Servant.Swagger.UI.Internal
7−-- Copyright : (c) 2015 Futurice
8−-- License : MIT
9−-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>
10−--
11−-- Originally from waitra package:
12−-- <http://hackage.haskell.org/package/waitra-0.0.4.0/docs/Network-Waitra-Embedded.html>
13−----------------------------------------------------------------------------
14−module Servant.Swagger.UI.Internal (mkRecursiveEmbedded) where
15−
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
21−import Language.Haskell.TH
22−import System.Directory
23− (doesDirectoryExist, getDirectoryContents)
24−import System.FilePath (makeRelative, (</>))
25−
26−getRecursiveContents :: FilePath -> IO [(FilePath, BL.ByteString)]
27−getRecursiveContents topdir = do
28− names <- getDirectoryContents topdir
29− let properNames = Prelude.filter (`notElem` [".", ".."]) names
30− paths <- forM properNames $ \name -> do
31− let path = topdir </> name
32− isDirectory <- doesDirectoryExist path
33− if isDirectory
34− then getRecursiveContents path
35− else do contents <- BL.readFile path
36− return [(path, contents)]
37− return (concat paths)
38−
39−makeAllRelative :: FilePath -> [(FilePath, a)] -> [(FilePath, a)]
40−makeAllRelative topdir = map (first (("/" ++) . makeRelative topdir))
41−
42−bytestringE :: B.ByteString -> Q Exp
43−bytestringE b = [| B8.pack $s |]
44− where s = litE $ stringL $ B8.unpack b
45−
46−makeEmbeddedEntry :: (FilePath, BL.ByteString) -> Q Exp
47−makeEmbeddedEntry (path, bs) = [| (path, $(bytestringE $ BL.toStrict bs)) |]
48−
49−-- | Create a @[('FilePath', 'BL.ByteString')]@ list, recursively traversing given directory path.
50−--
51−-- > staticApp $ embeddedSettings $(mkRecursiveEmbedded "static")
52−-- > -- is an in-memory equivalent of
53−-- > staticApp $ defaultFileServerSettings "static"
54−mkRecursiveEmbedded :: FilePath -> Q Exp
55−mkRecursiveEmbedded topdir = do
56− pairs <- runIO $ fmap (makeAllRelative topdir) $ getRecursiveContents topdir
57− listE $ map makeEmbeddedEntry pairs