servant 0.4.0 → 0.4.1
raw patch · 4 files changed
+80/−49 lines, 4 filesdep +directorydep +filepath
Dependencies added: directory, filepath
Files
- servant.cabal +4/−2
- src/Servant/API/ContentTypes.hs +36/−22
- src/Servant/Utils/Links.hs +26/−24
- test/Doctests.hs +14/−1
servant.cabal view
@@ -1,10 +1,10 @@ name: servant-version: 0.4.0+version: 0.4.1 synopsis: A family of combinators for defining webservices APIs description: A family of combinators for defining webservices APIs and serving them .- You can learn about the basics in <http://haskell-servant.github.io/getting-started/ the getting started> guide.+ You can learn about the basics in the <http://haskell-servant.github.io/tutorial tutorial>. . <https://github.com/haskell-servant/servant-server/blob/master/example/greet.hs Here>'s a runnable example, with comments, that defines a dummy API and implements a webserver that serves this API, using the <http://hackage.haskell.org/package/servant-server servant-server> package.@@ -107,6 +107,8 @@ , servant , doctest , filemanip+ , directory+ , filepath type: exitcode-stdio-1.0 main-is: test/Doctests.hs buildable: True
src/Servant/API/ContentTypes.hs view
@@ -66,29 +66,31 @@ ) where #if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<*))+import Control.Applicative ((*>), (<*)) #endif-import Control.Arrow (left)+import Control.Arrow (left) import Control.Monad-import Data.Aeson (FromJSON, ToJSON, Value,- encode, parseJSON)-import Data.Aeson.Parser (value)-import Data.Aeson.Types (parseEither)-import Data.Attoparsec.ByteString (endOfInput, parseOnly)-import qualified Data.ByteString as BS-import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)-import qualified Data.ByteString.Lazy as B+import Data.Aeson (FromJSON, ToJSON, encode,+ parseJSON)+import Data.Aeson.Parser (value)+import Data.Aeson.Types (parseEither)+import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly,+ skipSpace, (<?>))+import qualified Data.ByteString as BS+import Data.ByteString.Lazy (ByteString, fromStrict,+ toStrict)+import qualified Data.ByteString.Lazy as B import Data.Monoid-import Data.String.Conversions (cs)-import qualified Data.Text as TextS-import qualified Data.Text.Encoding as TextS-import qualified Data.Text.Lazy as TextL-import qualified Data.Text.Lazy.Encoding as TextL+import Data.String.Conversions (cs)+import qualified Data.Text as TextS+import qualified Data.Text.Encoding as TextS+import qualified Data.Text.Lazy as TextL+import qualified Data.Text.Lazy.Encoding as TextL import Data.Typeable-import GHC.Exts (Constraint)-import qualified Network.HTTP.Media as M-import Network.URI (escapeURIString, isUnreserved,- unEscapeString)+import GHC.Exts (Constraint)+import qualified Network.HTTP.Media as M+import Network.URI (escapeURIString,+ isUnreserved, unEscapeString) -- * Provided content types data JSON deriving Typeable@@ -291,10 +293,22 @@ -- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just -- objects and arrays.+--+-- Will handle trailing whitespace, but not trailing junk. ie.+--+-- >>> eitherDecodeLenient "1 " :: Either String Int+-- Right 1+--+-- >>> eitherDecodeLenient "1 junk" :: Either String Int+-- Left "trailing junk after valid JSON: endOfInput" eitherDecodeLenient :: FromJSON a => ByteString -> Either String a-eitherDecodeLenient input = do- v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input)- parseEither parseJSON v+eitherDecodeLenient input =+ parseOnly parser (cs input) >>= parseEither parseJSON+ where+ parser = skipSpace+ *> Data.Aeson.Parser.value+ <* skipSpace+ <* (endOfInput <?> "trailing junk after valid JSON") -- | `eitherDecode` instance FromJSON a => MimeUnrender JSON a where
src/Servant/Utils/Links.hs view
@@ -72,8 +72,7 @@ -- -- >>> let bad_link = Proxy :: Proxy ("hello" :> Delete '[JSON] ()) -- >>> safeLink api bad_link--- <BLANKLINE>--- <interactive>:64:1:+-- ... -- Could not deduce (Or -- (IsElem' (Delete '[JSON] ()) (Get '[JSON] Int)) -- (IsElem'@@ -138,15 +137,17 @@ -- | If either a or b produce an empty constraint, produce an empty constraint. type family Or (a :: Constraint) (b :: Constraint) :: Constraint where+ -- This works because of:+ -- https://ghc.haskell.org/trac/ghc/wiki/NewAxioms/CoincidentOverlap Or () b = () Or a () = () -- | If both a or b produce an empty constraint, produce an empty constraint. type family And (a :: Constraint) (b :: Constraint) :: Constraint where- And () () = ()+ And () () = () --- | You may use this type family to tell the type checker that your custom type--- may be skipped as part of a link. This is useful for things like+-- | You may use this type family to tell the type checker that your custom+-- type may be skipped as part of a link. This is useful for things like -- 'QueryParam' that are optional in a URI and do not affect them if they are -- omitted. --@@ -162,30 +163,31 @@ -- | Closed type family, check if endpoint is within api type family IsElem endpoint api :: Constraint where- IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)- IsElem (e :> sa) (e :> sb) = IsElem sa sb- IsElem sa (Header x :> sb) = IsElem sa sb- IsElem sa (ReqBody y x :> sb) = IsElem sa sb- IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb- IsElem sa (QueryParam x y :> sb) = IsElem sa sb- IsElem sa (QueryParams x y :> sb) = IsElem sa sb- IsElem sa (QueryFlag x :> sb) = IsElem sa sb- IsElem sa (MatrixParam x y :> sb) = IsElem sa sb- IsElem sa (MatrixParams x y :> sb) = IsElem sa sb- IsElem sa (MatrixFlag x :> sb) = IsElem sa sb- IsElem (Get ct typ) (Get ct' typ) = IsSubList ct ct'- IsElem (Post ct typ) (Post ct' typ) = IsSubList ct ct'- IsElem (Put ct typ) (Put ct' typ) = IsSubList ct ct'- IsElem (Delete ct typ) (Delete ct' typ) = IsSubList ct ct'- IsElem e e = ()- IsElem e a = IsElem' e a+ IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)+ IsElem (e :> sa) (e :> sb) = IsElem sa sb+ IsElem sa (Header x :> sb) = IsElem sa sb+ IsElem sa (ReqBody y x :> sb) = IsElem sa sb+ IsElem (Capture z y :> sa) (Capture x y :> sb)+ = IsElem sa sb+ IsElem sa (QueryParam x y :> sb) = IsElem sa sb+ IsElem sa (QueryParams x y :> sb) = IsElem sa sb+ IsElem sa (QueryFlag x :> sb) = IsElem sa sb+ IsElem sa (MatrixParam x y :> sb) = IsElem sa sb+ IsElem sa (MatrixParams x y :> sb) = IsElem sa sb+ IsElem sa (MatrixFlag x :> sb) = IsElem sa sb+ IsElem (Get ct typ) (Get ct' typ) = IsSubList ct ct'+ IsElem (Post ct typ) (Post ct' typ) = IsSubList ct ct'+ IsElem (Put ct typ) (Put ct' typ) = IsSubList ct ct'+ IsElem (Delete ct typ) (Delete ct' typ) = IsSubList ct ct'+ IsElem e e = ()+ IsElem e a = IsElem' e a type family IsSubList a b :: Constraint where- IsSubList '[] b = ()+ IsSubList '[] b = () IsSubList '[x] (x ': xs) = () IsSubList '[x] (y ': ys) = IsSubList '[x] ys- IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y+ IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y -- Phantom types for Param data Matrix
test/Doctests.hs view
@@ -1,16 +1,29 @@ module Main where +import Data.List (isPrefixOf)+import System.Directory+import System.FilePath import System.FilePath.Find import Test.DocTest main :: IO () main = do files <- find always (extension ==? ".hs") "src"+ cabalMacrosFile <- getCabalMacrosFile doctest $ [ "-isrc" , "-optP-include"- , "-optPdist/build/autogen/cabal_macros.h"+ , "-optP" ++ cabalMacrosFile , "-XOverloadedStrings" , "-XFlexibleInstances" , "-XMultiParamTypeClasses" ] ++ files +getCabalMacrosFile :: IO FilePath+getCabalMacrosFile = do+ contents <- getDirectoryContents "dist"+ let rest = "build" </> "autogen" </> "cabal_macros.h"+ return $ case filter ("dist-sandbox-" `isPrefixOf`) contents of+ [x] -> "dist" </> x </> rest+ [] -> "dist" </> rest+ xs -> error $ "ran doctests with multiple dist/dist-sandbox-xxxxx's: \n"+ ++ show xs ++ "\nTry cabal clean"