servant-serialization (empty) → 0.1.0
raw patch · 5 files changed
+245/−0 lines, 5 filesdep +QuickCheckdep +aesondep +basesetup-changed
Dependencies added: QuickCheck, aeson, base, binary, bytestring, cereal, doctest, flat, http-api-data, http-client, http-media, persist, serialise, servant, servant-client, servant-serialization, servant-server, text, warp
Files
- Doctests.hs +12/−0
- Main.hs +121/−0
- Setup.hs +2/−0
- lib/Servant/API/ContentTypes/ShowRead.hs +32/−0
- servant-serialization.cabal +78/−0
+ Doctests.hs view
@@ -0,0 +1,12 @@+module Main where++import qualified System.Environment+import qualified Test.DocTest++main :: IO ()+main = do+ args <- System.Environment.getArgs+ Test.DocTest.doctest+ $ "./lib/"+ : "./Main.hs"+ : args
+ Main.hs view
@@ -0,0 +1,121 @@+{-# OPTIONS_GHC "-Wno-missing-signatures" #-}+{-# OPTIONS_GHC "-Wno-unused-top-binds" #-}+{-# OPTIONS_GHC "-Wno-orphans" #-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DeriveGeneric #-}++import Data.Proxy (Proxy(..))+import GHC.Generics (Generic)+import Network.Wai.Handler.Warp (run)+import qualified Data.Aeson as Aeson (ToJSON, FromJSON)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Text as T+import qualified Web.FormUrlEncoded as UrlEncoded (ToForm, FromForm)++import Servant.API+import Servant.Server+import Servant.API.ContentTypes.ShowRead++import Servant.Client+import Network.HTTP.Client (Manager)+import qualified Test.QuickCheck as QC++data Example = Example+ { slythy :: Bool+ , momeRaths :: [Either Char Ordering]+ , grabe :: Int+ } deriving (Eq, Show, Read, Generic)++instance UrlEncoded.FromForm Example+instance UrlEncoded.ToForm Example++instance Aeson.FromJSON Example+instance Aeson.ToJSON Example++type TestAPI a+ -- string types+ = "string" :> ReqBody '[PlainText] String :> Post '[PlainText] String+ :<|> "text" :> ReqBody '[PlainText] T.Text :> Post '[PlainText] T.Text+ :<|> "bs" :> ReqBody '[OctetStream] BS.ByteString :> Post '[OctetStream] BS.ByteString+ :<|> "bsl" :> ReqBody '[OctetStream] BSL.ByteString :> Post '[OctetStream] BSL.ByteString+ -- builtin serialization+ :<|> "urlenc" :> ReqBody '[FormUrlEncoded] a :> Post '[FormUrlEncoded] a+ :<|> "json" :> ReqBody '[JSON] a :> Post '[JSON] a+ -- additional serialization+ :<|> "show" :> ReqBody '[ShowRead] a :> Post '[ShowRead] a++-- | Client functions+rtString+ :<|> rtText+ :<|> rtBS+ :<|> rtBSL+ :<|> rtUrlEnc+ :<|> rtJson+ :<|> rtShow+ = client (Proxy @(TestAPI Example))++main :: IO ()+main+ = run 80801+ . serve (Proxy @(TestAPI Example))+ $ return+ :<|> return+ :<|> return+ :<|> return+ :<|> return+ :<|> return+ :<|> return++-- $setup+-- >>> import Control.Concurrent (forkIO)+-- >>> forkIO main -- run a server in the background; BE SURE TO TEARDOWN+-- ThreadId ...+-- >>> import Network.HTTP.Client (newManager, defaultManagerSettings)+-- >>> mgr <- newManager defaultManagerSettings+-- >>> import Test.QuickCheck.Monadic (monadicIO)++-- | Send a value through a ClientM action and report whether it is unchanged.+--+-- !!!!> \x -> QC.ioProperty $ testRoundTrip mgr rtString x+-- prop> \x -> QC.ioProperty $ testRoundTrip mgr rtText x+-- prop> \x -> QC.ioProperty $ testRoundTrip mgr rtBS x+-- prop> \x -> QC.ioProperty $ testRoundTrip mgr rtBSL x+-- prop> \x -> QC.ioProperty $ testRoundTrip mgr rtUrlEnc (x :: Example)+-- prop> \x -> QC.ioProperty $ testRoundTrip mgr rtJson (x :: Example)+-- prop> \x -> QC.ioProperty $ testRoundTrip mgr rtShow (x :: Example)+testRoundTrip :: (Eq a, Show a) => Manager -> (a -> ClientM a) -> a -> IO Bool+testRoundTrip mgr roundtrip val = do+ let env = mkClientEnv mgr $ BaseUrl Http "localhost" 80801 ""+ result <- runClientM (roundtrip val) env+ case result of+ Left err -> print err >> return False+ Right val2+ | val == val2 -> return True+ | otherwise -> do+ putStrLn $ show val ++ " → " ++ show val2+ return False++instance QC.Arbitrary T.Text where+ arbitrary = T.pack <$> QC.arbitrary+ shrink = fmap T.pack . QC.shrink . T.unpack++instance QC.Arbitrary BS.ByteString where+ arbitrary = BS.pack <$> QC.arbitrary+ shrink = fmap BS.pack . QC.shrink . BS.unpack++instance QC.Arbitrary BSL.ByteString where+ arbitrary = BSL.pack <$> QC.arbitrary+ shrink = fmap BSL.pack . QC.shrink . BSL.unpack++instance QC.Arbitrary Example where+ arbitrary = Example <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary+ shrink (Example a b c) =+ [ Example a' b' c'+ | a' <- QC.shrink a+ , b' <- QC.shrink b+ , c' <- QC.shrink c+ ]
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lib/Servant/API/ContentTypes/ShowRead.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Servant.API.ContentTypes.ShowRead where++import Data.Proxy (Proxy(..))+import Network.HTTP.Media ((//))+import qualified Data.List.NonEmpty as NonEmpty++import Control.Monad ((<=<))+import Data.Text.Lazy (pack, unpack)+import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8')+import Text.Read (readEither)++import Servant.API.ContentTypes++-- | Content type for UTF-8 encoded Show/Read data.+data ShowRead++instance Accept ShowRead where+ contentTypes Proxy = NonEmpty.fromList+ [ "application" // "x-haskell-showread"+ , "application" // "vnd.haskell.showread"+ ]++instance Show a => MimeRender ShowRead a where+ mimeRender Proxy = encodeUtf8 . pack . show++instance Read a => MimeUnrender ShowRead a where+ mimeUnrender Proxy = readEither . unpack <=< mapLeft show . decodeUtf8'+ where+ mapLeft f = either (Left . f) Right
+ servant-serialization.cabal view
@@ -0,0 +1,78 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.7.+--+-- see: https://github.com/sol/hpack++name: servant-serialization+version: 0.1.0+description: Servant content types and instances for common serialization formats.+license: MIT+build-type: Simple++library+ exposed-modules:+ Servant.API.ContentTypes.ShowRead+ other-modules:+ Paths_servant_serialization+ hs-source-dirs:+ lib+ ghc-options: -Wall+ build-depends:+ base ==4.15.*+ , binary+ , cereal+ , flat+ , http-media+ , persist+ , serialise+ , servant+ , text+ default-language: Haskell2010++executable example+ main-is: Main.hs+ other-modules:+ Paths_servant_serialization+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck+ , aeson+ , base ==4.15.*+ , binary+ , bytestring+ , cereal+ , flat+ , http-api-data+ , http-client+ , http-media+ , persist+ , serialise+ , servant+ , servant-client+ , servant-serialization+ , servant-server+ , text+ , warp+ default-language: Haskell2010++test-suite doctest+ type: exitcode-stdio-1.0+ main-is: Doctests.hs+ other-modules:+ Paths_servant_serialization+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck+ , base ==4.15.*+ , binary+ , cereal+ , doctest+ , flat+ , http-media+ , persist+ , serialise+ , servant+ , servant-serialization+ , text+ default-language: Haskell2010