diff --git a/servant-examples/tutorial/T9.hs b/servant-examples/tutorial/T9.hs index c3133030..140f48d6 100644 --- a/servant-examples/tutorial/T9.hs +++ b/servant-examples/tutorial/T9.hs @@ -93,7 +93,7 @@ server' = server :<|> serveDirectory "tutorial/t9" apiJS :: String -apiJS = jsForAPI api generateJQueryJS +apiJS = jsForAPI api jquery writeJSFiles :: IO () writeJSFiles = do diff --git a/servant-js/examples/counter.hs b/servant-js/examples/counter.hs index 7fad2fc3..86f274dd 100644 --- a/servant-js/examples/counter.hs +++ b/servant-js/examples/counter.hs @@ -12,8 +12,6 @@ import Network.Wai.Handler.Warp (run) import Servant import Servant.JS import qualified Servant.JS as SJS -import qualified Servant.JS.Vanilla as JS -import qualified Servant.JS.JQuery as JQ import qualified Servant.JS.Angular as NG import System.FilePath @@ -43,55 +41,58 @@ 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 - :<|> Raw -- used for serving static files +type TestApi' = TestApi + :<|> 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 +-- defining handlers of our endpoints server :: TVar Counter -> Server TestApi server counter = counterPlusOne counter -- (+1) on the TVar :<|> currentValue counter -- read the TVar - :<|> serveDirectory www -- serve static files + +-- the whole server, including static file serving +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) +runServer var port = run port (serve testApi' $ server' var) --- * Generating the JQuery code -incCounterJS :: AjaxReq -currentValueJS :: AjaxReq -incCounterJS :<|> currentValueJS :<|> _ = javascript testApi - -writeJS :: JavaScriptGenerator -> FilePath -> [AjaxReq] -> IO () -writeJS gen fp functions = writeFile fp $ - concatMap (\req -> generateJS req gen) functions - -writeServiceJS :: FilePath -> [AjaxReq] -> IO () -writeServiceJS fp functions = writeFile fp $ - NG.wrapInServiceWith (NG.defAngularOptions { NG.serviceName = "counterSvc" }) - (defCommonGeneratorOptions { SJS.moduleName = "counterApp" }) functions +writeServiceJS :: FilePath -> IO () +writeServiceJS fp = + writeJSForAPI testApi + (angularServiceWith (NG.defAngularOptions { NG.serviceName = "counterSvc" }) + (defCommonGeneratorOptions { SJS.moduleName = "counterApp" }) + ) + fp main :: IO () main = do -- write the JS code to www/api.js at startup - writeJS JQ.generateJQueryJS (www "jquery" "api.js") - [ incCounterJS, currentValueJS ] - writeJS JS.generateVanillaJS (www "vanilla" "api.js") - [ incCounterJS, currentValueJS ] - writeJS (NG.generateAngularJS - NG.defAngularOptions) (www "angular" "api.js") - [ incCounterJS, currentValueJS ] - writeServiceJS - (www "angular" "api.service.js") - [ incCounterJS, currentValueJS ] + writeJSForAPI testApi jquery (www "jquery" "api.js") + + writeJSForAPI testApi vanillaJS (www "vanilla" "api.js") + + writeJSForAPI testApi (angular defAngularOptions) (www "angular" "api.js") + + writeServiceJS (www "angular" "api.service.js") -- setup a shared counter cnt <- newCounter diff --git a/servant-js/servant-js.cabal b/servant-js/servant-js.cabal index 3bfe803d..2fa38e0c 100644 --- a/servant-js/servant-js.cabal +++ b/servant-js/servant-js.cabal @@ -38,7 +38,7 @@ library Servant.JS.Angular Servant.JS.JQuery Servant.JS.Vanilla - other-modules: Servant.JS.Internal + Servant.JS.Internal build-depends: base >=4.5 && <5 , charset , lens >= 4 diff --git a/servant-js/src/Servant/JS.hs b/servant-js/src/Servant/JS.hs index 3c315183..1367fffd 100644 --- a/servant-js/src/Servant/JS.hs +++ b/servant-js/src/Servant/JS.hs @@ -4,56 +4,140 @@ {-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | --- Module : Servant.JQuery +-- Module : Servant.JS -- License : BSD3 -- Maintainer : Alp Mestanogullari -- Stability : experimental -- Portability : non-portable +-- +-- Generating Javascript code to query your APIs using vanilla Javascript, +-- Angular.js or JQuery. +-- +-- Using this package is very simple. Say you have this API type around: +-- +-- > type API = "users" :> Get '[JSON] [Users] +-- > :<|> "messages" :> Get '[JSON] [Message] +-- +-- All you need to do to generate the Javascript code is to write a 'Proxy' +-- for this API type: +-- +-- > api :: Proxy API +-- > api = Proxy +-- +-- And pick one of the generators: +-- +-- - 'vanillaJS' and 'vanillaJSWith' generate functions that use +-- /XMLHttpRequest/ to query your endpoints. The former just calls +-- the latter with default code-generation options. +-- - 'jquery' and 'jqueryWith' follow the same pattern except that they +-- generate functions that use /jQuery/'s AJAX functions. +-- - 'angular' and 'angularWith' do the same but use /Angular.js/'s $http +-- service. In addition, we provide 'angularService' and 'angularServiceWith' +-- which produce functions under an Angular service that your controlers +-- can depend on to query the API. +-- +-- Let's keep it simple and produce vanilla Javascript code with the default options. +-- +-- @ +-- jsCode :: String +-- jsCode = 'jsForAPI' api 'vanillaJS' +-- @ +-- +-- That's it! If you want to write that code to a file: +-- +-- @ +-- writeJSCode :: IO () +-- writeJSCode = 'writeJSForAPI' api 'vanillaJS' "./my_api.js" +-- @ +-- +-- If you want to customize the rendering options, take a look +-- at 'CommonGeneratorOptions' which are generic options common to all the +-- generators. the /xxxWith/ variants all take 'CommonGeneratorOptions' whereas +-- the /xxx/ versions use 'defCommonGeneratorOptions'. Once you have some custom +-- +-- > myOptions :: 'CommonGeneratorOptions' +-- +-- All you need to do to use it is to use 'vanillaJSWith' and pass it @myOptions@. +-- +-- @ +-- jsCodeWithMyOptions :: String +-- jsCodeWithMyOptions = 'jsForAPI' api ('vanillaJSWith' myOptions) +-- @ +-- +-- Follow the same pattern for any other generator. +-- +-- /Note/: The Angular generators take an additional type of options, +-- namely 'AngularOptions', to let you tweak aspects of the code generation +-- that are specific to /Angular.js/. module Servant.JS - ( javascript - , generateJS - , jsForAPI - , listFromAPI - , printJS - , module Servant.JS.Internal - , GenerateCode(..) - , CommonGeneratorOptions(..) + ( -- * Generating javascript code from an API type + jsForAPI + , writeJSForAPI + , JavaScriptGenerator + + , -- * Options common to all generators + CommonGeneratorOptions(..) + , defCommonGeneratorOptions + + , -- * Vanilla Javascript code generation + vanillaJS + , vanillaJSWith + + , -- * JQuery code generation + jquery + , jqueryWith + + , -- * Angular.js code generation + angular + , angularWith + , angularService + , angularServiceWith + , AngularOptions(..) + , defAngularOptions + + , -- * Misc. + listFromAPI + , javascript + , HasJS(..) + , GenerateList(..) + , AjaxReq ) where import Data.Proxy import Servant.API +import Servant.JS.Angular import Servant.JS.Internal +import Servant.JS.JQuery +import Servant.JS.Vanilla +-- | Generate the data necessary to generate javascript code +-- for all the endpoints of an API, as ':<|>'-separated values +-- of type 'AjaxReq'. javascript :: HasJS layout => Proxy layout -> JS layout javascript p = javascriptFor p defReq -printJS :: AjaxReq -> JavaScriptGenerator -> IO () -printJS req gen = putStrLn (generateJS req gen) - -generateJS :: AjaxReq -> JavaScriptGenerator -> String -generateJS req gen = gen $ req - --- | Utility class used by 'jsForAPI' which will --- directly hand you all the Javascript code --- instead of handing you a ':<|>'-separated list --- of 'AjaxReq' like 'javascript' and then having to --- use 'generateJS' on each 'AjaxReq'. -class GenerateCode reqs where - jsFor :: reqs -> JavaScriptGenerator -> String - -instance GenerateCode AjaxReq where - jsFor = generateJS - -instance GenerateCode rest => GenerateCode (AjaxReq :<|> rest) where - jsFor (req :<|> rest) gen = jsFor req gen ++ jsFor rest gen - -- | 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 :: (HasJS api, GenerateCode (JS api)) => Proxy api - -> JavaScriptGenerator -> String -jsForAPI p = jsFor (javascript p) +jsForAPI :: (HasJS api, GenerateList (JS api)) + => Proxy api -- ^ proxy for your API type + -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others) + -> String -- ^ a string that you can embed in your pages or write to a file +jsForAPI p gen = gen (listFromAPI p) +-- | Directly generate all the javascript functions for your API +-- from a 'Proxy' for your API type using the given generator +-- and write the resulting code to a file at the given path. +writeJSForAPI :: (HasJS api, GenerateList (JS api)) + => Proxy api -- ^ proxy for your API type + -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others) + -> FilePath -- ^ path to the file you want to write the resulting javascript code into + -> IO () +writeJSForAPI p gen fp = writeFile fp (jsForAPI p gen) + +-- | Utility class used by 'jsForAPI' which computes +-- the data needed to generate a function for each endpoint +-- and hands it all back in a list. class GenerateList reqs where generateList :: reqs -> [AjaxReq] @@ -63,5 +147,7 @@ instance GenerateList AjaxReq where instance GenerateList rest => GenerateList (AjaxReq :<|> rest) where generateList (r :<|> rest) = r : generateList rest +-- | Generate the necessary data for JS codegen as a list, each 'AjaxReq' +-- describing one endpoint from your API type. listFromAPI :: (HasJS api, GenerateList (JS api)) => Proxy api -> [AjaxReq] listFromAPI p = generateList (javascript p) diff --git a/servant-js/src/Servant/JS/Angular.hs b/servant-js/src/Servant/JS/Angular.hs index 0d11592a..68ff0a27 100644 --- a/servant-js/src/Servant/JS/Angular.hs +++ b/servant-js/src/Servant/JS/Angular.hs @@ -5,6 +5,7 @@ import Control.Lens import Data.List import Data.Monoid +-- | Options specific to the angular code generator data AngularOptions = AngularOptions { serviceName :: String -- ^ When generating code with wrapInService, -- name of the service to generate @@ -24,28 +25,37 @@ defAngularOptions = AngularOptions -- | Instead of simply generating top level functions, generates a service instance -- on which your controllers can depend to access your API. -- This variant uses default 'AngularOptions'. -wrapInService :: AngularOptions -> [AjaxReq] -> String -wrapInService ngOpts reqs = wrapInServiceWith ngOpts defCommonGeneratorOptions reqs +angularService :: AngularOptions -> JavaScriptGenerator +angularService ngOpts = angularServiceWith ngOpts defCommonGeneratorOptions -- | Instead of simply generating top level functions, generates a service instance -- on which your controllers can depend to access your API -wrapInServiceWith :: AngularOptions -> CommonGeneratorOptions -> [AjaxReq] -> String -wrapInServiceWith ngOpts opts reqs = - ((prologue ngOpts) svc mName) - <> (intercalate "," $ map generator reqs) <> - (epilogue ngOpts) +angularServiceWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator +angularServiceWith ngOpts opts reqs = + prologue ngOpts svc mName + <> intercalate "," (map generator reqs) <> + epilogue ngOpts where - generator req = (generateAngularJSWith ngOpts opts req) + generator req = generateAngularJSWith ngOpts opts req svc = serviceName ngOpts mName = if null (moduleName opts) then "app." - else (moduleName opts) <> "." - --- js codegen using $http service from Angular using default options + else moduleName opts <> "." + +-- | Generate regular javacript functions that use +-- the $http service, using default values for 'CommonGeneratorOptions'. +angular :: AngularOptions -> JavaScriptGenerator +angular ngopts = angularWith ngopts defCommonGeneratorOptions + +-- | Generate regular javascript functions that use the $http service. +angularWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator +angularWith ngopts opts = intercalate "\n\n" . map (generateAngularJSWith ngopts opts) + +-- | js codegen using $http service from Angular using default options generateAngularJS :: AngularOptions -> AjaxReq -> String generateAngularJS ngOpts = generateAngularJSWith ngOpts defCommonGeneratorOptions --- js codegen using $http service from Angular +-- | js codegen using $http service from Angular generateAngularJSWith :: AngularOptions -> CommonGeneratorOptions -> AjaxReq -> String generateAngularJSWith ngOptions opts req = "\n" <> fname <> fsep <> " function(" <> argsStr <> ")\n" diff --git a/servant-js/src/Servant/JS/Internal.hs b/servant-js/src/Servant/JS/Internal.hs index c2d04ad3..909df8d2 100644 --- a/servant-js/src/Servant/JS/Internal.hs +++ b/servant-js/src/Servant/JS/Internal.hs @@ -36,6 +36,17 @@ data CommonGeneratorOptions = CommonGeneratorOptions , moduleName :: String -- ^ namespace on which we define the js function (empty mean local var) } +-- | Default options. +-- +-- @ +-- > defCommonGeneratorOptions = CommonGeneratorOptions +-- > { functionRenamer = id +-- > , requestBody = "body" +-- > , successCallback = "onSuccess" +-- > , errorCallback = "onError" +-- > , moduleName = "" +-- > } +-- @ defCommonGeneratorOptions :: CommonGeneratorOptions defCommonGeneratorOptions = CommonGeneratorOptions { @@ -48,7 +59,10 @@ defCommonGeneratorOptions = CommonGeneratorOptions type Arg = String -type JavaScriptGenerator = AjaxReq -> String +-- A 'JavascriptGenerator' just takes the data found in the API type +-- for each endpoint and generates Javascript code in a String. Several +-- generators are available in this package. +type JavaScriptGenerator = [AjaxReq] -> String data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] } deriving (Eq, Show) diff --git a/servant-js/src/Servant/JS/JQuery.hs b/servant-js/src/Servant/JS/JQuery.hs index 5a446c40..be36792e 100644 --- a/servant-js/src/Servant/JS/JQuery.hs +++ b/servant-js/src/Servant/JS/JQuery.hs @@ -5,6 +5,17 @@ import Control.Lens import Data.List import Data.Monoid +-- | Generate javascript functions that use the /jQuery/ library +-- to make the AJAX calls. Uses 'defCommonGeneratorOptions' +-- for the generator options. +jquery :: JavaScriptGenerator +jquery = concat . map generateJQueryJS + +-- | Generate javascript functions that use the /jQuery/ library +-- to make the AJAX calls. Lets you specify your own 'CommonGeneratorOptions'. +jqueryWith :: CommonGeneratorOptions -> JavaScriptGenerator +jqueryWith opts = concat . map (generateJQueryJSWith opts) + -- | js codegen using JQuery using default options generateJQueryJS :: AjaxReq -> String generateJQueryJS = generateJQueryJSWith defCommonGeneratorOptions diff --git a/servant-js/src/Servant/JS/Vanilla.hs b/servant-js/src/Servant/JS/Vanilla.hs index 6bbb55c3..c9b0fb49 100644 --- a/servant-js/src/Servant/JS/Vanilla.hs +++ b/servant-js/src/Servant/JS/Vanilla.hs @@ -5,6 +5,18 @@ import Control.Lens import Data.List import Data.Monoid +-- | Generate vanilla javascript functions to make AJAX requests +-- to your API, using /XMLHttpRequest/. Uses 'defCommonGeneratorOptions' +-- for the 'CommonGeneratorOptions'. +vanillaJS :: JavaScriptGenerator +vanillaJS = concat . map generateVanillaJS + +-- | Generate vanilla javascript functions to make AJAX requests +-- to your API, using /XMLHttpRequest/. Lets you specify your +-- own options. +vanillaJSWith :: CommonGeneratorOptions -> JavaScriptGenerator +vanillaJSWith opts = concat . map (generateVanillaJSWith opts) + -- | js codegen using XmlHttpRequest using default generation options generateVanillaJS :: AjaxReq -> String generateVanillaJS = generateVanillaJSWith defCommonGeneratorOptions diff --git a/servant-js/test/Servant/JSSpec.hs b/servant-js/test/Servant/JSSpec.hs index d451e438..0025f3b7 100644 --- a/servant-js/test/Servant/JSSpec.hs +++ b/servant-js/test/Servant/JSSpec.hs @@ -97,15 +97,13 @@ angularSpec test = describe specLabel $ do output _ = return () testName = "MyService" ngOpts = NG.defAngularOptions { NG.serviceName = testName } - genJS req = NG.wrapInService ngOpts req + genJS req = NG.angularService ngOpts req generateJSSpec :: TestNames -> (AjaxReq -> String) -> Spec generateJSSpec n gen = describe specLabel $ do it "should generate valid javascript" $ do - let (postSimple :<|> getHasExtension ) = javascript (Proxy :: Proxy TestAPI) - parseFromString (genJS postSimple) `shouldSatisfy` isRight - parseFromString (genJS getHasExtension) `shouldSatisfy` isRight - output $ genJS getHasExtension + let s = jsForAPI (Proxy :: Proxy TestAPI) (concat . map gen) + parseFromString s `shouldSatisfy` isRight it "should use non-empty function names" $ do let (_ :<|> topLevel) = javascript (Proxy :: Proxy TopLevelRawAPI) @@ -141,13 +139,13 @@ generateJSSpec n gen = describe specLabel $ do jsText `shouldContain` (header n "X-WhatsForDinner" $ "\"I would like \" + headerXWhatsForDinner + \" with a cherry on top.\"") it "can generate the whole javascript code string at once with jsForAPI" $ do - let jsStr = jsForAPI (Proxy :: Proxy TestAPI) gen + let jsStr = jsForAPI (Proxy :: Proxy TestAPI) (concat . map gen) parseFromString jsStr `shouldSatisfy` isRight where specLabel = "generateJS(" ++ (show n) ++ ")" --output = print output _ = return () - genJS req = generateJS req gen + genJS req = gen req header :: TestNames -> String -> String -> String header v headerName headerValue | v `elem` [Vanilla, VanillaCustom] = "xhr.setRequestHeader(\"" ++ headerName ++ "\", " ++ headerValue ++ ");\n" diff --git a/servant-js/test/Servant/JSSpec/CustomHeaders.hs b/servant-js/test/Servant/JSSpec/CustomHeaders.hs index 9b94e637..af89d174 100644 --- a/servant-js/test/Servant/JSSpec/CustomHeaders.hs +++ b/servant-js/test/Servant/JSSpec/CustomHeaders.hs @@ -14,6 +14,7 @@ import Data.Proxy import GHC.TypeLits import Servant.API import Servant.JS +import Servant.JS.Internal -- | This is a hypothetical combinator that fetches an Authorization header. -- The symbol in the header denotes what kind of authentication we are