From 98b6e8512859f5783e9e97266419ac090485aadc Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Mon, 17 Aug 2015 23:50:42 +0200 Subject: [PATCH] Contributing --- .stylish-haskell.yaml | 77 +++++++++++++++++++ HLint.hs | 6 ++ README.md | 53 +++++++++++-- servant-client/src/Servant/Common/Req.hs | 2 +- servant-js/src/Servant/JS/Internal.hs | 12 +-- servant-js/src/Servant/JS/JQuery.hs | 8 +- servant-js/src/Servant/JS/Vanilla.hs | 12 +-- servant-js/test/Servant/JSSpec.hs | 20 ++--- servant-mock/src/Servant/Mock.hs | 36 ++++----- servant-server/src/Servant/Server/Internal.hs | 8 +- servant/default.nix | 24 ------ servant/test/Servant/API/ContentTypesSpec.hs | 6 +- 12 files changed, 180 insertions(+), 84 deletions(-) create mode 100644 .stylish-haskell.yaml create mode 100644 HLint.hs diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml new file mode 100644 index 00000000..cb559b12 --- /dev/null +++ b/.stylish-haskell.yaml @@ -0,0 +1,77 @@ +# stylish-haskell configuration file +# ================================== + +# The stylish-haskell tool is mainly configured by specifying steps. These steps +# are a list, so they have an order, and one specific step may appear more than +# once (if needed). Each file is processed by these steps in the given order. +steps: + # Convert some ASCII sequences to their Unicode equivalents. This is disabled + # by default. + # - unicode_syntax: + # # In order to make this work, we also need to insert the UnicodeSyntax + # # language pragma. If this flag is set to true, we insert it when it's + # # not already present. You may want to disable it if you configure + # # language extensions using some other method than pragmas. Default: + # # true. + # add_language_pragma: true + + # Import cleanup + - imports: + # There are different ways we can align names and lists. + # + # - global: Align the import names and import list throughout the entire + # file. + # + # - file: Like global, but don't add padding when there are no qualified + # imports in the file. + # + # - group: Only align the imports per group (a group is formed by adjacent + # import lines). + # + # - none: Do not perform any alignment. + # + # Default: global. + align: global + + # Language pragmas + - language_pragmas: + # We can generate different styles of language pragma lists. + # + # - vertical: Vertical-spaced language pragmas, one per line. + # + # - compact: A more compact style. + # + # - compact_line: Similar to compact, but wrap each line with + # `{-#LANGUAGE #-}'. + # + # Default: vertical. + style: vertical + + # stylish-haskell can detect redundancy of some language pragmas. If this + # is set to true, it will remove those redundant pragmas. Default: true. + remove_redundant: true + + # Align the types in record declarations + - records: {} + + # Replace tabs by spaces. This is disabled by default. + # - tabs: + # # Number of spaces to use for each tab. Default: 8, as specified by the + # # Haskell report. + # spaces: 8 + + # Remove trailing whitespace + - trailing_whitespace: {} + +# A common setting is the number of columns (parts of) code will be wrapped +# to. Different steps take this into account. Default: 80. +columns: 80 + +# Sometimes, language extensions are specified in a cabal file or from the +# command line instead of using language pragmas in the file. stylish-haskell +# needs to be aware of these, so it can parse the file correctly. +# +# No language extensions are enabled by default. +language_extensions: + - TemplateHaskell + - QuasiQuotes diff --git a/HLint.hs b/HLint.hs new file mode 100644 index 00000000..efc99fef --- /dev/null +++ b/HLint.hs @@ -0,0 +1,6 @@ +import "hint" HLint.Default + +ignore "Redundant do" +ignore "Parse error" +ignore "Use list comprehension" +ignore "Use liftM" diff --git a/README.md b/README.md index ebdae484..a879e131 100644 --- a/README.md +++ b/README.md @@ -5,17 +5,56 @@ ![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png) -These libraries provides a family of combinators to define webservices and automatically generate the documentation and client-side querying functions for each endpoint. +These libraries provides a family of combinators to define webservices and +automatically generate the documentation and client-side querying functions for +each endpoint. -In order to minimize the dependencies depending on your needs, we provide these features under different packages. +In order to minimize the dependencies depending on your needs, we provide these +features under different packages. - `servant`, which contains everything you need to *declare* a webservice API. -- `servant-server`, which lets you *implement* an HTTP server with handlers for each endpoint of an API. -- `servant-client`, which lets you derive automatically Haskell functions that let you query each endpoint of a `servant` webservice. +- `servant-server`, which lets you *implement* an HTTP server with handlers for +each endpoint of an API. +- `servant-client`, which lets you derive automatically Haskell functions that +let you query each endpoint of a `servant` webservice. - `servant-docs`, which lets you generate API docs for your webservice. -- `servant-js`, which lets you derive Javascript functions (using vanilla JS ajax requests, angular or jquery) to query your API's endpoints, in the same spirit as `servant-client`. -- `servant-blaze` and `servant-lucid` provide easy HTML rendering of your data as an `HTML` content-type "combinator". +- `servant-js`, which lets you derive Javascript functions (using vanilla JS +ajax requests, angular or jquery) to query your API's endpoints, in the same +spirit as `servant-client`. +- `servant-blaze` and `servant-lucid` provide easy HTML rendering of your data +as an `HTML` content-type "combinator". ## Tutorial -We have a [tutorial](http://haskell-servant.github.io/tutorial) guide that introduces the core types and features of servant. After this article, you should be able to write your first servant webservices, learning the rest from the haddocks' examples. +We have a [tutorial](http://haskell-servant.github.io/tutorial) guide that +introduces the core types and features of servant. After this article, you +should be able to write your first servant webservices, learning the rest from +the haddocks' examples. + +## Contributing + +Contributions are very welcome! To hack on the github version, clone the +repository. You can use `cabal`: + +```shell +./scripts/start-sandbox.sh # Initialize the sandbox and add-source the packages +./scripts/test-all.sh # Run all the tests +``` + +`stack`: + +```shell +stack build # Install and build packages +stack test # Run all the tests +``` + +Or `nix`: +```shell +./scripts/update-nix-files.sh # Get up-to-date shell.nix files +``` + +Though we aren't sticklers for style, the `.stylish-haskel.yaml` and `HLint.hs` +files in the repository provide a good baseline for consistency. + +Please include a description of the changes in your PR in the `CHANGELOG.md` of +the packages you've changed. And of course, write tests! diff --git a/servant-client/src/Servant/Common/Req.hs b/servant-client/src/Servant/Common/Req.hs index d6933e34..4a6a63a6 100644 --- a/servant-client/src/Servant/Common/Req.hs +++ b/servant-client/src/Servant/Common/Req.hs @@ -99,7 +99,7 @@ setRQBody b t req = req { reqBody = Just (b, t) } reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request reqToRequest req (BaseUrl reqScheme reqHost reqPort) = - fmap (setheaders . setAccept . setrqb . setQS ) $ parseUrl url + setheaders . setAccept . setrqb . setQS <$> parseUrl url where url = show $ nullURI { uriScheme = case reqScheme of Http -> "http:" diff --git a/servant-js/src/Servant/JS/Internal.hs b/servant-js/src/Servant/JS/Internal.hs index 9e28820f..22a26cd0 100644 --- a/servant-js/src/Servant/JS/Internal.hs +++ b/servant-js/src/Servant/JS/Internal.hs @@ -28,7 +28,7 @@ import Servant.API -- | this structure is used by JavaScriptGenerator implementations to let you -- customize the output data CommonGeneratorOptions = CommonGeneratorOptions - { + { functionNameBuilder :: FunctionName -> String -- ^ function generating function names , requestBody :: String -- ^ name used when a user want to send the request body (to let you redefine it) , successCallback :: String -- ^ name of the callback parameter when the request was successful @@ -63,12 +63,12 @@ defCommonGeneratorOptions = CommonGeneratorOptions -- | Function name builder that simply concat each part together concatCase :: FunctionName -> String concatCase = concat - + -- | Function name builder using the snake_case convention. -- each part is separated by a single underscore character. snakeCase :: FunctionName -> String snakeCase = intercalate "_" - + -- | Function name builder using the CamelCase convention. -- each part begins with an upper case character. camelCase :: FunctionName -> String @@ -78,7 +78,7 @@ camelCase (p:ps) = concat $ p : camelCase' ps camelCase' (r:rs) = capitalize r : camelCase' rs capitalize [] = [] capitalize (x:xs) = toUpper x : xs - + type Arg = String -- A 'JavascriptGenerator' just takes the data found in the API type @@ -141,8 +141,8 @@ toValidFunctionName (x:xs) = [setFirstChar x] <> filter remainder xs setFirstChar c = if firstChar c then c else '_' - firstChar c = (prefixOK c) || (or . map (Set.member c) $ firstLetterOK) - remainder c = (prefixOK c) || (or . map (Set.member c) $ remainderOK) + firstChar c = prefixOK c || any (Set.member c) firstLetterOK + remainder c = prefixOK c || any (Set.member c) remainderOK -- Valid prefixes prefixOK c = c `elem` ['$','_'] -- Unicode character sets diff --git a/servant-js/src/Servant/JS/JQuery.hs b/servant-js/src/Servant/JS/JQuery.hs index e0d2f79f..97831573 100644 --- a/servant-js/src/Servant/JS/JQuery.hs +++ b/servant-js/src/Servant/JS/JQuery.hs @@ -9,12 +9,12 @@ import Data.Monoid -- to make the AJAX calls. Uses 'defCommonGeneratorOptions' -- for the generator options. jquery :: JavaScriptGenerator -jquery = concat . map generateJQueryJS +jquery = concatMap 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) +jqueryWith opts = concatMap (generateJQueryJSWith opts) -- | js codegen using JQuery using default options generateJQueryJS :: AjaxReq -> String @@ -53,7 +53,7 @@ generateJQueryJSWith opts req = "\n" <> body = if req ^. reqBody then [requestBody opts] else [] - + onSuccess = successCallback opts onError = errorCallback opts @@ -77,7 +77,7 @@ generateJQueryJSWith opts req = "\n" <> then "var " else (moduleName opts) <> "." fname = namespace <> (functionNameBuilder opts $ req ^. funcName) - + method = req ^. reqMethod url = if url' == "'" then "'/'" else url' url' = "'" diff --git a/servant-js/src/Servant/JS/Vanilla.hs b/servant-js/src/Servant/JS/Vanilla.hs index 40559ef3..b03d4cac 100644 --- a/servant-js/src/Servant/JS/Vanilla.hs +++ b/servant-js/src/Servant/JS/Vanilla.hs @@ -9,13 +9,13 @@ import Data.Monoid -- to your API, using /XMLHttpRequest/. Uses 'defCommonGeneratorOptions' -- for the 'CommonGeneratorOptions'. vanillaJS :: JavaScriptGenerator -vanillaJS = concat . map generateVanillaJS +vanillaJS = concatMap 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) +vanillaJSWith opts = concatMap (generateVanillaJSWith opts) -- | js codegen using XmlHttpRequest using default generation options generateVanillaJS :: AjaxReq -> String @@ -56,11 +56,11 @@ generateVanillaJSWith opts req = "\n" <> hs = req ^. reqHeaders queryparams = req ^.. reqUrl.queryStr.traverse - + body = if req ^. reqBody then [requestBody opts] else [] - + onSuccess = successCallback opts onError = errorCallback opts @@ -68,7 +68,7 @@ generateVanillaJSWith opts req = "\n" <> if req ^. reqBody then "JSON.stringify(body)\n" else "null" - + reqheaders = if null hs @@ -84,7 +84,7 @@ generateVanillaJSWith opts req = "\n" <> then "var " else (moduleName opts) <> "." fname = namespace <> (functionNameBuilder opts $ req ^. funcName) - + method = req ^. reqMethod url = if url' == "'" then "'/'" else url' url' = "'" diff --git a/servant-js/test/Servant/JSSpec.hs b/servant-js/test/Servant/JSSpec.hs index ec7bc000..38670bc3 100644 --- a/servant-js/test/Servant/JSSpec.hs +++ b/servant-js/test/Servant/JSSpec.hs @@ -65,7 +65,7 @@ customOptions = defCommonGeneratorOptions { successCallback = "okCallback" , errorCallback = "errorCallback" } - + spec :: Spec spec = describe "Servant.JQuery" $ do generateJSSpec Vanilla JS.generateVanillaJS @@ -76,12 +76,12 @@ spec = describe "Servant.JQuery" $ do generateJSSpec AngularCustom (NG.generateAngularJSWith NG.defAngularOptions customOptions) generateJSSpec Axios (AX.generateAxiosJS AX.defAxiosOptions) generateJSSpec AxiosCustom (AX.generateAxiosJSWith (AX.defAxiosOptions { withCredentials = True }) customOptions) - + angularSpec Angular axiosSpec --angularSpec AngularCustom -axiosSpec :: Spec +axiosSpec :: Spec axiosSpec = describe specLabel $ do it "should add withCredentials when needed" $ do let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI) @@ -102,20 +102,20 @@ axiosSpec = describe specLabel $ do cookieOpts = AX.defAxiosOptions { AX.xsrfCookieName = Just "MyXSRFcookie" } headerOpts = AX.defAxiosOptions { AX.xsrfHeaderName = Just "MyXSRFheader" } genJS :: AxiosOptions -> [AjaxReq] -> String - genJS opts req = concat $ map (AX.generateAxiosJS opts) req + genJS opts req = concatMap (AX.generateAxiosJS opts) req -angularSpec :: TestNames -> Spec +angularSpec :: TestNames -> Spec angularSpec test = describe specLabel $ do it "should implement a service globally" $ do let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) output jsText jsText `shouldContain` (".service('" ++ testName ++ "'") - + it "should depend on $http service globally" $ do let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) output jsText jsText `shouldContain` ("('" ++ testName ++ "', function($http) {") - + it "should not depend on $http service in handlers" $ do let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) output jsText @@ -126,11 +126,11 @@ angularSpec test = describe specLabel $ do testName = "MyService" ngOpts = NG.defAngularOptions { NG.serviceName = testName } genJS req = NG.angularService ngOpts req - + generateJSSpec :: TestNames -> (AjaxReq -> String) -> Spec generateJSSpec n gen = describe specLabel $ do it "should generate valid javascript" $ do - let s = jsForAPI (Proxy :: Proxy TestAPI) (concat . map gen) + let s = jsForAPI (Proxy :: Proxy TestAPI) (concatMap gen) parseFromString s `shouldSatisfy` isRight it "should use non-empty function names" $ do @@ -167,7 +167,7 @@ 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) (concat . map gen) + let jsStr = jsForAPI (Proxy :: Proxy TestAPI) (concatMap gen) parseFromString jsStr `shouldSatisfy` isRight where specLabel = "generateJS(" ++ (show n) ++ ")" diff --git a/servant-mock/src/Servant/Mock.hs b/servant-mock/src/Servant/Mock.hs index 9382d40f..ddc836da 100644 --- a/servant-mock/src/Servant/Mock.hs +++ b/servant-mock/src/Servant/Mock.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -- | -- Module : Servant.Mock -- Copyright : 2015 Alp Mestanogullari @@ -51,18 +51,18 @@ module Servant.Mock ( HasMock(..) ) where #if !MIN_VERSION_base(4,8,0) -import Control.Applicative +import Control.Applicative #endif -import Control.Monad.IO.Class -import Data.ByteString.Lazy.Char8 (pack) -import Data.Proxy -import GHC.TypeLits -import Network.HTTP.Types.Status -import Network.Wai -import Servant -import Servant.API.ContentTypes -import Test.QuickCheck.Arbitrary (Arbitrary(..), vector) -import Test.QuickCheck.Gen (Gen, generate) +import Control.Monad.IO.Class +import Data.ByteString.Lazy.Char8 (pack) +import Data.Proxy +import GHC.TypeLits +import Network.HTTP.Types.Status +import Network.Wai +import Servant +import Servant.API.ContentTypes +import Test.QuickCheck.Arbitrary (Arbitrary (..), vector) +import Test.QuickCheck.Gen (Gen, generate) -- | 'HasMock' defines an interpretation of API types -- than turns them into random-response-generating @@ -169,7 +169,7 @@ instance HasMock Raw where bdy <- genBody respond $ responseLBS status200 [] bdy - where genBody = fmap pack $ generate (vector 100 :: Gen [Char]) + where genBody = pack <$> generate (vector 100 :: Gen [Char]) mockArbitrary :: (MonadIO m, Arbitrary a) => m a mockArbitrary = liftIO (generate arbitrary) diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 5aaff73f..9db11353 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -137,9 +137,7 @@ processMethodRouter handleA status method headers request = case handleA of Nothing -> failWith UnsupportedMediaType Just (contentT, body) -> succeedWith $ responseLBS status hdrs bdy where - bdy = case allowedMethodHead method request of - True -> "" - False -> body + bdy = if allowedMethodHead method request then "" else body hdrs = (hContentType, cs contentT) : (fromMaybe [] headers) methodRouter :: (AllCTRender ctypes a) @@ -512,7 +510,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout) -- named "foo" or "foo[]" and call fromText on the -- corresponding values parameters = filter looksLikeParam querytext - values = catMaybes $ map (convert . snd) parameters + values = mapMaybe (convert . snd) parameters in route (Proxy :: Proxy sublayout) (feedTo subserver values) where paramname = cs $ symbolVal (Proxy :: Proxy sym) looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]") @@ -625,7 +623,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout) -- named "foo" or "foo[]" and call fromText on the -- corresponding values parameters = filter looksLikeParam matrixtext - values = catMaybes $ map (convert . snd) parameters + values = mapMaybe (convert . snd) parameters route (Proxy :: Proxy sublayout) (feedTo subserver values) _ -> route (Proxy :: Proxy sublayout) (feedTo subserver []) where paramname = cs $ symbolVal (Proxy :: Proxy sym) diff --git a/servant/default.nix b/servant/default.nix index 0bf96999..e69de29b 100644 --- a/servant/default.nix +++ b/servant/default.nix @@ -1,24 +0,0 @@ -{ mkDerivation, aeson, attoparsec, base, bytestring -, bytestring-conversion, case-insensitive, directory, doctest -, filemanip, filepath, hspec, http-media, http-types, network-uri -, parsec, QuickCheck, quickcheck-instances, stdenv -, string-conversions, text, url, vault -}: -mkDerivation { - pname = "servant"; - version = "0.5"; - src = ./.; - buildDepends = [ - aeson attoparsec base bytestring bytestring-conversion - case-insensitive http-media http-types network-uri - string-conversions text vault - ]; - testDepends = [ - aeson attoparsec base bytestring directory doctest filemanip - filepath hspec parsec QuickCheck quickcheck-instances - string-conversions text url - ]; - homepage = "http://haskell-servant.github.io/"; - description = "A family of combinators for defining webservices APIs"; - license = stdenv.lib.licenses.bsd3; -} diff --git a/servant/test/Servant/API/ContentTypesSpec.hs b/servant/test/Servant/API/ContentTypesSpec.hs index 1dbd64b9..85296ec5 100644 --- a/servant/test/Servant/API/ContentTypesSpec.hs +++ b/servant/test/Servant/API/ContentTypesSpec.hs @@ -57,15 +57,15 @@ spec = describe "Servant.API.ContentTypes" $ do let p = Proxy :: Proxy FormUrlEncoded it "has mimeUnrender reverse mimeRender" $ do - property $ \x -> all (/= mempty) x + property $ \x -> mempty `notElem` x ==> mimeUnrender p (mimeRender p x) == Right (x::[(TextS.Text,TextS.Text)]) it "has mimeUnrender reverse exportParams (Network.URL)" $ do - property $ \x -> all (/= mempty) x + property $ \x -> mempty `notElem` x ==> (mimeUnrender p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)]) it "has importParams (Network.URL) reverse mimeRender" $ do - property $ \x -> all (/= mempty) x + property $ \x -> mempty `notElem` x ==> (fmap (map (cs *** cs)) . importParams . cs . mimeRender p $ x) == Just (x::[(TextS.Text,TextS.Text)]) describe "The PlainText Content-Type type" $ do