servant-static-th-0.2.2.0: Embed a directory of static files in your Servant server

CopyrightDennis Gosnell 2017
LicenseBSD3
MaintainerDennis Gosnell (cdep.illabout@gmail.com)
Stabilityexperimental
Portabilityunknown
Safe HaskellNone
LanguageHaskell2010

Servant.Static.TH

Contents

Description

This module provides the createApiAndServerDecs function. At compile time, it will read all the files under a specified directory, embed their contents, create a Servant "API" type synonym representing their directory layout, and create a ServerT function for serving their contents statically.

Let's assume that we have a directory called "dir" in the root of our Haskell web API that looks like this:

  $ tree dir/
  dir/
  ├── js
  │   └── test.js
  └── hello.html

Here's the contents of "hello.html" and "js/test.js":

  $ cat dir/index.html
  <p>Hello World</p>
  $ cat dir/js/test.js
  console.log("hello world");

The createApiAndServerDecs function can be used like the following:

  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE TemplateHaskell #-}

  import Data.Proxy (Proxy(Proxy))
  import Network.Wai (Application)
  import Network.Wai.Handler.Warp (run)
  import Servant.Server (serve)
  import Servant.Static.TH (createApiAndServerDecs)

  $(createApiAndServerDecs "FrontEndApi" "frontEndServer" "dir")

  app :: Application
  app = serve (Proxy :: Proxy FrontEndApi) frontEndServer

  main :: IO ()
  main = run 8080 app

createApiAndServerDecs will expand to something like the following at compile time:

  type FrontEndAPI =
         "js" :> "test.js" :> Get '[JS] ByteString
    :<|> "index.html" :> Get '[HTML] Html

  frontEndServer :: Applicative m => ServerT FrontEndAPI m
  frontEndServer =
         pure "console.log(\"hello world\");"
    :<|> pure "<p>Hello World</p>"

If this WAI application is running, it is possible to use curl to access the server:

  $ curl localhost:8080/hello.html
  <p>Hello World</p>
  $ curl localhost:8080/js/test.js
  console.log("hello world");

This createApiAndServerDecs function is convenient to use when you want to make a Servant application easy to deploy. All the static frontend files are bundled into the Haskell binary at compile-time, so all you need to do is deploy the Haskell binary. This works well for low-traffic websites like prototypes and internal applications.

This shouldn't be used for high-traffic websites. Instead, you should serve your static files from something like Apache, nginx, or a CDN.

Synopsis

Create API

createApiType Source #

Arguments

:: FilePath

directory name to read files from

-> Q Type 

Take a template directory argument as a FilePath and create a Servant type representing the files in the directory. Empty directories will be ignored.

For example, assume the following directory structure:

  $ tree dir/
  dir/
  ├── js
  │   └── test.js
  └── index.html

createApiType is used like the following:

  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE TemplateHaskell #-}

  type FrontEndAPI = $(createApiType "dir")

At compile time, it will expand to the following:

  type FrontEndAPI =
         "js" :> "test.js" :> Get '[JS] ByteString
    :<|> "index.html" :> Get '[HTML] Html

createApiDec Source #

Arguments

:: String

name of the api type synonym

-> FilePath

directory name to read files from

-> Q [Dec] 

This is similar to createApiType, but it creates the whole type synonym declaration.

Given the following code:

  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE TemplateHaskell #-}

  $(createApiDec "FrontAPI" "dir")

You can think of it as expanding to the following:

  type FrontAPI = $(createApiType "dir")

Create Server

createServerExp :: FilePath -> Q Exp Source #

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.

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 Haskell binary for a website with all static files completely baked-in.

For example, assume the following directory structure and file contents:

  $ tree dir/
  dir/
  ├── js
  │   └── test.js
  └── index.html
  $ cat dir/index.html
  <p>Hello World</p>
  $ cat dir/js/test.js
  console.log("hello world");

createServerExp is used like the following:

  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE TemplateHaskell #-}

  type FrontEndAPI = $(createApiType "dir")

  frontEndServer :: Applicative m => ServerT FrontEndAPI m
  frontEndServer = $(createServerExp "dir")

At compile time, this expands to something like the following. This has been slightly simplified to make it easier to understand:

  type FrontEndAPI =
         "js" :> "test.js" :> Get '[JS] ByteString
    :<|> "index.html" :> Get '[HTML] Html

  frontEndServer :: Applicative m => ServerT FrontEndAPI m
  frontEndServer =
         pure "console.log(\"hello world\");"
    :<|> pure "<p>Hello World</p>"

createServerDec Source #

Arguments

:: String

name of the api type synonym

-> String

name of the server function

-> FilePath

directory name to read files from

-> Q [Dec] 

This is similar to createServerExp, but it creates the whole function declaration.

Given the following code:

  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE TemplateHaskell #-}

  $(createServerDec "FrontAPI" "frontServer" "dir")

You can think of it as expanding to the following:

  frontServer :: Applicative m => ServerT FrontAPI m
  frontServer = $(createServerExp "dir")

Create Both API and Server

createApiAndServerDecs Source #

Arguments

:: String

name of the api type synonym

-> String

name of the server function

-> FilePath

directory name to read files from

-> Q [Dec] 

This is a combination of createApiDec and createServerDec. This function is the one most users should use.

Given the following code:

  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE TemplateHaskell #-}

  $(createApiAndServerDecs "FrontAPI" "frontServer" "dir")

You can think of it as expanding to the following:

  $(createApiDec "FrontAPI" "dir")

  $(createServerDec "FrontAPI" "frontServer" "dir")

MIME Types

The following types are the MIME types supported by servant-static-th. If you need additional MIME types supported, feel free to create an issue or PR.

data EOT Source #

Since: 0.2.0.0

data GEXF Source #

GEXF file (xml for graph application)

data HTML :: * #

Instances

Accept * HTML
text/html;charset=utf-8
ToMarkup a => MimeRender * HTML a 

Methods

mimeRender :: Proxy HTML a -> a -> ByteString #

type Html = Markup #

data ICO Source #

Since: 0.2.0.0

data JS Source #

Instances

data JSON Source #

JSON file

data TTF Source #

Since: 0.2.0.0

data WOFF Source #

Since: 0.2.0.0

data XML Source #

XML file

Easy-To-Use Names and Paths

The functions in this section pick defaults for the template directory, api name, and the server function name. This makes it easy to use for quick-and-dirty code.

Paths and Names

frontEndTemplateDir :: FilePath Source #

This is the directory "frontend/dist".

frontEndApiName :: String Source #

This is the String "FrontEnd".

frontEndServerName :: String Source #

This is the String "frontEndServer".

API

Server

Server and API