Copyright | Dennis Gosnell 2017 |
---|---|
License | BSD3 |
Maintainer | Dennis Gosnell (cdep.illabout@gmail.com) |
Stability | experimental |
Portability | unknown |
Safe Haskell | None |
Language | Haskell2010 |
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.
Note:
If you are creating a cabal
package that needs to work with cabal-install
,
the "dir"
you want to serve needs to be a relative path inside your
project root, and all contained files need to be listed in your
.cabal
-file under the extra-source-files
field so that they are
included and available at compile-time.
Synopsis
- createApiType :: FilePath -> Q Type
- createApiDec :: String -> FilePath -> Q [Dec]
- createServerExp :: FilePath -> Q Exp
- createServerDec :: String -> String -> FilePath -> Q [Dec]
- createApiAndServerDecs :: String -> String -> FilePath -> Q [Dec]
- data CSS
- data EOT
- data GEXF
- data GIF
- data HTML
- type Html = Markup
- data ICO
- data JPEG
- data JS
- data JSON
- data PNG
- data SVG
- data TTF
- data TXT
- data WOFF
- data WOFF2
- data XML
- frontEndTemplateDir :: FilePath
- frontEndApiName :: String
- frontEndServerName :: String
- createApiFrontEndType :: Q Type
- createApiFrontEndDec :: Q [Dec]
- createServerFrontEndExp :: Q Exp
- createServerFrontEndDec :: Q [Dec]
- createApiAndServerFrontEndDecs :: Q [Dec]
Create API
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
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>"
:: 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 #
:: 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.
Instances
Accept CSS Source # | text/css |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender CSS ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy CSS -> ByteString -> ByteString0 # |
Since: 0.2.0.0
Instances
Accept EOT Source # | fonts/eot |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender EOT ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy EOT -> ByteString -> ByteString0 # |
GEXF file (xml for graph application)
Instances
Accept GEXF Source # | application/gexf |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender GEXF ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy GEXF -> ByteString -> ByteString0 # |
Instances
Accept GIF Source # | image/gif |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender GIF ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy GIF -> ByteString -> ByteString0 # |
Instances
Accept HTML | text/html;charset=utf-8 |
Defined in Servant.HTML.Blaze | |
ToMarkup a => MimeRender HTML a | |
Defined in Servant.HTML.Blaze mimeRender :: Proxy HTML -> a -> ByteString # |
Since: 0.2.0.0
Instances
Accept ICO Source # | icon/ico |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender ICO ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy ICO -> ByteString -> ByteString0 # |
Instances
Accept JPEG Source # | image/jpeg |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender JPEG ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy JPEG -> ByteString -> ByteString0 # |
Instances
Accept JS Source # | application/javascript |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender JS ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy JS -> ByteString -> ByteString0 # |
JSON file
Instances
Accept JSON Source # | application/json |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender JSON ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy JSON -> ByteString -> ByteString0 # |
Instances
Accept PNG Source # | image/png |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender PNG ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy PNG -> ByteString -> ByteString0 # |
Instances
Accept SVG Source # | image/svg |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender SVG ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy SVG -> ByteString -> ByteString0 # |
Since: 0.2.0.0
Instances
Accept TTF Source # | fonts/ttf |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender TTF ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy TTF -> ByteString -> ByteString0 # |
Instances
Accept TXT Source # | text/plain |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender TXT ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy TXT -> ByteString -> ByteString0 # |
Since: 0.2.0.0
Instances
Accept WOFF Source # | fonts/woff |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender WOFF ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy WOFF -> ByteString -> ByteString0 # |
Since: 0.2.0.0
Instances
Accept WOFF2 Source # | fonts/woff2 |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender WOFF2 ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy WOFF2 -> ByteString -> ByteString0 # |
XML file
Instances
Accept XML Source # | application/xml |
Defined in Servant.Static.TH.Internal.Mime | |
MimeRender XML ByteString Source # | |
Defined in Servant.Static.TH.Internal.Mime mimeRender :: Proxy XML -> ByteString -> ByteString0 # |
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
createApiFrontEndType :: Q Type Source #
This is the same as
.createApiType
frontEndTemplateDir
createApiFrontEndDec :: Q [Dec] Source #
This is the same as
.createApiDec
frontEndApiName
frontEndTemplateDir
Server
createServerFrontEndExp :: Q Exp Source #
This is the same as
.createServerExp
frontEndTemplateDir
createServerFrontEndDec :: Q [Dec] Source #
This is the same as
.createServerDec
frontEndApiName
frontEndServerName
frontEndTemplateDir
Server and API
createApiAndServerFrontEndDecs :: Q [Dec] Source #
This is the same as
.createApiAndServerDecs
frontEndApiName
frontEndServerName
frontEndTemplateDir