packages feed

servant-jquery (empty) → 0.2

raw patch · 6 files changed

+547/−0 lines, 6 filesdep +aesondep +basedep +filepathsetup-changed

Dependencies added: aeson, base, filepath, lens, servant, servant-jquery, stm, transformers, warp

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Zalora South East Asia Pte Ltd++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Zalora South East Asia Pte Ltd nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/counter.hs view
@@ -0,0 +1,82 @@+{-# 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
+ servant-jquery.cabal view
@@ -0,0 +1,127 @@+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
+ src/Servant/JQuery.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Servant.JQuery+-- Copyright   :  (C) 2014 Alp Mestanogullari+-- License     :  BSD3+-- Maintainer  :  Alp Mestanogullari <alpmestan@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable+module Servant.JQuery+  ( jquery+  , generateJS+  , printJS+  , module Servant.JQuery.Internal+  ) where++import Control.Lens+import Data.List+import Data.Monoid+import Data.Proxy+import Servant.JQuery.Internal++jquery :: HasJQ layout => Proxy layout -> JQ layout+jquery p = jqueryFor p defReq++-- js codegen+generateJS :: AjaxReq -> String+generateJS req = "\n" <>+    "function " <> fname <> "(" <> argsStr <> ")\n"+ <> "{\n"+ <> "  $.ajax(\n"+ <> "    { url: " <> url <> "\n"+ <> "    , success: onSuccess\n"+ <> dataBody+ <> reqheaders+ <> "    , error: onError\n"+ <> "    , type: '" <> method <> "'\n"+ <> "    });\n"+ <> "}\n"++  where argsStr = intercalate ", " args+        args = captures+            ++ map (view argName) queryparams+            ++ body+            ++ map ("header"++) hs+            ++ ["onSuccess", "onError"]+        +        captures = map captureArg+                 . filter isCapture+                 $ req ^. reqUrl.path++        hs = req ^. reqHeaders++        queryparams = req ^.. reqUrl.queryStr.traverse++        body = if req ^. reqBody+                 then ["body"]+                 else []++        dataBody =+          if req ^. reqBody+            then "\n    , data: JSON.stringify(body)\n"+            else ""++        reqheaders =+          if null hs+            then ""+            else "\n    , headers: { " ++ headersStr ++ " } }\n"++          where headersStr = intercalate ", " $ map headerStr hs+                headerStr hname = "\"" ++ hname ++ "\": header" ++ hname++        fname = req ^. funcName+        method = req ^. reqMethod+        url = "'"+           ++ urlArgs+           ++ queryArgs++        urlArgs = jsSegments+                $ req ^.. reqUrl.path.traverse++        queryArgs = if null queryparams+                      then ""+                      else " + '?" ++ jsParams queryparams++printJS :: AjaxReq -> IO ()+printJS = putStrLn . generateJS
+ src/Servant/JQuery/Internal.hs view
@@ -0,0 +1,217 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Servant.JQuery.Internal where++import Control.Lens+import Data.Monoid+import Data.Proxy+import GHC.TypeLits+import Servant.API++type Arg = String++data Segment = Static String -- ^ a static path segment. like "/foo"+             | Cap Arg       -- ^ a capture. like "/:userid"+  deriving (Eq, Show)+++isCapture :: Segment -> Bool+isCapture (Cap _) = True+isCapture      _  = False++captureArg :: Segment -> Arg+captureArg (Cap s) = s+captureArg      _  = error "captureArg called on non capture"++jsSegments :: [Segment] -> String+jsSegments []  = ""+jsSegments [x] = "/" ++ segmentToStr x False+jsSegments (x:xs) = "/" ++ segmentToStr x True ++ jsSegments xs++segmentToStr :: Segment -> Bool -> String+segmentToStr (Static s) notTheEnd =+  if notTheEnd then s else s ++ "'"+segmentToStr (Cap s)    notTheEnd =+  "' + encodeURIComponent(" ++ s ++ if notTheEnd then ") + '" else ")"++type Path = [Segment]++data ArgType =+    Normal+  | Flag+  | List+  deriving (Eq, Show)++data QueryArg = QueryArg+  { _argName :: Arg+  , _argType :: ArgType+  } deriving (Eq, Show)++type HeaderArg = String++data Url = Url+  { _path     :: Path+  , _queryStr :: [QueryArg]+  } deriving (Eq, Show)++defUrl :: Url+defUrl = Url [] []++type FunctionName = String+type Method = String++data AjaxReq = AjaxReq+  { _reqUrl     :: Url+  , _reqMethod  :: Method+  , _reqHeaders :: [HeaderArg]+  , _reqBody    :: Bool+  , _funcName   :: FunctionName+  } deriving (Eq, Show)++makeLenses ''QueryArg+makeLenses ''Url+makeLenses ''AjaxReq++jsParams :: [QueryArg] -> String+jsParams []  = ""+jsParams [x] = paramToStr x False+jsParams (x:xs) = paramToStr x True ++ "&" ++ jsParams xs++paramToStr :: QueryArg -> Bool -> String+paramToStr qarg notTheEnd =+  case qarg ^. argType of+    Normal -> name+           ++ "=' + encodeURIComponent("+           ++ name+           ++ if notTheEnd then ") + '" else ")"++    Flag   -> name ++ "="++    List   -> name+           ++ "[]=' + encodeURIComponent("+           ++ name+           ++ if notTheEnd then ") + '" else ")"++  where name = qarg ^. argName++defReq :: AjaxReq+defReq = AjaxReq defUrl "GET" [] False ""++class HasJQ layout where+  type JQ layout :: *+  jqueryFor :: Proxy layout -> AjaxReq -> JQ layout++instance (HasJQ a, HasJQ b)+      => HasJQ (a :<|> b) where+  type JQ (a :<|> b) = JQ a :<|> JQ b++  jqueryFor Proxy req =+         jqueryFor (Proxy :: Proxy a) req+    :<|> jqueryFor (Proxy :: Proxy b) req++instance (KnownSymbol sym, HasJQ sublayout)+      => HasJQ (Capture sym a :> sublayout) where+  type JQ (Capture sym a :> sublayout) = JQ sublayout++  jqueryFor Proxy req =+    jqueryFor (Proxy :: Proxy sublayout) $+      req & reqUrl.path <>~ [Cap str]++    where str = symbolVal (Proxy :: Proxy sym)++instance HasJQ Delete where+  type JQ Delete = AjaxReq++  jqueryFor Proxy req =+    req & funcName  %~ ("delete" <>)+        & reqMethod .~ "DELETE"++instance HasJQ (Get a) where+  type JQ (Get a) = AjaxReq++  jqueryFor Proxy req =+    req & funcName  %~ ("get" <>)+        & reqMethod .~ "GET"++instance (KnownSymbol sym, HasJQ sublayout)+      => HasJQ (Header sym a :> sublayout) where+  type JQ (Header sym a :> sublayout) = JQ sublayout++  jqueryFor Proxy req =+    jqueryFor subP (req & reqHeaders <>~ [hname])++    where hname = symbolVal (Proxy :: Proxy sym)+          subP = Proxy :: Proxy sublayout++instance HasJQ (Post a) where+  type JQ (Post a) = AjaxReq++  jqueryFor Proxy req =+    req & funcName  %~ ("post" <>)+        & reqMethod .~ "POST"++instance HasJQ (Put a) where+  type JQ (Put a) = AjaxReq++  jqueryFor Proxy req =+    req & funcName  %~ ("put" <>)+        & reqMethod .~ "PUT"++instance (KnownSymbol sym, HasJQ sublayout)+      => HasJQ (QueryParam sym a :> sublayout) where+  type JQ (QueryParam sym a :> sublayout) = JQ sublayout++  jqueryFor Proxy req =+    jqueryFor (Proxy :: Proxy sublayout) $+      req & reqUrl.queryStr <>~ [QueryArg str Normal]++    where str = symbolVal (Proxy :: Proxy sym)+          strArg = str ++ "Value"++instance (KnownSymbol sym, HasJQ sublayout)+      => HasJQ (QueryParams sym a :> sublayout) where+  type JQ (QueryParams sym a :> sublayout) = JQ sublayout++  jqueryFor Proxy req =+    jqueryFor (Proxy :: Proxy sublayout) $+      req & reqUrl.queryStr <>~ [QueryArg str List]++    where str = symbolVal (Proxy :: Proxy sym)++instance (KnownSymbol sym, HasJQ sublayout)+      => HasJQ (QueryFlag sym :> sublayout) where+  type JQ (QueryFlag sym :> sublayout) = JQ sublayout++  jqueryFor Proxy req =+    jqueryFor (Proxy :: Proxy sublayout) $+      req & reqUrl.queryStr <>~ [QueryArg str Flag]++    where str = symbolVal (Proxy :: Proxy sym)++instance HasJQ Raw where+  type JQ Raw = Method -> AjaxReq++  jqueryFor Proxy req method =+    req & reqMethod .~ method++instance HasJQ sublayout => HasJQ (ReqBody a :> sublayout) where+  type JQ (ReqBody a :> sublayout) = JQ sublayout++  jqueryFor Proxy req =+    jqueryFor (Proxy :: Proxy sublayout) $+      req & reqBody .~ True++instance (KnownSymbol path, HasJQ sublayout)+      => HasJQ (path :> sublayout) where+  type JQ (path :> sublayout) = JQ sublayout++  jqueryFor Proxy req =+    jqueryFor (Proxy :: Proxy sublayout) $+      req & reqUrl.path <>~ [Static str]+          & funcName %~ (str <>)++    where str = symbolVal (Proxy :: Proxy path)