servant-static-th 0.2.4.0 → 1.0.0.0

raw patch · 8 files changed

+77/−18 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• servant-static-th.cabal +1/−1
• src/Servant/Static/TH.hs +19/−5
• src/Servant/Static/TH/Internal/Api.hs +9/−3
• src/Servant/Static/TH/Internal/Server.hs +21/−7
• test/Spec/ApiSpec.hs +4/−2
• test/Spec/HelperFuncSpec.hs +3/−0
• test/Spec/ServerSpec.hs +12/−0

@@ -1,5 +1,13 @@ # Changelog +## v1.0.0.0++-   Serve any files called `index.html` on the root `/` as well as the path+    `/index.html`. This makes servant-static-th operate similar to how web+    servers like Apache or nginx work.+    [#19](https://github.com/cdepillabout/servant-static-th/pull/19).+    Thanks [@vendamere](https://github.com/vendamere)!+ ## v0.2.4.0  -   Add a mime type for .wasm files

@@ -1,5 +1,5 @@ name:                servant-static-th-version:             0.2.4.0+version:             1.0.0.0 synopsis:            Embed a directory of static files in your Servant server description:         Please see <https://github.com/cdepillabout/servant-static-th#readme README.md>. homepage:            https://github.com/cdepillabout/servant-static-th

@@ -22,14 +22,17 @@   dir\/   ├── js   │   └── test.js-  └── hello.html+  ├── hello.html+  └── index.html @ -Here's the contents of @\"hello.html\"@ and @\"js\/test.js\"@:+Here's the contents of @\"hello.html\"@, @\"index.html\"@, and @\"js\/test.js\"@:  @-  $ cat dir\/index.html+  $ cat dir\/hello.html   \<p\>Hello World\<\/p\>+  $ cat dir\/index.html+  \<p\>This is the index\<\/p\>   $ cat dir\/js\/test.js   console.log(\"hello world\"); @@@ -60,19 +63,30 @@  @   type FrontEndAPI =-         \"js\" 'Servant.API.:>' \"test.js\" 'Servant.API.:>' 'Servant.API.Get' \'['JS'] 'Data.ByteString.ByteString'+    -- index.html is served on the root, as well as from the path \"/index.html\".+         'Servant.API.Get' \'['HTML'] 'Html'     ':<|>' \"index.html\" 'Servant.API.:>' 'Servant.API.Get' \'['HTML'] 'Html'+    -- hello.html is served from the path \"/hello.html\".+    ':<|>' \"hello.html\" 'Servant.API.:>' 'Servant.API.Get' \'['HTML'] 'Html'+    -- js/test.js is served from the path \"/js/test.js\".+    ':<|>' \"js\" 'Servant.API.:>' \"test.js\" 'Servant.API.:>' 'Servant.API.Get' \'['JS'] 'Data.ByteString.ByteString'    frontEndServer :: 'Applicative' m => 'Servant.Server.ServerT' FrontEndAPI m   frontEndServer =-         'pure' "console.log(\\"hello world\\");"+         'pure' "\<p\>This is the index\<\/p\>"+    ':<|>' 'pure' "\<p\>This is the index\<\/p\>"     ':<|>' 'pure' "\<p\>Hello World\<\/p\>"+    ':<|>' 'pure' "console.log(\\"hello world\\");" @  If this WAI application is running, it is possible to use @curl@ to access the server:  @+  $ curl localhost:8080\/+  \<p\>This is the index\<\/p\>+  $ curl localhost:8080\/index.html+  \<p\>This is the index\<\/p\>   $ curl localhost:8080\/hello.html   \<p\>Hello World\<\/p\>   $ curl localhost:8080\/js\/test.js

@@ -21,8 +21,13 @@ fileTreeToApiType (FileTreeFile filePath _) = do   addDependentFile filePath   MimeTypeInfo mimeT respT _ <- extensionToMimeTypeInfoEx filePath-  let fileNameLitT = litT $ strTyLit $ takeFileName filePath-  [t|$(fileNameLitT) :> Get '[$(mimeT)] $(respT)|]+  let fileName = takeFileName filePath+  let fileNameLitT = litT $ strTyLit fileName+  case fileName of+    -- We special-case files called "index.html" and generate a type that serves on both+    -- the root, and under the path "index.html".+    "index.html" -> [t|Get '[$(mimeT)] $(respT) :<|> $(fileNameLitT) :> Get '[$(mimeT)] $(respT)|]+    _ -> [t|$(fileNameLitT) :> Get '[$(mimeT)] $(respT)|] fileTreeToApiType (FileTreeDir filePath fileTrees) =   let fileNameLitT = litT $ strTyLit $ takeFileName filePath   in [t|$(fileNameLitT) :> $(combineWithServantOrT nonEmptyApiTypesQ)|]@@ -40,7 +45,7 @@  -- | Take a template directory argument as a 'FilePath' and create a Servant -- type representing the files in the directory.  Empty directories will be--- ignored.+-- ignored. @index.html@ files will also be served at the root. -- -- For example, assume the following directory structure: --@@ -66,6 +71,7 @@ -- @ --   type FrontEndAPI = --          \"js\" ':>' \"test.js\" ':>' 'Get' \'['JS'] 'Data.ByteString.ByteString'+--     ':<|>' 'Get' \'['Servant.HTML.Blaze.HTML'] 'Text.Blaze.Html.Html' --     ':<|>' \"index.html\" ':>' 'Get' \'['Servant.HTML.Blaze.HTML'] 'Text.Blaze.Html.Html' -- @ createApiType

@@ -5,34 +5,47 @@ module Servant.Static.TH.Internal.Server where  import Data.Foldable (foldl1)-import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty (NonEmpty((:|))) import Language.Haskell.TH        (Dec, Exp, Q, appE, clause, conT, funD, mkName, normalB,         runIO, sigD) import Language.Haskell.TH.Syntax (addDependentFile) import Servant.API ((:<|>)((:<|>))) import Servant.Server (ServerT)+import System.FilePath (takeFileName) + import Servant.Static.TH.Internal.FileTree import Servant.Static.TH.Internal.Mime  combineWithExp :: Q Exp -> Q Exp -> Q Exp -> Q Exp combineWithExp combiningExp = appE . appE combiningExp -combineWithServantOr :: NonEmpty (Q Exp) -> Q Exp-combineWithServantOr = foldl1 $ combineWithExp [e|(:<|>)|]+combineWithServantOr :: Q Exp -> Q Exp -> Q Exp+combineWithServantOr = combineWithExp [e|(:<|>)|] +combineMultiWithServantOr :: NonEmpty (Q Exp) -> Q Exp+combineMultiWithServantOr = foldl1 combineWithServantOr+ fileTreeToServer :: FileTree -> Q Exp fileTreeToServer (FileTreeFile filePath fileContents) = do   addDependentFile filePath   MimeTypeInfo _ _ contentToExp <- extensionToMimeTypeInfoEx filePath-  contentToExp fileContents+  let fileName = takeFileName filePath+  case fileName of+    "index.html" ->+      combineWithServantOr+        -- content to serve on the root+        (contentToExp fileContents)+        -- content to serve on the path "index.html"+        (contentToExp fileContents)+    _ -> contentToExp fileContents fileTreeToServer (FileTreeDir _ fileTrees) =-  combineWithServantOr $ fmap fileTreeToServer fileTrees+  combineMultiWithServantOr $ fmap fileTreeToServer fileTrees  -- | Take a template directory argument as a 'FilePath' and create a 'ServerT' -- function that serves the files under the directory.  Empty directories will--- be ignored.+-- be ignored. 'index.html' files will also be served at the root. -- -- Note that the file contents will be embedded in the function.  They will -- not be served dynamically at runtime.  This makes it easy to create a@@ -73,6 +86,7 @@ -- @ --   type FrontEndAPI = --          \"js\" 'Servant.API.:>' \"test.js\" 'Servant.API.:>' 'Servant.API.Get' \'['JS'] 'Data.ByteString.ByteString'+--     ':<|>' 'Servant.API.Get' \'['Servant.HTML.Blaze.HTML'] 'Text.Blaze.Html.Html' --     ':<|>' \"index.html\" 'Servant.API.:>' 'Servant.API.Get' \'['Servant.HTML.Blaze.HTML'] 'Text.Blaze.Html.Html' -- --   frontEndServer :: 'Applicative' m => 'ServerT' FrontEndAPI m@@ -85,7 +99,7 @@   -> Q Exp createServerExp templateDir = do   fileTree <- runIO $ getFileTreeIgnoreEmpty templateDir-  combineWithServantOr $ fmap fileTreeToServer fileTree+  combineMultiWithServantOr $ fmap fileTreeToServer fileTree  -- | This is similar to 'createServerExp', but it creates the whole function -- declaration.

@@ -19,7 +19,7 @@ $(createApiDec "FrontEndApi" testDir)  type ExpectedFrontEndApi =-    (+    ((       "dir" :>         (           ( "inner-file.html" :> Get '[HTML] Html )@@ -28,7 +28,9 @@         )     )   :<|>-    ( "hello.html" :> Get '[HTML] Html )+    ( "hello.html" :> Get '[HTML] Html ))+  :<|>+    ( Get '[HTML] Html :<|> "index.html" :> Get '[HTML] Html )  checkFrontEndApiType :: ExpectedFrontEndApi :~: FrontEndApi checkFrontEndApiType = Refl

@@ -58,6 +58,9 @@               , FileTreeFile                   (testDir </> "hello.html")                   "Hello World\n"+              , FileTreeFile+                  (testDir </> "index.html")+                  "Index\n"               ]         actualFileTree @?= expectedFileTree     , testCase "fails on empty directory" $

@@ -33,6 +33,18 @@                 { matchHeaders = ["Content-Type" <:> "text/html;charset=utf-8"]                 }         in get "hello.html" `shouldRespondWith` expectedResp+      it "index.html responds correctly and is html" $+        let expectedResp =+              "Index\n"+                { matchHeaders = ["Content-Type" <:> "text/html;charset=utf-8"]+                }+        in get "index.html" `shouldRespondWith` expectedResp+      it "root responds with index.html contents" $+        let expectedResp =+              "Index\n"+                { matchHeaders = ["Content-Type" <:> "text/html;charset=utf-8"]+                }+        in get "" `shouldRespondWith` expectedResp       it "dir/inner-file.html responds correctly" $         get "dir/inner-file.html" `shouldRespondWith` "Inner File\n"       it "non existing file gives 404" $