diff --git a/README.md b/README.md new file mode 100644 index 00000000..a019805c --- /dev/null +++ b/README.md @@ -0,0 +1,96 @@ +# servant-jquery + +[![Build Status](https://secure.travis-ci.org/haskell-servant/servant-jquery.svg)](http://travis-ci.org/haskell-servant/servant-jquery) + +![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png) + +This library lets you derive automatically (JQuery based) Javascript functions that let you query each endpoint of a *servant* webservice. + +## Example + +Read more about the following example [here](https://github.com/haskell-servant/servant-jquery/tree/master/examples#examples). + +``` haskell +{-# 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 +``` \ No newline at end of file diff --git a/servant-jquery.cabal b/servant-jquery.cabal index ab8079c3..b44682ba 100644 --- a/servant-jquery.cabal +++ b/servant-jquery.cabal @@ -1,8 +1,94 @@ 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 -homepage: http://github.com/alpmestan/servant +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 @@ -11,15 +97,19 @@ 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 - -- other-extensions: build-depends: base >=4.5 && <5, servant >= 0.2, lens >= 4 hs-source-dirs: src default-language: Haskell2010 - ghc-options: -O2 -Wall + ghc-options: -Wall executable counter main-is: counter.hs