eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Merge pull request #196 from haskell-servant/jkarni/contributing

Browse source 
'Contributing' section in the README + stylish haskell changes
This commit is contained in:
Alp Mestanogullari 2015-08-18 11:25:08 +02:00
commit 90d837dda9
68 changed files with 557 additions and 457 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

77
.stylish-haskell.yaml Normal file
View file

@ -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

6
HLint.hs Normal file
View file

@ -0,0 +1,6 @@
import "hint" HLint.Default
ignore "Redundant do"
ignore "Parse error"
ignore "Use list comprehension"
ignore "Use liftM"

53
README.md
View file

@ -5,17 +5,56 @@
![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png) ![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`, 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-server`, which lets you *implement* an HTTP server with handlers for
- `servant-client`, which lets you derive automatically Haskell functions that let you query each endpoint of a `servant` webservice. 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-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-js`, which lets you derive Javascript functions (using vanilla JS
- `servant-blaze` and `servant-lucid` provide easy HTML rendering of your data as an `HTML` content-type "combinator". 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 ## 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!

2
servant-blaze/Setup.hs
View file

@ -1,2 +1,2 @@
import Distribution.Simple import Distribution.Simple
main = defaultMain main = defaultMain

2
servant-client/Setup.hs
View file

@ -1,2 +1,2 @@
import Distribution.Simple import Distribution.Simple
main = defaultMain main = defaultMain

18
servant-client/src/Servant/Common/BaseUrl.hs
View file

@ -11,13 +11,13 @@ module Servant.Common.BaseUrl (
, showBaseUrl , showBaseUrl
) where ) where
import Control.Monad.Catch (MonadThrow, throwM, Exception) import Control.Monad.Catch (Exception, MonadThrow, throwM)
import Data.List import Data.List
import Data.Typeable import Data.Typeable
import GHC.Generics import GHC.Generics
import Network.URI import Network.URI
import Safe import Safe
import Text.Read import Text.Read
-- | URI scheme to use -- | URI scheme to use
data Scheme = data Scheme =
@ -29,8 +29,8 @@ data Scheme =
-- for servant's automatically-generated clients. -- for servant's automatically-generated clients.
data BaseUrl = BaseUrl data BaseUrl = BaseUrl
{ baseUrlScheme :: Scheme -- ^ URI scheme to use { baseUrlScheme :: Scheme -- ^ URI scheme to use
, baseUrlHost :: String -- ^ host (eg "haskell.org") , baseUrlHost :: String -- ^ host (eg "haskell.org")
, baseUrlPort :: Int -- ^ port (eg 80) , baseUrlPort :: Int -- ^ port (eg 80)
} deriving (Show, Eq, Ord, Generic) } deriving (Show, Eq, Ord, Generic)
showBaseUrl :: BaseUrl -> String showBaseUrl :: BaseUrl -> String

2
servant-client/src/Servant/Common/Req.hs
View file

@ -99,7 +99,7 @@ setRQBody b t req = req { reqBody = Just (b, t) }
reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
reqToRequest req (BaseUrl reqScheme reqHost reqPort) = 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 where url = show $ nullURI { uriScheme = case reqScheme of
Http -> "http:" Http -> "http:"

12
servant-client/test/Servant/Common/BaseUrlSpec.hs
View file

@ -1,15 +1,15 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.Common.BaseUrlSpec where module Servant.Common.BaseUrlSpec where
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)
import Control.Applicative import Control.Applicative
#endif #endif
import Control.DeepSeq import Control.DeepSeq
import Test.Hspec import Test.Hspec
import Test.QuickCheck import Test.QuickCheck
import Servant.Common.BaseUrl import Servant.Common.BaseUrl
spec :: Spec spec :: Spec
spec = do spec = do

2
servant-client/test/Spec.hs
View file

@ -1,4 +1,4 @@
import Servant.ClientSpec (spec, failSpec) import Servant.ClientSpec (failSpec, spec)
main :: IO () main :: IO ()
main = do main = do

2
servant-docs/Setup.hs
View file

@ -1,2 +1,2 @@
import Distribution.Simple import Distribution.Simple
main = defaultMain main = defaultMain

2
servant-docs/src/Servant/Docs.hs
View file

@ -166,4 +166,4 @@ module Servant.Docs
, single , single
) where ) where
import Servant.Docs.Internal import Servant.Docs.Internal

4
servant-docs/src/Servant/Docs/Internal.hs
View file

@ -1,5 +1,5 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -23,6 +23,7 @@ module Servant.Docs.Internal where
import Control.Applicative import Control.Applicative
#endif #endif
import Control.Lens import Control.Lens
import Data.ByteString.Conversion (ToByteString, toByteString)
import Data.ByteString.Lazy.Char8 (ByteString) import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
import Data.Hashable import Data.Hashable
@ -32,7 +33,6 @@ import Data.Maybe
import Data.Monoid import Data.Monoid
import Data.Ord (comparing) import Data.Ord (comparing)
import Data.Proxy import Data.Proxy
import Data.ByteString.Conversion (ToByteString, toByteString)
import Data.String.Conversions import Data.String.Conversions
import Data.Text (Text, pack, unpack) import Data.Text (Text, pack, unpack)
import GHC.Exts (Constraint) import GHC.Exts (Constraint)

2
servant-examples/Setup.hs
View file

@ -1,2 +1,2 @@
import Distribution.Simple import Distribution.Simple
main = defaultMain main = defaultMain

30
servant-examples/auth-combinator/auth-combinator.hs
View file

@ -1,19 +1,19 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
import Data.Aeson {-# LANGUAGE TypeFamilies #-}
import Data.ByteString (ByteString) {-# LANGUAGE TypeOperators #-}
import Data.Text (Text) import Data.Aeson
import GHC.Generics import Data.ByteString (ByteString)
import Network.HTTP.Types import Data.Text (Text)
import Network.Wai import GHC.Generics
import Network.Wai.Handler.Warp import Network.HTTP.Types
import Servant import Network.Wai
import Servant.Server.Internal import Network.Wai.Handler.Warp
import Servant
import Servant.Server.Internal
-- Pretty much stolen/adapted from -- Pretty much stolen/adapted from
-- https://github.com/haskell-servant/HaskellSGMeetup2015/blob/master/examples/authentication-combinator/AuthenticationCombinator.hs -- https://github.com/haskell-servant/HaskellSGMeetup2015/blob/master/examples/authentication-combinator/AuthenticationCombinator.hs

32
servant-examples/hackage/hackage.hs
View file

@ -1,21 +1,21 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
import Control.Applicative {-# LANGUAGE TypeOperators #-}
import Control.Monad import Control.Applicative
import Control.Monad.IO.Class import Control.Monad
import Control.Monad.Trans.Either import Control.Monad.IO.Class
import Data.Aeson import Control.Monad.Trans.Either
import Data.Monoid import Data.Aeson
import Data.Proxy import Data.Monoid
import Data.Text (Text) import Data.Proxy
import GHC.Generics import Data.Text (Text)
import Servant.API import GHC.Generics
import Servant.Client import Servant.API
import Servant.Client
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
type HackageAPI = type HackageAPI =
"users" :> Get '[JSON] [UserSummary] "users" :> Get '[JSON] [UserSummary]

24
servant-examples/socket-io-chat/socket-io-chat.hs
View file

@ -1,24 +1,24 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeOperators #-}
import Data.Monoid ((<>)) import Data.Monoid ((<>))
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)
import Control.Applicative((<$>)) import Control.Applicative ((<$>))
#endif #endif
import Network.Wai import Network.EngineIO.Wai
import Servant import Network.Wai
import Network.EngineIO.Wai import Network.Wai.Handler.Warp (run)
import Network.Wai.Handler.Warp (run) import Servant
import qualified Control.Concurrent.STM as STM import qualified Control.Concurrent.STM as STM
import qualified Network.SocketIO as SocketIO import qualified Network.SocketIO as SocketIO
import Chat (eioServer, ServerState (..)) import Chat (ServerState (..), eioServer)
type API = "socket.io" :> Raw type API = "socket.io" :> Raw

22
servant-examples/tutorial/T1.hs
View file

@ -1,19 +1,19 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module T1 where module T1 where
import Data.Aeson import Data.Aeson
import Data.Time.Calendar import Data.Time.Calendar
import GHC.Generics import GHC.Generics
import Network.Wai import Network.Wai
import Servant import Servant
data User = User data User = User
{ name :: String { name :: String
, age :: Int , age :: Int
, email :: String , email :: String
, registration_date :: Day , registration_date :: Day
} deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)
@ -27,7 +27,7 @@ instance ToJSON User
type UserAPI = "users" :> Get '[JSON] [User] type UserAPI = "users" :> Get '[JSON] [User]
users :: [User] users :: [User]
users = users =
[ User "Isaac Newton" 372 "isaac@newton.co.uk" (fromGregorian 1683 3 1) [ User "Isaac Newton" 372 "isaac@newton.co.uk" (fromGregorian 1683 3 1)
, User "Albert Einstein" 136 "ae@mc2.org" (fromGregorian 1905 12 1) , User "Albert Einstein" 136 "ae@mc2.org" (fromGregorian 1905 12 1)
] ]

24
servant-examples/tutorial/T10.hs
View file

@ -1,18 +1,18 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module T10 where module T10 where
import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy (ByteString)
import Data.Text.Lazy (pack) import Data.Text.Lazy (pack)
import Data.Text.Lazy.Encoding (encodeUtf8) import Data.Text.Lazy.Encoding (encodeUtf8)
import Network.HTTP.Types import Network.HTTP.Types
import Network.Wai import Network.Wai
import Servant import Servant
import Servant.Docs import Servant.Docs
import qualified T3 import qualified T3
type DocsAPI = T3.API :<|> Raw type DocsAPI = T3.API :<|> Raw

20
servant-examples/tutorial/T2.hs
View file

@ -1,19 +1,19 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module T2 where module T2 where
import Data.Aeson import Data.Aeson
import Data.Time.Calendar import Data.Time.Calendar
import GHC.Generics import GHC.Generics
import Network.Wai import Network.Wai
import Servant import Servant
data User = User data User = User
{ name :: String { name :: String
, age :: Int , age :: Int
, email :: String , email :: String
, registration_date :: Day , registration_date :: Day
} deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)

28
servant-examples/tutorial/T3.hs
View file

@ -1,15 +1,15 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module T3 where module T3 where
import Control.Monad.Trans.Either import Control.Monad.Trans.Either
import Data.Aeson import Data.Aeson
import Data.List import Data.List
import GHC.Generics import GHC.Generics
import Network.Wai import Network.Wai
import Servant import Servant
data Position = Position data Position = Position
{ x :: Int { x :: Int
@ -26,9 +26,9 @@ instance FromJSON HelloMessage
instance ToJSON HelloMessage instance ToJSON HelloMessage
data ClientInfo = ClientInfo data ClientInfo = ClientInfo
{ name :: String { name :: String
, email :: String , email :: String
, age :: Int , age :: Int
, interested_in :: [String] , interested_in :: [String]
} deriving (Show, Generic) } deriving (Show, Generic)
@ -36,10 +36,10 @@ instance FromJSON ClientInfo
instance ToJSON ClientInfo instance ToJSON ClientInfo
data Email = Email data Email = Email
{ from :: String { from :: String
, to :: String , to :: String
, subject :: String , subject :: String
, body :: String , body :: String
} deriving (Show, Generic) } deriving (Show, Generic)
instance FromJSON Email instance FromJSON Email

22
servant-examples/tutorial/T4.hs
View file

@ -1,18 +1,18 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module T4 where module T4 where
import Data.Aeson import Data.Aeson
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import GHC.Generics import GHC.Generics
import Lucid import Lucid
import Network.Wai import Network.Wai
import Servant import Servant
import Servant.HTML.Lucid import Servant.HTML.Lucid
data Person = Person data Person = Person
{ firstName :: String { firstName :: String

22
servant-examples/tutorial/T5.hs
View file

@ -1,17 +1,17 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module T5 where module T5 where
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Trans.Either import Control.Monad.Trans.Either
import Data.Aeson import Data.Aeson
import GHC.Generics import GHC.Generics
import Network.Wai import Network.Wai
import Servant import Servant
import System.Directory import System.Directory
type IOAPI = "myfile.txt" :> Get '[JSON] FileContent type IOAPI = "myfile.txt" :> Get '[JSON] FileContent

8
servant-examples/tutorial/T6.hs
View file

@ -1,10 +1,10 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module T6 where module T6 where
import Network.Wai import Network.Wai
import Servant import Servant
type API = "code" :> Raw type API = "code" :> Raw

12
servant-examples/tutorial/T7.hs
View file

@ -1,12 +1,12 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module T7 where module T7 where
import Control.Monad.Trans.Either import Control.Monad.Trans.Either
import Control.Monad.Trans.Reader import Control.Monad.Trans.Reader
import Network.Wai import Network.Wai
import Servant import Servant
type ReaderAPI = "a" :> Get '[JSON] Int type ReaderAPI = "a" :> Get '[JSON] Int
:<|> "b" :> Get '[JSON] String :<|> "b" :> Get '[JSON] String

14
servant-examples/tutorial/T8.hs
View file

@ -1,14 +1,14 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module T8 where module T8 where
import Control.Monad.Trans.Either import Control.Monad.Trans.Either
import Data.Aeson import Data.Aeson
import Servant import Servant
import Servant.Client import Servant.Client
import T3 import T3
position :: Int -- ^ value for "x" position :: Int -- ^ value for "x"
-> Int -- ^ value for "y" -> Int -- ^ value for "y"

28
servant-examples/tutorial/T9.hs
View file

@ -1,20 +1,20 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module T9 where module T9 where
import Control.Applicative import Control.Applicative
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Data.Aeson import Data.Aeson
import Data.Text (Text) import Data.Text (Text)
import GHC.Generics import GHC.Generics
import Network.Wai import Network.Wai
import Servant import Servant
import Servant.JS import Servant.JS
import Servant.JS.JQuery import Servant.JS.JQuery
import System.Random import System.Random
import qualified Data.Text as T import qualified Data.Text as T
import qualified Language.Javascript.JQuery as JQ import qualified Language.Javascript.JQuery as JQ

2
servant-examples/tutorial/t8-main.hs
View file

@ -1,4 +1,4 @@
import T8 import T8
main :: IO () main :: IO ()
main = run main = run

8
servant-examples/tutorial/tutorial.hs
View file

@ -1,8 +1,9 @@
import Network.Wai import Network.Wai
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
import System.Environment import System.Environment
import qualified T1 import qualified T1
import qualified T10
import qualified T2 import qualified T2
import qualified T3 import qualified T3
import qualified T4 import qualified T4
@ -10,7 +11,6 @@ import qualified T5
import qualified T6 import qualified T6
import qualified T7 import qualified T7
import qualified T9 import qualified T9
import qualified T10
app :: String -> (Application -> IO ()) -> IO () app :: String -> (Application -> IO ()) -> IO ()
app n f = case n of app n f = case n of

18
servant-examples/wai-middleware/wai-middleware.hs
View file

@ -1,13 +1,13 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
import Data.Aeson import Data.Aeson
import Data.Text import Data.Text
import GHC.Generics import GHC.Generics
import Network.Wai import Network.Wai
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
import Network.Wai.Middleware.RequestLogger import Network.Wai.Middleware.RequestLogger
import Servant import Servant
data Product = Product data Product = Product
{ name :: Text { name :: Text

2
servant-js/Setup.hs
View file

@ -1,2 +1,2 @@
import Distribution.Simple import Distribution.Simple
main = defaultMain main = defaultMain

32
servant-js/examples/counter.hs
View file

@ -1,19 +1,19 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeOperators #-}
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Data.Aeson import Data.Aeson
import Data.Proxy import Data.Proxy
import GHC.Generics import GHC.Generics
import Network.Wai.Handler.Warp (run) import Network.Wai.Handler.Warp (run)
import Servant import Servant
import Servant.JS import Servant.JS
import qualified Servant.JS as SJS import qualified Servant.JS as SJS
import qualified Servant.JS.Angular as NG import qualified Servant.JS.Angular as NG
import System.FilePath import System.FilePath
-- * A simple Counter data type -- * A simple Counter data type
newtype Counter = Counter { value :: Int } newtype Counter = Counter { value :: Int }
@ -43,7 +43,7 @@ type TestApi = "counter" :> Post '[JSON] Counter -- endpoint for increasing the
:<|> "counter" :> Get '[JSON] Counter -- endpoint to get the current value :<|> "counter" :> Get '[JSON] Counter -- endpoint to get the current value
type TestApi' = TestApi type TestApi' = TestApi
:<|> Raw -- used for serving static files :<|> Raw -- used for serving static files
-- this proxy only targets the proper endpoints of our API, -- this proxy only targets the proper endpoints of our API,
-- not the static file serving bit -- not the static file serving bit
@ -82,7 +82,7 @@ writeServiceJS fp =
(defCommonGeneratorOptions { SJS.moduleName = "counterApp" }) (defCommonGeneratorOptions { SJS.moduleName = "counterApp" })
) )
fp fp
main :: IO () main :: IO ()
main = do main = do
-- write the JS code to www/api.js at startup -- write the JS code to www/api.js at startup

22
servant-js/src/Servant/JS.hs
View file

@ -1,7 +1,7 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
-- Module : Servant.JS -- Module : Servant.JS
@ -114,13 +114,13 @@ module Servant.JS
, AjaxReq , AjaxReq
) where ) where
import Data.Proxy import Data.Proxy
import Servant.API import Servant.API
import Servant.JS.Angular import Servant.JS.Angular
import Servant.JS.Axios import Servant.JS.Axios
import Servant.JS.Internal import Servant.JS.Internal
import Servant.JS.JQuery import Servant.JS.JQuery
import Servant.JS.Vanilla import Servant.JS.Vanilla
-- | Generate the data necessary to generate javascript code -- | Generate the data necessary to generate javascript code
-- for all the endpoints of an API, as ':<|>'-separated values -- for all the endpoints of an API, as ':<|>'-separated values
@ -160,6 +160,6 @@ instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> res
generateList (start :<|> rest) = (generateList start) ++ (generateList rest) generateList (start :<|> rest) = (generateList start) ++ (generateList rest)
-- | Generate the necessary data for JS codegen as a list, each 'AjaxReq' -- | Generate the necessary data for JS codegen as a list, each 'AjaxReq'
-- describing one endpoint from your API type. -- describing one endpoint from your API type.
listFromAPI :: (HasJS api, GenerateList (JS api)) => Proxy api -> [AjaxReq] listFromAPI :: (HasJS api, GenerateList (JS api)) => Proxy api -> [AjaxReq]
listFromAPI p = generateList (javascript p) listFromAPI p = generateList (javascript p)

26
servant-js/src/Servant/JS/Angular.hs
View file

@ -1,16 +1,16 @@
module Servant.JS.Angular where module Servant.JS.Angular where
import Servant.JS.Internal import Control.Lens
import Control.Lens import Data.List
import Data.List import Data.Monoid
import Data.Monoid import Servant.JS.Internal
-- | Options specific to the angular code generator -- | Options specific to the angular code generator
data AngularOptions = AngularOptions data AngularOptions = AngularOptions
{ serviceName :: String -- ^ When generating code with wrapInService, { serviceName :: String -- ^ When generating code with wrapInService,
-- name of the service to generate -- name of the service to generate
, prologue :: String -> String -> String -- ^ beginning of the service definition , prologue :: String -> String -> String -- ^ beginning of the service definition
, epilogue :: String -- ^ end of the service definition , epilogue :: String -- ^ end of the service definition
} }
-- | Default options for the Angular codegen. Used by 'wrapInService'. -- | Default options for the Angular codegen. Used by 'wrapInService'.
@ -31,7 +31,7 @@ angularService ngOpts = angularServiceWith ngOpts defCommonGeneratorOptions
-- | Instead of simply generating top level functions, generates a service instance -- | Instead of simply generating top level functions, generates a service instance
-- on which your controllers can depend to access your API -- on which your controllers can depend to access your API
angularServiceWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator angularServiceWith :: AngularOptions -> CommonGeneratorOptions -> JavaScriptGenerator
angularServiceWith ngOpts opts reqs = angularServiceWith ngOpts opts reqs =
prologue ngOpts svc mName prologue ngOpts svc mName
<> intercalate "," (map generator reqs) <> <> intercalate "," (map generator reqs) <>
epilogue ngOpts epilogue ngOpts
@ -54,7 +54,7 @@ angularWith ngopts opts = intercalate "\n\n" . map (generateAngularJSWith ngopts
-- | js codegen using $http service from Angular using default options -- | js codegen using $http service from Angular using default options
generateAngularJS :: AngularOptions -> AjaxReq -> String generateAngularJS :: AngularOptions -> AjaxReq -> String
generateAngularJS ngOpts = generateAngularJSWith ngOpts defCommonGeneratorOptions 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 :: AngularOptions -> CommonGeneratorOptions -> AjaxReq -> String
generateAngularJSWith ngOptions opts req = "\n" <> generateAngularJSWith ngOptions opts req = "\n" <>
@ -74,7 +74,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
++ map (view argName) queryparams ++ map (view argName) queryparams
++ body ++ body
++ map (toValidFunctionName . (<>) "header" . headerArgName) hs ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
-- If we want to generate Top Level Function, they must depend on -- If we want to generate Top Level Function, they must depend on
-- the $http service, if we generate a service, the functions will -- the $http service, if we generate a service, the functions will
-- inherit this dependency from the service -- inherit this dependency from the service
@ -118,13 +118,13 @@ generateAngularJSWith ngOptions opts req = "\n" <>
else (moduleName opts) <> "." else (moduleName opts) <> "."
where where
hasNoModule = null (moduleName opts) hasNoModule = null (moduleName opts)
hasService = not $ null (serviceName ngOptions) hasService = not $ null (serviceName ngOptions)
fsep = if hasService then ":" else " =" fsep = if hasService then ":" else " ="
fname = namespace <> (functionNameBuilder opts $ req ^. funcName) fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
method = req ^. reqMethod method = req ^. reqMethod
url = if url' == "'" then "'/'" else url' url = if url' == "'" then "'/'" else url'
url' = "'" url' = "'"

24
servant-js/src/Servant/JS/Axios.hs
View file

@ -1,10 +1,10 @@
module Servant.JS.Axios where module Servant.JS.Axios where
import Servant.JS.Internal import Control.Lens
import Control.Lens import Data.Char (toLower)
import Data.Char (toLower) import Data.List
import Data.List import Data.Monoid
import Data.Monoid import Servant.JS.Internal
-- | Axios 'configuration' type -- | Axios 'configuration' type
-- Let you customize the generation using Axios capabilities -- Let you customize the generation using Axios capabilities
@ -13,9 +13,9 @@ data AxiosOptions = AxiosOptions
-- should be made using credentials -- should be made using credentials
withCredentials :: !Bool withCredentials :: !Bool
-- | the name of the cookie to use as a value for xsrf token -- | the name of the cookie to use as a value for xsrf token
, xsrfCookieName :: !(Maybe String) , xsrfCookieName :: !(Maybe String)
-- | the name of the header to use as a value for xsrf token -- | the name of the header to use as a value for xsrf token
, xsrfHeaderName :: !(Maybe String) , xsrfHeaderName :: !(Maybe String)
} }
-- | Default instance of the AxiosOptions -- | Default instance of the AxiosOptions
@ -40,7 +40,7 @@ axiosWith aopts opts = intercalate "\n\n" . map (generateAxiosJSWith aopts opts)
-- | js codegen using axios library using default options -- | js codegen using axios library using default options
generateAxiosJS :: AxiosOptions -> AjaxReq -> String generateAxiosJS :: AxiosOptions -> AjaxReq -> String
generateAxiosJS aopts = generateAxiosJSWith aopts defCommonGeneratorOptions generateAxiosJS aopts = generateAxiosJSWith aopts defCommonGeneratorOptions
-- | js codegen using axios library -- | js codegen using axios library
generateAxiosJSWith :: AxiosOptions -> CommonGeneratorOptions -> AjaxReq -> String generateAxiosJSWith :: AxiosOptions -> CommonGeneratorOptions -> AjaxReq -> String
generateAxiosJSWith aopts opts req = "\n" <> generateAxiosJSWith aopts opts req = "\n" <>
@ -61,7 +61,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
++ map (view argName) queryparams ++ map (view argName) queryparams
++ body ++ body
++ map (toValidFunctionName . (<>) "header" . headerArgName) hs ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs
captures = map captureArg captures = map captureArg
. filter isCapture . filter isCapture
$ req ^. reqUrl.path $ req ^. reqUrl.path
@ -85,7 +85,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
then " , withCredentials: true\n" then " , withCredentials: true\n"
else "" else ""
xsrfCookie = xsrfCookie =
case xsrfCookieName aopts of case xsrfCookieName aopts of
Just name -> " , xsrfCookieName: '" <> name <> "'\n" Just name -> " , xsrfCookieName: '" <> name <> "'\n"
Nothing -> "" Nothing -> ""
@ -111,9 +111,9 @@ generateAxiosJSWith aopts opts req = "\n" <>
else (moduleName opts) <> "." else (moduleName opts) <> "."
where where
hasNoModule = null (moduleName opts) hasNoModule = null (moduleName opts)
fname = namespace <> (functionNameBuilder opts $ req ^. funcName) fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
method = map toLower $ req ^. reqMethod method = map toLower $ req ^. reqMethod
url = if url' == "'" then "'/'" else url' url = if url' == "'" then "'/'" else url'
url' = "'" url' = "'"

12
servant-js/src/Servant/JS/Internal.hs
View file

@ -28,7 +28,7 @@ import Servant.API
-- | this structure is used by JavaScriptGenerator implementations to let you -- | this structure is used by JavaScriptGenerator implementations to let you
-- customize the output -- customize the output
data CommonGeneratorOptions = CommonGeneratorOptions data CommonGeneratorOptions = CommonGeneratorOptions
{ {
functionNameBuilder :: FunctionName -> String -- ^ function generating function names 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) , 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 , 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 -- | Function name builder that simply concat each part together
concatCase :: FunctionName -> String concatCase :: FunctionName -> String
concatCase = concat concatCase = concat
-- | Function name builder using the snake_case convention. -- | Function name builder using the snake_case convention.
-- each part is separated by a single underscore character. -- each part is separated by a single underscore character.
snakeCase :: FunctionName -> String snakeCase :: FunctionName -> String
snakeCase = intercalate "_" snakeCase = intercalate "_"
-- | Function name builder using the CamelCase convention. -- | Function name builder using the CamelCase convention.
-- each part begins with an upper case character. -- each part begins with an upper case character.
camelCase :: FunctionName -> String camelCase :: FunctionName -> String
@ -78,7 +78,7 @@ camelCase (p:ps) = concat $ p : camelCase' ps
camelCase' (r:rs) = capitalize r : camelCase' rs camelCase' (r:rs) = capitalize r : camelCase' rs
capitalize [] = [] capitalize [] = []
capitalize (x:xs) = toUpper x : xs capitalize (x:xs) = toUpper x : xs
type Arg = String type Arg = String
-- A 'JavascriptGenerator' just takes the data found in the API type -- 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 setFirstChar c = if firstChar c
then c then c
else '_' else '_'
firstChar c = (prefixOK c) || (or . map (Set.member c) $ firstLetterOK) firstChar c = prefixOK c || any (Set.member c) firstLetterOK
remainder c = (prefixOK c) || (or . map (Set.member c) $ remainderOK) remainder c = prefixOK c || any (Set.member c) remainderOK
-- Valid prefixes -- Valid prefixes
prefixOK c = c `elem` ['$','_'] prefixOK c = c `elem` ['$','_']
-- Unicode character sets -- Unicode character sets

16
servant-js/src/Servant/JS/JQuery.hs
View file

@ -1,20 +1,20 @@
module Servant.JS.JQuery where module Servant.JS.JQuery where
import Servant.JS.Internal import Control.Lens
import Control.Lens import Data.List
import Data.List import Data.Monoid
import Data.Monoid import Servant.JS.Internal
-- | Generate javascript functions that use the /jQuery/ library -- | Generate javascript functions that use the /jQuery/ library
-- to make the AJAX calls. Uses 'defCommonGeneratorOptions' -- to make the AJAX calls. Uses 'defCommonGeneratorOptions'
-- for the generator options. -- for the generator options.
jquery :: JavaScriptGenerator jquery :: JavaScriptGenerator
jquery = concat . map generateJQueryJS jquery = concatMap generateJQueryJS
-- | Generate javascript functions that use the /jQuery/ library -- | Generate javascript functions that use the /jQuery/ library
-- to make the AJAX calls. Lets you specify your own 'CommonGeneratorOptions'. -- to make the AJAX calls. Lets you specify your own 'CommonGeneratorOptions'.
jqueryWith :: CommonGeneratorOptions -> JavaScriptGenerator jqueryWith :: CommonGeneratorOptions -> JavaScriptGenerator
jqueryWith opts = concat . map (generateJQueryJSWith opts) jqueryWith opts = concatMap (generateJQueryJSWith opts)
-- | js codegen using JQuery using default options -- | js codegen using JQuery using default options
generateJQueryJS :: AjaxReq -> String generateJQueryJS :: AjaxReq -> String
@ -53,7 +53,7 @@ generateJQueryJSWith opts req = "\n" <>
body = if req ^. reqBody body = if req ^. reqBody
then [requestBody opts] then [requestBody opts]
else [] else []
onSuccess = successCallback opts onSuccess = successCallback opts
onError = errorCallback opts onError = errorCallback opts
@ -77,7 +77,7 @@ generateJQueryJSWith opts req = "\n" <>
then "var " then "var "
else (moduleName opts) <> "." else (moduleName opts) <> "."
fname = namespace <> (functionNameBuilder opts $ req ^. funcName) fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
method = req ^. reqMethod method = req ^. reqMethod
url = if url' == "'" then "'/'" else url' url = if url' == "'" then "'/'" else url'
url' = "'" url' = "'"

20
servant-js/src/Servant/JS/Vanilla.hs
View file

@ -1,21 +1,21 @@
module Servant.JS.Vanilla where module Servant.JS.Vanilla where
import Servant.JS.Internal import Control.Lens
import Control.Lens import Data.List
import Data.List import Data.Monoid
import Data.Monoid import Servant.JS.Internal
-- | Generate vanilla javascript functions to make AJAX requests -- | Generate vanilla javascript functions to make AJAX requests
-- to your API, using /XMLHttpRequest/. Uses 'defCommonGeneratorOptions' -- to your API, using /XMLHttpRequest/. Uses 'defCommonGeneratorOptions'
-- for the 'CommonGeneratorOptions'. -- for the 'CommonGeneratorOptions'.
vanillaJS :: JavaScriptGenerator vanillaJS :: JavaScriptGenerator
vanillaJS = concat . map generateVanillaJS vanillaJS = concatMap generateVanillaJS
-- | Generate vanilla javascript functions to make AJAX requests -- | Generate vanilla javascript functions to make AJAX requests
-- to your API, using /XMLHttpRequest/. Lets you specify your -- to your API, using /XMLHttpRequest/. Lets you specify your
-- own options. -- own options.
vanillaJSWith :: CommonGeneratorOptions -> JavaScriptGenerator vanillaJSWith :: CommonGeneratorOptions -> JavaScriptGenerator
vanillaJSWith opts = concat . map (generateVanillaJSWith opts) vanillaJSWith opts = concatMap (generateVanillaJSWith opts)
-- | js codegen using XmlHttpRequest using default generation options -- | js codegen using XmlHttpRequest using default generation options
generateVanillaJS :: AjaxReq -> String generateVanillaJS :: AjaxReq -> String
@ -56,11 +56,11 @@ generateVanillaJSWith opts req = "\n" <>
hs = req ^. reqHeaders hs = req ^. reqHeaders
queryparams = req ^.. reqUrl.queryStr.traverse queryparams = req ^.. reqUrl.queryStr.traverse
body = if req ^. reqBody body = if req ^. reqBody
then [requestBody opts] then [requestBody opts]
else [] else []
onSuccess = successCallback opts onSuccess = successCallback opts
onError = errorCallback opts onError = errorCallback opts
@ -68,7 +68,7 @@ generateVanillaJSWith opts req = "\n" <>
if req ^. reqBody if req ^. reqBody
then "JSON.stringify(body)\n" then "JSON.stringify(body)\n"
else "null" else "null"
reqheaders = reqheaders =
if null hs if null hs
@ -84,7 +84,7 @@ generateVanillaJSWith opts req = "\n" <>
then "var " then "var "
else (moduleName opts) <> "." else (moduleName opts) <> "."
fname = namespace <> (functionNameBuilder opts $ req ^. funcName) fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
method = req ^. reqMethod method = req ^. reqMethod
url = if url' == "'" then "'/'" else url' url = if url' == "'" then "'/'" else url'
url' = "'" url' = "'"

42
servant-js/test/Servant/JSSpec.hs
View file

@ -7,18 +7,18 @@
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.JSSpec where module Servant.JSSpec where
import Data.Either (isRight) import Data.Either (isRight)
import Data.Proxy import Data.Proxy
import Language.ECMAScript3.Parser (parseFromString) import Language.ECMAScript3.Parser (parseFromString)
import Test.Hspec import Test.Hspec
import Servant.API import Servant.API
import Servant.JS import Servant.JS
import qualified Servant.JS.Vanilla as JS import qualified Servant.JS.Angular as NG
import qualified Servant.JS.JQuery as JQ import qualified Servant.JS.Axios as AX
import qualified Servant.JS.Angular as NG import qualified Servant.JS.JQuery as JQ
import qualified Servant.JS.Axios as AX import qualified Servant.JS.Vanilla as JS
import Servant.JSSpec.CustomHeaders import Servant.JSSpec.CustomHeaders
type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] String :> Post '[JSON] Bool type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] String :> Post '[JSON] Bool
:<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool :<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool
@ -65,7 +65,7 @@ customOptions = defCommonGeneratorOptions
{ successCallback = "okCallback" { successCallback = "okCallback"
, errorCallback = "errorCallback" , errorCallback = "errorCallback"
} }
spec :: Spec spec :: Spec
spec = describe "Servant.JQuery" $ do spec = describe "Servant.JQuery" $ do
generateJSSpec Vanilla JS.generateVanillaJS generateJSSpec Vanilla JS.generateVanillaJS
@ -76,12 +76,12 @@ spec = describe "Servant.JQuery" $ do
generateJSSpec AngularCustom (NG.generateAngularJSWith NG.defAngularOptions customOptions) generateJSSpec AngularCustom (NG.generateAngularJSWith NG.defAngularOptions customOptions)
generateJSSpec Axios (AX.generateAxiosJS AX.defAxiosOptions) generateJSSpec Axios (AX.generateAxiosJS AX.defAxiosOptions)
generateJSSpec AxiosCustom (AX.generateAxiosJSWith (AX.defAxiosOptions { withCredentials = True }) customOptions) generateJSSpec AxiosCustom (AX.generateAxiosJSWith (AX.defAxiosOptions { withCredentials = True }) customOptions)
angularSpec Angular angularSpec Angular
axiosSpec axiosSpec
--angularSpec AngularCustom --angularSpec AngularCustom
axiosSpec :: Spec axiosSpec :: Spec
axiosSpec = describe specLabel $ do axiosSpec = describe specLabel $ do
it "should add withCredentials when needed" $ do it "should add withCredentials when needed" $ do
let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI) let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI)
@ -102,20 +102,20 @@ axiosSpec = describe specLabel $ do
cookieOpts = AX.defAxiosOptions { AX.xsrfCookieName = Just "MyXSRFcookie" } cookieOpts = AX.defAxiosOptions { AX.xsrfCookieName = Just "MyXSRFcookie" }
headerOpts = AX.defAxiosOptions { AX.xsrfHeaderName = Just "MyXSRFheader" } headerOpts = AX.defAxiosOptions { AX.xsrfHeaderName = Just "MyXSRFheader" }
genJS :: AxiosOptions -> [AjaxReq] -> String 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 angularSpec test = describe specLabel $ do
it "should implement a service globally" $ do it "should implement a service globally" $ do
let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
output jsText output jsText
jsText `shouldContain` (".service('" ++ testName ++ "'") jsText `shouldContain` (".service('" ++ testName ++ "'")
it "should depend on $http service globally" $ do it "should depend on $http service globally" $ do
let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
output jsText output jsText
jsText `shouldContain` ("('" ++ testName ++ "', function($http) {") jsText `shouldContain` ("('" ++ testName ++ "', function($http) {")
it "should not depend on $http service in handlers" $ do it "should not depend on $http service in handlers" $ do
let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
output jsText output jsText
@ -126,11 +126,11 @@ angularSpec test = describe specLabel $ do
testName = "MyService" testName = "MyService"
ngOpts = NG.defAngularOptions { NG.serviceName = testName } ngOpts = NG.defAngularOptions { NG.serviceName = testName }
genJS req = NG.angularService ngOpts req genJS req = NG.angularService ngOpts req
generateJSSpec :: TestNames -> (AjaxReq -> String) -> Spec generateJSSpec :: TestNames -> (AjaxReq -> String) -> Spec
generateJSSpec n gen = describe specLabel $ do generateJSSpec n gen = describe specLabel $ do
it "should generate valid javascript" $ 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 parseFromString s `shouldSatisfy` isRight
it "should use non-empty function names" $ do 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.\"") 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 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 parseFromString jsStr `shouldSatisfy` isRight
where where
specLabel = "generateJS(" ++ (show n) ++ ")" specLabel = "generateJS(" ++ (show n) ++ ")"

14
servant-js/test/Servant/JSSpec/CustomHeaders.hs
View file

@ -8,13 +8,13 @@
module Servant.JSSpec.CustomHeaders where module Servant.JSSpec.CustomHeaders where
import Control.Lens import Control.Lens
import Data.Monoid import Data.Monoid
import Data.Proxy import Data.Proxy
import GHC.TypeLits import GHC.TypeLits
import Servant.API import Servant.API
import Servant.JS import Servant.JS
import Servant.JS.Internal import Servant.JS.Internal
-- | This is a hypothetical combinator that fetches an Authorization header. -- | This is a hypothetical combinator that fetches an Authorization header.
-- The symbol in the header denotes what kind of authentication we are -- The symbol in the header denotes what kind of authentication we are

2
servant-lucid/Setup.hs
View file

@ -1,2 +1,2 @@
import Distribution.Simple import Distribution.Simple
main = defaultMain main = defaultMain

2
servant-mock/Setup.hs
View file

@ -1,2 +1,2 @@
import Distribution.Simple import Distribution.Simple
main = defaultMain main = defaultMain

18
servant-mock/example/main.hs
View file

@ -1,13 +1,13 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Data.Aeson {-# LANGUAGE TypeOperators #-}
import GHC.Generics import Data.Aeson
import Network.Wai.Handler.Warp import GHC.Generics
import Servant import Network.Wai.Handler.Warp
import Servant.Mock import Servant
import Test.QuickCheck.Arbitrary import Servant.Mock
import Test.QuickCheck.Arbitrary
newtype User = User { username :: String } newtype User = User { username :: String }
deriving (Eq, Show, Arbitrary, Generic) deriving (Eq, Show, Arbitrary, Generic)

36
servant-mock/src/Servant/Mock.hs
View file

@ -1,10 +1,10 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-- | -- |
-- Module : Servant.Mock -- Module : Servant.Mock
-- Copyright : 2015 Alp Mestanogullari -- Copyright : 2015 Alp Mestanogullari
@ -51,18 +51,18 @@
module Servant.Mock ( HasMock(..) ) where module Servant.Mock ( HasMock(..) ) where
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)
import Control.Applicative import Control.Applicative
#endif #endif
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Data.ByteString.Lazy.Char8 (pack) import Data.ByteString.Lazy.Char8 (pack)
import Data.Proxy import Data.Proxy
import GHC.TypeLits import GHC.TypeLits
import Network.HTTP.Types.Status import Network.HTTP.Types.Status
import Network.Wai import Network.Wai
import Servant import Servant
import Servant.API.ContentTypes import Servant.API.ContentTypes
import Test.QuickCheck.Arbitrary (Arbitrary(..), vector) import Test.QuickCheck.Arbitrary (Arbitrary (..), vector)
import Test.QuickCheck.Gen (Gen, generate) import Test.QuickCheck.Gen (Gen, generate)
-- | 'HasMock' defines an interpretation of API types -- | 'HasMock' defines an interpretation of API types
-- than turns them into random-response-generating -- than turns them into random-response-generating
@ -169,7 +169,7 @@ instance HasMock Raw where
bdy <- genBody bdy <- genBody
respond $ responseLBS status200 [] bdy 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 :: (MonadIO m, Arbitrary a) => m a
mockArbitrary = liftIO (generate arbitrary) mockArbitrary = liftIO (generate arbitrary)

2
servant-server/Setup.hs
View file

@ -1,2 +1,2 @@
import Distribution.Simple import Distribution.Simple
main = defaultMain main = defaultMain

26
servant-server/example/greet.hs
View file

@ -1,19 +1,19 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
import Data.Aeson import Data.Aeson
import Data.Monoid import Data.Monoid
import Data.Proxy import Data.Proxy
import Data.Text import Data.Text
import GHC.Generics import GHC.Generics
import Network.Wai import Network.Wai
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
import Servant import Servant
-- * Example -- * Example

12
servant-server/src/Servant.hs
View file

@ -14,9 +14,9 @@ module Servant (
Proxy(..), Proxy(..),
) where ) where
import Data.Proxy import Data.Proxy
import Servant.API import Servant.API
import Servant.Common.Text import Servant.Common.Text
import Servant.Server import Servant.Server
import Servant.Utils.Links import Servant.Utils.Links
import Servant.Utils.StaticFiles import Servant.Utils.StaticFiles

4
servant-server/src/Servant/Server.hs
View file

@ -77,8 +77,8 @@ module Servant.Server
) where ) where
import Data.Proxy (Proxy) import Data.Proxy (Proxy)
import Network.Wai (Application) import Network.Wai (Application)
import Servant.Server.Internal import Servant.Server.Internal
import Servant.Server.Internal.Enter import Servant.Server.Internal.Enter

10
servant-server/src/Servant/Server/Internal.hs
View file

@ -27,7 +27,7 @@ import Control.Monad.Trans.Either (EitherT)
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (catMaybes, fromMaybe) import Data.Maybe (mapMaybe, fromMaybe)
import Data.String (fromString) import Data.String (fromString)
import Data.String.Conversions (cs, (<>), ConvertibleStrings) import Data.String.Conversions (cs, (<>), ConvertibleStrings)
import Data.Text (Text) import Data.Text (Text)
@ -137,9 +137,7 @@ processMethodRouter handleA status method headers request = case handleA of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
Just (contentT, body) -> succeedWith $ responseLBS status hdrs bdy Just (contentT, body) -> succeedWith $ responseLBS status hdrs bdy
where where
bdy = case allowedMethodHead method request of bdy = if allowedMethodHead method request then "" else body
True -> ""
False -> body
hdrs = (hContentType, cs contentT) : (fromMaybe [] headers) hdrs = (hContentType, cs contentT) : (fromMaybe [] headers)
methodRouter :: (AllCTRender ctypes a) methodRouter :: (AllCTRender ctypes a)
@ -512,7 +510,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- named "foo" or "foo[]" and call fromText on the -- named "foo" or "foo[]" and call fromText on the
-- corresponding values -- corresponding values
parameters = filter looksLikeParam querytext parameters = filter looksLikeParam querytext
values = catMaybes $ map (convert . snd) parameters values = mapMaybe (convert . snd) parameters
in route (Proxy :: Proxy sublayout) (feedTo subserver values) in route (Proxy :: Proxy sublayout) (feedTo subserver values)
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)
looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]") 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 -- named "foo" or "foo[]" and call fromText on the
-- corresponding values -- corresponding values
parameters = filter looksLikeParam matrixtext 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 values)
_ -> route (Proxy :: Proxy sublayout) (feedTo subserver []) _ -> route (Proxy :: Proxy sublayout) (feedTo subserver [])
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)

10
servant-server/src/Servant/Server/Internal/PathInfo.hs
View file

@ -1,10 +1,10 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Servant.Server.Internal.PathInfo where module Servant.Server.Internal.PathInfo where
import Data.List (unfoldr) import Data.List (unfoldr)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Network.Wai (Request, pathInfo) import Network.Wai (Request, pathInfo)
-- | Like `null . pathInfo`, but works with redundant trailing slashes. -- | Like `null . pathInfo`, but works with redundant trailing slashes.
pathIsEmpty :: Request -> Bool pathIsEmpty :: Request -> Bool

10
servant-server/src/Servant/Server/Internal/Router.hs
View file

@ -1,10 +1,10 @@
module Servant.Server.Internal.Router where module Servant.Server.Internal.Router where
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.Text (Text) import Data.Text (Text)
import Network.Wai (Request, pathInfo) import Network.Wai (Request, pathInfo)
import Servant.Server.Internal.PathInfo import Servant.Server.Internal.PathInfo
import Servant.Server.Internal.RoutingApplication import Servant.Server.Internal.RoutingApplication

33
servant-server/src/Servant/Server/Internal/RoutingApplication.hs
View file

@ -5,23 +5,24 @@
module Servant.Server.Internal.RoutingApplication where module Servant.Server.Internal.RoutingApplication where
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative, (<$>)) import Control.Applicative (Applicative, (<$>))
import Data.Monoid (Monoid, mappend, mempty) import Data.Monoid (Monoid, mappend, mempty)
#endif #endif
import Control.Monad.Trans.Either (EitherT, runEitherT) import Control.Monad.Trans.Either (EitherT, runEitherT)
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import Data.IORef (newIORef, readIORef, writeIORef) import Data.IORef (newIORef, readIORef,
import Data.Maybe (fromMaybe) writeIORef)
import Data.Monoid ((<>)) import Data.Maybe (fromMaybe)
import Data.String (fromString) import Data.Monoid ((<>))
import Network.HTTP.Types hiding (Header, ResponseHeaders) import Data.String (fromString)
import Network.Wai (Application, Request, Response, import Network.HTTP.Types hiding (Header,
ResponseReceived, ResponseHeaders)
requestBody, import Network.Wai (Application, Request,
responseLBS, Response, ResponseReceived,
strictRequestBody) requestBody, responseLBS,
import Servant.API ((:<|>) (..)) strictRequestBody)
import Servant.API ((:<|>) (..))
import Servant.Server.Internal.ServantErr import Servant.Server.Internal.ServantErr
type RoutingApplication = type RoutingApplication =

8
servant-server/src/Servant/Server/Internal/ServantErr.hs
View file

@ -2,10 +2,10 @@
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
module Servant.Server.Internal.ServantErr where module Servant.Server.Internal.ServantErr where
import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import qualified Network.HTTP.Types as HTTP import qualified Network.HTTP.Types as HTTP
import Network.Wai (responseLBS, Response) import Network.Wai (Response, responseLBS)
data ServantErr = ServantErr { errHTTPCode :: Int data ServantErr = ServantErr { errHTTPCode :: Int
, errReasonPhrase :: String , errReasonPhrase :: String

11
servant-server/src/Servant/Utils/StaticFiles.hs
View file

@ -7,12 +7,13 @@ module Servant.Utils.StaticFiles (
serveDirectory, serveDirectory,
) where ) where
import System.FilePath (addTrailingPathSeparator) import Network.Wai.Application.Static (defaultFileServerSettings,
import Network.Wai.Application.Static (staticApp, defaultFileServerSettings) staticApp)
import Servant.API.Raw (Raw) import Servant.API.Raw (Raw)
import Servant.Server (Server) import Servant.Server (Server)
import System.FilePath (addTrailingPathSeparator)
#if !MIN_VERSION_wai_app_static(3,1,0) #if !MIN_VERSION_wai_app_static(3,1,0)
import Filesystem.Path.CurrentOS (decodeString) import Filesystem.Path.CurrentOS (decodeString)
#endif #endif
-- | Serve anything under the specified directory as a 'Raw' endpoint. -- | Serve anything under the specified directory as a 'Raw' endpoint.

2
servant-server/test/Doctests.hs
View file

@ -1,6 +1,6 @@
module Main where module Main where
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
import System.Directory import System.Directory
import System.FilePath import System.FilePath
import System.FilePath.Find import System.FilePath.Find

8
servant-server/test/Servant/Server/Internal/EnterSpec.hs
View file

@ -3,16 +3,16 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Servant.Server.Internal.EnterSpec where module Servant.Server.Internal.EnterSpec where
import qualified Control.Category as C import qualified Control.Category as C
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Either import Control.Monad.Trans.Either
import Data.Proxy import Data.Proxy
import Servant.API import Servant.API
import Servant.Server import Servant.Server
import Test.Hspec (Spec, describe, it) import Test.Hspec (Spec, describe, it)
import Test.Hspec.Wai (get, matchStatus, post, import Test.Hspec.Wai (get, matchStatus, post,
shouldRespondWith, with) shouldRespondWith, with)
spec :: Spec spec :: Spec
spec = describe "module Servant.Server.Enter" $ do spec = describe "module Servant.Server.Enter" $ do

38
servant-server/test/Servant/Utils/StaticFilesSpec.hs
View file

@ -1,27 +1,29 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.Utils.StaticFilesSpec where module Servant.Utils.StaticFilesSpec where
import Control.Exception (bracket) import Control.Exception (bracket)
import Data.Proxy (Proxy(Proxy)) import Data.Proxy (Proxy (Proxy))
import Network.Wai (Application) import Network.Wai (Application)
import System.Directory (getCurrentDirectory, setCurrentDirectory, createDirectory) import System.Directory (createDirectory,
import System.IO.Temp (withSystemTempDirectory) getCurrentDirectory,
import Test.Hspec (Spec, describe, it, around_) setCurrentDirectory)
import Test.Hspec.Wai (with, get, shouldRespondWith) import System.IO.Temp (withSystemTempDirectory)
import Test.Hspec (Spec, around_, describe, it)
import Test.Hspec.Wai (get, shouldRespondWith, with)
import Servant.API (JSON) import Servant.API (JSON)
import Servant.API.Alternative ((:<|>)((:<|>))) import Servant.API.Alternative ((:<|>) ((:<|>)))
import Servant.API.Capture (Capture) import Servant.API.Capture (Capture)
import Servant.API.Get (Get) import Servant.API.Get (Get)
import Servant.API.Raw (Raw) import Servant.API.Raw (Raw)
import Servant.API.Sub ((:>)) import Servant.API.Sub ((:>))
import Servant.Server (Server, serve) import Servant.Server (Server, serve)
import Servant.ServerSpec (Person(Person)) import Servant.ServerSpec (Person (Person))
import Servant.Utils.StaticFiles (serveDirectory) import Servant.Utils.StaticFiles (serveDirectory)
type Api = type Api =
"dummy_api" :> Capture "person_name" String :> Get '[JSON] Person "dummy_api" :> Capture "person_name" String :> Get '[JSON] Person

2
servant/Setup.hs
View file

@ -1,2 +1,2 @@
import Distribution.Simple import Distribution.Simple
main = defaultMain main = defaultMain

24
servant/default.nix
View file

@ -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;
}

4
servant/src/Servant/API.hs
View file

@ -69,8 +69,8 @@ import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,
import Servant.API.Delete (Delete) import Servant.API.Delete (Delete)
import Servant.API.Get (Get) import Servant.API.Get (Get)
import Servant.API.Header (Header (..)) import Servant.API.Header (Header (..))
import Servant.API.HttpVersion (HttpVersion(..)) import Servant.API.HttpVersion (HttpVersion (..))
import Servant.API.IsSecure (IsSecure(..)) import Servant.API.IsSecure (IsSecure (..))
import Servant.API.MatrixParam (MatrixFlag, MatrixParam, import Servant.API.MatrixParam (MatrixFlag, MatrixParam,
MatrixParams) MatrixParams)
import Servant.API.Patch (Patch) import Servant.API.Patch (Patch)

2
servant/src/Servant/API/Delete.hs
View file

@ -4,7 +4,7 @@
{-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_HADDOCK not-home #-}
module Servant.API.Delete (Delete) where module Servant.API.Delete (Delete) where
import Data.Typeable ( Typeable ) import Data.Typeable (Typeable)
-- | Combinator for DELETE requests. -- | Combinator for DELETE requests.
-- --

2
servant/src/Servant/API/HttpVersion.hs
View file

@ -3,7 +3,7 @@ module Servant.API.HttpVersion
HttpVersion(..) HttpVersion(..)
) where ) where
import Network.HTTP.Types (HttpVersion(..)) import Network.HTTP.Types (HttpVersion (..))
-- $httpversion -- $httpversion
-- --

2
servant/src/Servant/API/IsSecure.hs
View file

@ -4,7 +4,7 @@ module Servant.API.IsSecure
IsSecure(..) IsSecure(..)
) where ) where
import Data.Typeable import Data.Typeable
-- | Was this request made over an SSL connection? -- | Was this request made over an SSL connection?
-- --

2
servant/src/Servant/API/Put.hs
View file

@ -4,7 +4,7 @@
{-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_HADDOCK not-home #-}
module Servant.API.Put (Put) where module Servant.API.Put (Put) where
import Data.Typeable ( Typeable ) import Data.Typeable (Typeable)
-- | Endpoint for PUT requests, usually used to update a ressource. -- | Endpoint for PUT requests, usually used to update a ressource.
-- The type @a@ is the type of the response body that's returned. -- The type @a@ is the type of the response body that's returned.

2
servant/src/Servant/API/Raw.hs
View file

@ -2,7 +2,7 @@
{-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_HADDOCK not-home #-}
module Servant.API.Raw where module Servant.API.Raw where
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
-- | Endpoint for plugging in your own Wai 'Application's. -- | Endpoint for plugging in your own Wai 'Application's.
-- --
-- The given 'Application' will get the request as received by the server, potentially with -- The given 'Application' will get the request as received by the server, potentially with

2
servant/src/Servant/API/RemoteHost.hs
View file

@ -4,7 +4,7 @@ module Servant.API.RemoteHost
RemoteHost RemoteHost
) where ) where
import Data.Typeable import Data.Typeable
-- | Provides access to the host or IP address -- | Provides access to the host or IP address
-- from which the HTTP request was sent. -- from which the HTTP request was sent.

2
servant/src/Servant/API/Vault.hs
View file

@ -3,7 +3,7 @@ module Servant.API.Vault
Vault Vault
) where ) where
import Data.Vault.Lazy (Vault) import Data.Vault.Lazy (Vault)
-- $vault -- $vault
-- --

2
servant/test/Doctests.hs
View file

@ -1,6 +1,6 @@
module Main where module Main where
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
import System.Directory import System.Directory
import System.FilePath import System.FilePath
import System.FilePath.Find import System.FilePath.Find

28
servant/test/Servant/API/ContentTypesSpec.hs
View file

@ -12,22 +12,22 @@ import Data.Monoid
#endif #endif
import Control.Arrow import Control.Arrow
import Data.Aeson import Data.Aeson
import Data.ByteString.Char8 (ByteString, append, pack)
import qualified Data.ByteString.Lazy as BSL
import Data.Either import Data.Either
import Data.Function (on) import Data.Function (on)
import Data.List (maximumBy)
import Data.Maybe (fromJust, isJust, isNothing)
import Data.Proxy import Data.Proxy
import Data.ByteString.Char8 (ByteString, append, pack) import Data.String (IsString (..))
import qualified Data.ByteString.Lazy as BSL import Data.String.Conversions (cs)
import Data.List (maximumBy) import qualified Data.Text as TextS
import Data.Maybe (fromJust, isJust, isNothing) import qualified Data.Text.Lazy as TextL
import Data.String (IsString (..))
import Data.String.Conversions (cs)
import qualified Data.Text as TextS
import qualified Data.Text.Lazy as TextL
import GHC.Generics import GHC.Generics
import Network.URL (exportParams, importParams) import Network.URL (exportParams, importParams)
import Test.Hspec import Test.Hspec
import Test.QuickCheck import Test.QuickCheck
import Test.QuickCheck.Instances () import Test.QuickCheck.Instances ()
import Servant.API.ContentTypes import Servant.API.ContentTypes
@ -57,15 +57,15 @@ spec = describe "Servant.API.ContentTypes" $ do
let p = Proxy :: Proxy FormUrlEncoded let p = Proxy :: Proxy FormUrlEncoded
it "has mimeUnrender reverse mimeRender" $ do 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)]) ==> mimeUnrender p (mimeRender p x) == Right (x::[(TextS.Text,TextS.Text)])
it "has mimeUnrender reverse exportParams (Network.URL)" $ do 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)]) ==> (mimeUnrender p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])
it "has importParams (Network.URL) reverse mimeRender" $ do 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)]) ==> (fmap (map (cs *** cs)) . importParams . cs . mimeRender p $ x) == Just (x::[(TextS.Text,TextS.Text)])
describe "The PlainText Content-Type type" $ do describe "The PlainText Content-Type type" $ do