127 lines
3.9 KiB
Text
127 lines
3.9 KiB
Text
name: servant-jquery
|
|
version: 0.2
|
|
synopsis: Automatically derive jquery-based javascript functions to query servant webservices
|
|
description:
|
|
Automatically derive jquery-based javascript functions to query servant webservices.
|
|
.
|
|
Example below that serves the generated javascript to a webpage that lets you
|
|
trigger webservice calls.
|
|
.
|
|
> {-# 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.JQuery
|
|
> 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 Counter -- endpoint for increasing the counter
|
|
> :<|> "counter" :> Get Counter -- endpoint to get the current value
|
|
> :<|> Raw -- used for serving static files
|
|
>
|
|
> 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
|
|
> :<|> 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)
|
|
>
|
|
> -- * Generating the JQuery code
|
|
>
|
|
> incCounterJS :<|> currentValueJS :<|> _ = jquery testApi
|
|
>
|
|
> writeJS :: FilePath -> [AjaxReq] -> IO ()
|
|
> writeJS fp functions = writeFile fp $
|
|
> concatMap generateJS functions
|
|
>
|
|
> main :: IO ()
|
|
> main = do
|
|
> -- write the JS code to www/api.js at startup
|
|
> writeJS (www </> "api.js")
|
|
> [ incCounterJS, currentValueJS ]
|
|
>
|
|
> -- setup a shared counter
|
|
> cnt <- newCounter
|
|
>
|
|
> -- listen to requests on port 8080
|
|
> runServer cnt 8080
|
|
license: BSD3
|
|
license-file: LICENSE
|
|
author: Alp Mestanogullari
|
|
maintainer: alpmestan@gmail.com
|
|
copyright: 2014 Alp Mestanogullari
|
|
category: Web
|
|
build-type: Simple
|
|
cabal-version: >=1.10
|
|
homepage: http://haskell-servant.github.io/
|
|
Bug-reports: http://github.com/haskell-servant/servant-jquery/issues
|
|
source-repository head
|
|
type: git
|
|
location: http://github.com/haskell-servant/servant-jquery.git
|
|
|
|
library
|
|
exposed-modules: Servant.JQuery
|
|
other-modules: Servant.JQuery.Internal
|
|
build-depends: base >=4.5 && <5, servant >= 0.2, lens >= 4
|
|
hs-source-dirs: src
|
|
default-language: Haskell2010
|
|
ghc-options: -Wall
|
|
|
|
executable counter
|
|
main-is: counter.hs
|
|
ghc-options: -O2 -Wall
|
|
hs-source-dirs: examples
|
|
build-depends:
|
|
aeson
|
|
, base
|
|
, filepath
|
|
, servant >= 0.2
|
|
, servant-jquery >= 0.2
|
|
, stm
|
|
, transformers
|
|
, warp
|
|
default-language: Haskell2010
|