From 21b6e96891d8281b164e843e5195759eaae39817 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Sun, 19 Apr 2015 10:07:58 +0200 Subject: [PATCH 1/5] add a jsForAPI function that takes an API type proxy and generates js functions for each endpoint, collecting the result in a big String. fixes #12 --- CHANGELOG.md | 1 + src/Servant/JQuery.hs | 25 +++++++++++++++++++++++++ 2 files changed, 26 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index ceac30d4..99eeaf5f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,7 @@ * Extend `HeaderArg` to support more advanced HTTP header handling (https://github.com/haskell-servant/servant-jquery/pull/6) * Support content-type aware combinators (but require that endpoints support JSON) * Add support for Matrix params (https://github.com/haskell-servant/servant-jquery/pull/11) +* Add functions that directly generate the Javascript code from the API type without having to manually pattern match on the result. 0.2.2 ----- diff --git a/src/Servant/JQuery.hs b/src/Servant/JQuery.hs index d979755d..22d13288 100644 --- a/src/Servant/JQuery.hs +++ b/src/Servant/JQuery.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | @@ -12,14 +13,17 @@ module Servant.JQuery ( jquery , generateJS + , jsForAPI , printJS , module Servant.JQuery.Internal + , GenerateCode(..) ) where import Control.Lens import Data.List import Data.Monoid import Data.Proxy +import Servant.API import Servant.JQuery.Internal jquery :: HasJQ layout => Proxy layout -> JQ layout @@ -90,3 +94,24 @@ generateJS req = "\n" <> printJS :: AjaxReq -> IO () printJS = putStrLn . generateJS + +-- | Utility class used by 'jsForAPI' which will +-- directly hand you all the Javascript code +-- instead of handing you a ':<|>'-separated list +-- of 'AjaxReq' like 'jquery' and then having to +-- use 'generateJS' on each 'AjaxReq'. +class GenerateCode reqs where + jsFor :: reqs -> String + +instance GenerateCode AjaxReq where + jsFor = generateJS + +instance GenerateCode rest => GenerateCode (AjaxReq :<|> rest) where + jsFor (req :<|> rest) = jsFor req ++ jsFor rest + +-- | Directly generate all the javascript functions for your API +-- from a 'Proxy' for your API type. You can then write it to +-- a file or integrate it in a page, for example. +jsForAPI :: (HasJQ api, GenerateCode (JQ api)) + => Proxy api -> String +jsForAPI p = jsFor (jquery p) From b09e2bf9da8fbb5d51859558ed1aa3dbf477b4dd Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Sun, 19 Apr 2015 11:56:29 +0200 Subject: [PATCH 2/5] add a test for jsForAPI --- servant-jquery.cabal | 2 +- test/Servant/JQuerySpec.hs | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/servant-jquery.cabal b/servant-jquery.cabal index d21d4862..e6acc9ff 100644 --- a/servant-jquery.cabal +++ b/servant-jquery.cabal @@ -74,5 +74,5 @@ test-suite spec , servant , hspec >= 2.0 , hspec-expectations - , language-ecmascript == 0.16.* + , language-ecmascript >= 0.16 default-language: Haskell2010 diff --git a/test/Servant/JQuerySpec.hs b/test/Servant/JQuerySpec.hs index 077b9b87..b8bc5152 100644 --- a/test/Servant/JQuerySpec.hs +++ b/test/Servant/JQuerySpec.hs @@ -90,3 +90,7 @@ generateJSSpec = describe "generateJS" $ do parseFromString jsText `shouldSatisfy` isRight jsText `shouldContain` "headerXWhatsForDinner" jsText `shouldContain` "headers: { \"X-WhatsForDinner\": \"I would like \" + headerXWhatsForDinner + \" with a cherry on top.\" }\n" + + it "can generate the whole javascript code string at once with jsForAPI" $ do + let jsStr = jsForAPI (Proxy :: Proxy TestAPI) + parseFromString jsStr `shouldSatisfy` isRight From 0644c8dd799bb9c568297a944a33210b37f8bc0e Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Mon, 9 Mar 2015 22:54:41 +0100 Subject: [PATCH 3/5] canonicalize API type before generating jquery functions, flattening everything on the way --- src/Servant/JQuery.hs | 4 +-- src/Servant/JQuery/Internal.hs | 32 +++++++++++++----------- test/Servant/JQuerySpec/CustomHeaders.hs | 6 ++--- 3 files changed, 22 insertions(+), 20 deletions(-) diff --git a/src/Servant/JQuery.hs b/src/Servant/JQuery.hs index 22d13288..673c81c1 100644 --- a/src/Servant/JQuery.hs +++ b/src/Servant/JQuery.hs @@ -26,8 +26,8 @@ import Data.Proxy import Servant.API import Servant.JQuery.Internal -jquery :: HasJQ layout => Proxy layout -> JQ layout -jquery p = jqueryFor p defReq +jquery :: HasJQ (Canonicalize layout) => Proxy layout -> JQ layout +jquery p = jqueryFor (canonicalize p) defReq -- js codegen generateJS :: AjaxReq -> String diff --git a/src/Servant/JQuery/Internal.hs b/src/Servant/JQuery/Internal.hs index 738acd7e..4d36b83c 100644 --- a/src/Servant/JQuery/Internal.hs +++ b/src/Servant/JQuery/Internal.hs @@ -191,12 +191,14 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where Elem a (b ': list) = Elem a list class HasJQ (layout :: *) where - type JQ layout :: * - jqueryFor :: Proxy layout -> AjaxReq -> JQ layout + type JQ' layout :: * + jqueryFor :: Proxy layout -> AjaxReq -> JQ' layout + +type JQ layout = JQ' (Canonicalize layout) instance (HasJQ a, HasJQ b) => HasJQ (a :<|> b) where - type JQ (a :<|> b) = JQ a :<|> JQ b + type JQ' (a :<|> b) = JQ' a :<|> JQ' b jqueryFor Proxy req = jqueryFor (Proxy :: Proxy a) req @@ -204,7 +206,7 @@ instance (HasJQ a, HasJQ b) instance (KnownSymbol sym, HasJQ sublayout) => HasJQ (Capture sym a :> sublayout) where - type JQ (Capture sym a :> sublayout) = JQ sublayout + type JQ' (Capture sym a :> sublayout) = JQ' sublayout jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ @@ -213,14 +215,14 @@ instance (KnownSymbol sym, HasJQ sublayout) where str = symbolVal (Proxy :: Proxy sym) instance HasJQ Delete where - type JQ Delete = AjaxReq + type JQ' Delete = AjaxReq jqueryFor Proxy req = req & funcName %~ ("delete" <>) & reqMethod .~ "DELETE" instance Elem JSON list => HasJQ (Get list a) where - type JQ (Get list a) = AjaxReq + type JQ' (Get list a) = AjaxReq jqueryFor Proxy req = req & funcName %~ ("get" <>) @@ -228,7 +230,7 @@ instance Elem JSON list => HasJQ (Get list a) where instance (KnownSymbol sym, HasJQ sublayout) => HasJQ (Header sym a :> sublayout) where - type JQ (Header sym a :> sublayout) = JQ sublayout + type JQ' (Header sym a :> sublayout) = JQ' sublayout jqueryFor Proxy req = jqueryFor subP (req & reqHeaders <>~ [HeaderArg hname]) @@ -237,14 +239,14 @@ instance (KnownSymbol sym, HasJQ sublayout) subP = Proxy :: Proxy sublayout instance Elem JSON list => HasJQ (Post list a) where - type JQ (Post list a) = AjaxReq + type JQ' (Post list a) = AjaxReq jqueryFor Proxy req = req & funcName %~ ("post" <>) & reqMethod .~ "POST" instance Elem JSON list => HasJQ (Put list a) where - type JQ (Put list a) = AjaxReq + type JQ' (Put list a) = AjaxReq jqueryFor Proxy req = req & funcName %~ ("put" <>) @@ -252,7 +254,7 @@ instance Elem JSON list => HasJQ (Put list a) where instance (KnownSymbol sym, HasJQ sublayout) => HasJQ (QueryParam sym a :> sublayout) where - type JQ (QueryParam sym a :> sublayout) = JQ sublayout + type JQ' (QueryParam sym a :> sublayout) = JQ' sublayout jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ @@ -262,7 +264,7 @@ instance (KnownSymbol sym, HasJQ sublayout) instance (KnownSymbol sym, HasJQ sublayout) => HasJQ (QueryParams sym a :> sublayout) where - type JQ (QueryParams sym a :> sublayout) = JQ sublayout + type JQ' (QueryParams sym a :> sublayout) = JQ' sublayout jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ @@ -272,7 +274,7 @@ instance (KnownSymbol sym, HasJQ sublayout) instance (KnownSymbol sym, HasJQ sublayout) => HasJQ (QueryFlag sym :> sublayout) where - type JQ (QueryFlag sym :> sublayout) = JQ sublayout + type JQ' (QueryFlag sym :> sublayout) = JQ' sublayout jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ @@ -312,14 +314,14 @@ instance (KnownSymbol sym, HasJQ sublayout) where str = symbolVal (Proxy :: Proxy sym) instance HasJQ Raw where - type JQ Raw = Method -> AjaxReq + type JQ' Raw = Method -> AjaxReq jqueryFor Proxy req method = req & funcName %~ ((toLower <$> method) <>) & reqMethod .~ method instance (Elem JSON list, HasJQ sublayout) => HasJQ (ReqBody list a :> sublayout) where - type JQ (ReqBody list a :> sublayout) = JQ sublayout + type JQ' (ReqBody list a :> sublayout) = JQ' sublayout jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ @@ -327,7 +329,7 @@ instance (Elem JSON list, HasJQ sublayout) => HasJQ (ReqBody list a :> sublayout instance (KnownSymbol path, HasJQ sublayout) => HasJQ (path :> sublayout) where - type JQ (path :> sublayout) = JQ sublayout + type JQ' (path :> sublayout) = JQ' sublayout jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ diff --git a/test/Servant/JQuerySpec/CustomHeaders.hs b/test/Servant/JQuerySpec/CustomHeaders.hs index 4480d44c..95cf4487 100644 --- a/test/Servant/JQuerySpec/CustomHeaders.hs +++ b/test/Servant/JQuerySpec/CustomHeaders.hs @@ -22,7 +22,7 @@ data Authorization (sym :: Symbol) a instance (KnownSymbol sym, HasJQ sublayout) => HasJQ (Authorization sym a :> sublayout) where - type JQ (Authorization sym a :> sublayout) = JQ sublayout + type JQ' (Authorization sym a :> sublayout) = JQ' sublayout jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $ @@ -35,7 +35,7 @@ data MyLovelyHorse a instance (HasJQ sublayout) => HasJQ (MyLovelyHorse a :> sublayout) where - type JQ (MyLovelyHorse a :> sublayout) = JQ sublayout + type JQ' (MyLovelyHorse a :> sublayout) = JQ' sublayout jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ req & reqHeaders <>~ [ ReplaceHeaderArg "X-MyLovelyHorse" tpl ] @@ -47,7 +47,7 @@ data WhatsForDinner a instance (HasJQ sublayout) => HasJQ (WhatsForDinner a :> sublayout) where - type JQ (WhatsForDinner a :> sublayout) = JQ sublayout + type JQ' (WhatsForDinner a :> sublayout) = JQ' sublayout jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ req & reqHeaders <>~ [ ReplaceHeaderArg "X-WhatsForDinner" tpl ] From d90b59e90228a3709834c2f2a5e1705123dbf189 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Sun, 19 Apr 2015 11:06:12 +0200 Subject: [PATCH 4/5] fix a couple of typos --- src/Servant/JQuery/Internal.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Servant/JQuery/Internal.hs b/src/Servant/JQuery/Internal.hs index 4d36b83c..b5bca7cb 100644 --- a/src/Servant/JQuery/Internal.hs +++ b/src/Servant/JQuery/Internal.hs @@ -284,7 +284,7 @@ instance (KnownSymbol sym, HasJQ sublayout) instance (KnownSymbol sym, HasJQ sublayout) => HasJQ (MatrixParam sym a :> sublayout) where - type JQ (MatrixParam sym a :> sublayout) = JQ sublayout + type JQ' (MatrixParam sym a :> sublayout) = JQ' sublayout jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ @@ -295,7 +295,7 @@ instance (KnownSymbol sym, HasJQ sublayout) instance (KnownSymbol sym, HasJQ sublayout) => HasJQ (MatrixParams sym a :> sublayout) where - type JQ (MatrixParams sym a :> sublayout) = JQ sublayout + type JQ' (MatrixParams sym a :> sublayout) = JQ' sublayout jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ @@ -305,7 +305,7 @@ instance (KnownSymbol sym, HasJQ sublayout) instance (KnownSymbol sym, HasJQ sublayout) => HasJQ (MatrixFlag sym :> sublayout) where - type JQ (MatrixFlag sym :> sublayout) = JQ sublayout + type JQ' (MatrixFlag sym :> sublayout) = JQ' sublayout jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $ From 95a120f1101a0d79777d5c6eb364fe153fb62f5f Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Mon, 20 Apr 2015 10:21:03 +0200 Subject: [PATCH 5/5] jsForAPI now needs to take into account Canonicalize --- src/Servant/JQuery.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Servant/JQuery.hs b/src/Servant/JQuery.hs index 673c81c1..4460e0e9 100644 --- a/src/Servant/JQuery.hs +++ b/src/Servant/JQuery.hs @@ -112,6 +112,6 @@ instance GenerateCode rest => GenerateCode (AjaxReq :<|> rest) where -- | Directly generate all the javascript functions for your API -- from a 'Proxy' for your API type. You can then write it to -- a file or integrate it in a page, for example. -jsForAPI :: (HasJQ api, GenerateCode (JQ api)) +jsForAPI :: (HasJQ (Canonicalize api), GenerateCode (JQ api)) => Proxy api -> String jsForAPI p = jsFor (jquery p)