servant-js: Automatically derive javascript functions to query servant webservices.

This is a package candidate release! Here you can preview how this package release will appear once published to the main package index (which can be accomplished via the 'maintain' link below). Please note that once a package has been published to the main package index it cannot be undone! Please consult the package uploading documentation for more information.

[maintain] [Publish]

Automatically derive javascript functions to query servant webservices.

Supports deriving functions using vanilla javascript AJAX requests, Angulari, Axios or JQuery.

You can find an example here which serves the generated javascript to a webpage that allows you to trigger webservice calls.

CHANGELOG


[Skip to Readme]

Properties

Versions 0.5, 0.6, 0.6.1, 0.7, 0.7.1, 0.8, 0.8.1, 0.9, 0.9.1, 0.9.2, 0.9.3, 0.9.3.1, 0.9.3.2, 0.9.4, 0.9.4, 0.9.4.1, 0.9.4.2
Change log CHANGELOG.md
Dependencies aeson (>=1.4.1.0 && <1.5), base (>=4.9 && <4.13), base-compat (>=0.10.5 && <0.11), charset (>=0.3.7.1 && <0.4), filepath (>=1), lens (>=4.17 && <4.18), servant (>=0.15 && <0.16), servant-foreign (>=0.15 && <0.16), servant-js, servant-server, stm, text (>=1.2.3.0 && <1.3), transformers, warp [details]
License BSD-3-Clause
Copyright 2015-2016 Servant Contributors
Author Servant Contributors
Maintainer haskell-servant-maintainers@googlegroups.com
Category Web, Servant
Home page http://haskell-servant.readthedocs.org/
Bug tracker http://github.com/haskell-servant/servant-js/issues
Source repo head: git clone http://github.com/haskell-servant/servant-js.git
Uploaded by phadej at 2018-11-13T22:10:36Z

Modules

[Index] [Quick Jump]

Flags

Manual Flags

NameDescriptionDefault
example

Build the example too

Disabled

Use -f <flag> to enable a flag, or -f -<flag> to disable that flag. More info

Downloads

Maintainer's Corner

Package maintainers

For package maintainers and hackage trustees


Readme for servant-js-0.9.4

[back to package description]

servant-js

servant

This library lets you derive automatically Javascript functions that let you query each endpoint of a servant webservice.

It contains a powerful system allowing you to generate functions for several frameworks (Angular, AXios, JQuery) as well as vanilla (framework-free) javascript code.

Example

Read more about the following example here.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Control.Concurrent.STM
import Control.Monad.IO.Class
import Data.Aeson
import Data.Proxy
import GHC.Generics
import Network.Wai.Handler.Warp (run)
import Servant
import Servant.JS
import System.FilePath

-- * A simple Counter data type
newtype Counter = Counter { value :: Int }
  deriving (Generic, Show, Num)

instance ToJSON Counter

-- * Shared counter operations

-- Creating a counter that starts from 0
newCounter :: IO (TVar Counter)
newCounter = newTVarIO 0

-- Increasing the counter by 1
counterPlusOne :: MonadIO m => TVar Counter -> m Counter
counterPlusOne counter = liftIO . atomically $ do
  oldValue <- readTVar counter
  let newValue = oldValue + 1
  writeTVar counter newValue
  return newValue

currentValue :: MonadIO m => TVar Counter -> m Counter
currentValue counter = liftIO $ readTVarIO counter

-- * Our API type
type TestApi = "counter" :> Post '[JSON] Counter -- endpoint for increasing the counter
          :<|> "counter" :> Get  '[JSON] Counter -- endpoint to get the current value

type TestApi' = TestApi -- The API we want a JS handler for
           :<|> Raw     -- used for serving static files

-- this proxy only targets the proper endpoints of our API,
-- not the static file serving bit
testApi :: Proxy TestApi
testApi = Proxy

-- this proxy targets everything
testApi' :: Proxy TestApi'
testApi' = Proxy

-- * Server-side handler

-- where our static files reside
www :: FilePath
www = "examples/www"

-- defining handlers
server :: TVar Counter -> Server TestApi
server counter = counterPlusOne counter     -- (+1) on the TVar
            :<|> currentValue counter       -- read the TVar

server' :: TVar Counter -> Server TestApi'
server' counter = server counter
             :<|> serveDirectory www         -- serve static files

runServer :: TVar Counter -- ^ shared variable for the counter
          -> Int          -- ^ port the server should listen on
          -> IO ()
runServer var port = run port (serve testApi' $ server' var)

main :: IO ()
main = do
  -- write the JS code to www/api.js at startup
  writeJSForAPI testApi jquery (www </> "api.js")

  -- setup a shared counter
  cnt <- newCounter

  -- listen to requests on port 8080
  runServer cnt 8080