servant-waargonaut (empty) → 0.5.0.1
raw patch · 7 files changed
+333/−0 lines, 7 filesdep +attoparsecdep +basedep +bytestringsetup-changed
Dependencies added: attoparsec, base, bytestring, http-media, http-types, lens, servant, servant-server, servant-waargonaut, tasty, tasty-wai, text, transformers, waargonaut, wai, wl-pprint-annotated
Files
- CHANGELOG.md +10/−0
- LICENCE +31/−0
- Setup.hs +2/−0
- servant-waargonaut.cabal +87/−0
- src/Servant/API/ContentTypes/Waargonaut.hs +78/−0
- test/Main.hs +38/−0
- test/TestAPI.hs +87/−0
+ CHANGELOG.md view
@@ -0,0 +1,10 @@+# Revision history for servant-waargonaut++## 0.5.0.0 -- 2019-01-08++* Bump waargonaut to version 0.5.2.1+* Use nix overlays instead of manually composed overrides.++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENCE view
@@ -0,0 +1,31 @@+Copyright (c) 2018, Commonwealth Scientific and Industrial Research Organisation+(CSIRO) ABN 41 687 119 230.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of QFPL nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ servant-waargonaut.cabal view
@@ -0,0 +1,87 @@+-- Initial servant-waargonaut.cabal generated by cabal init. For further+-- documentation, see http://haskell.org/cabal/users-guide/++name: servant-waargonaut+version: 0.5.0.1+synopsis: Servant Integration for Waargonaut JSON Package+description: Provides the types and instances necessary to utilise Waargonaut as the JSON handling library for your Servant API.+-- license:+-- The license under which the package is released.+license: BSD3++-- The file containing the license text.+license-file: LICENCE++-- The package author(s).+author: QFPL @ Data61++-- An email address to which users can send suggestions, bug reports, and+-- patches.+maintainer: oᴉ˙ldɟb@uɐǝs++-- A copyright notice.+copyright: Copyright (C) 2017 Commonwealth Scientific and Industrial Research Organisation (CSIRO)++category: Web, JSON++build-type: Simple+extra-source-files: CHANGELOG.md+cabal-version: >=1.10++tested-with: GHC==8.0.2+ , GHC==8.2.2+ , GHC==8.4.4+ , GHC==8.6.3++source-repository head+ type: git+ location: git@github.com/qfpl/servant-waargonaut.git++library+ exposed-modules: Servant.API.ContentTypes.Waargonaut+ -- other-modules:+ -- other-extensions:+ build-depends: base >= 4.9 && < 4.13+ , servant >= 0.14.1 && < 0.16+ , waargonaut >= 0.5 && < 0.6+ , attoparsec >= 0.13.2 && < 0.14+ , bytestring >= 0.10.8 && < 0.11+ , text >= 1.2.3 && < 1.3+ , http-media >= 0.7.1 && < 0.8+ , lens >= 4.16.1 && < 4.18+ , wl-pprint-annotated >= 0.1.0 && < 0.2++ hs-source-dirs: src++ default-language: Haskell2010+ ghc-options: -Wall++test-suite saarg+ -- Base language which the package is written in.+ default-language: Haskell2010++ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: test+ ghc-options: -Wall++ other-modules: TestAPI++ build-depends: base >= 4.9 && < 4.13+ , servant-waargonaut+ , servant-server+ , servant >= 0.14.1 && < 0.16+ , waargonaut >= 0.5 && < 0.6++ , attoparsec >= 0.13.2 && < 0.14+ , bytestring >= 0.10.8 && < 0.11+ , text >= 1.2.3 && < 1.3+ , http-media >= 0.7.1 && < 0.8+ , lens >= 4.16.1 && < 4.18+ , wl-pprint-annotated >= 0.1.0 && < 0.2++ , wai+ , tasty+ , tasty-wai+ , http-types+ , transformers
+ src/Servant/API/ContentTypes/Waargonaut.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- | Integrate Waargonaut with Servant, including support for the tagged typeclass encoder/decoder functionality.+module Servant.API.ContentTypes.Waargonaut ( WaargJSON ) where++import Control.Category ((.))+import Control.Lens (over, _Left)++import Prelude (show)++import qualified Data.ByteString.Lazy as BSL+import qualified Data.Text as Text+import qualified Data.Text.Lazy.Encoding as TextLE++import Data.Function (($))+import Data.Proxy (Proxy (..))+import Data.Typeable (Typeable)++import qualified Data.List.NonEmpty as NE+import qualified Network.HTTP.Media as M++import Data.Attoparsec.ByteString (eitherResult, parse)++import Servant.API.ContentTypes (Accept (..), MimeRender (..),+ MimeUnrender (..))++import qualified Text.PrettyPrint.Annotated.WL as WL+import Waargonaut (parseWaargonaut)+import Waargonaut.Decode (ppCursorHistory, simpleDecode)+import Waargonaut.Decode.Error (DecodeError (ParseFailed))++import Waargonaut.Encode (simplePureEncodeNoSpaces)++import Waargonaut.Generic (JsonDecode, JsonEncode,+ mkDecoder, mkEncoder, proxy)++-- | Replacement for 'Servant.API.ContentTypes.JSON' that will use the relevant instances from+-- Waargonaut that are tagged with the type @t@.+--+-- This allows you to have separate typeclass implementations for the same type for different routes+-- and have it be evident in the types. Without the need for creating a 'newtype' for each one.+--+-- Where you would use 'JSON' to use 'aeson' for encoding or decoding, you use 'WaargJSON t', with+-- the @t@ denoting the tag type. Refer to the <https://hackage.haskell.org/package/waargonaut Waargonaut>+-- package for more information about why this is so.+--+-- A hello world example:+--+-- >>> -- GET /hello/world+-- >>> -- returning a JSON encoded World value+-- >>> data MyTag = MyTag+-- >>> type MyApi = "hello" :> "world" :> Get '[WaargJSON MyTag] World+--+data WaargJSON t+ deriving Typeable++instance Accept (WaargJSON t) where+ contentTypes _ = "application" M.// "json" M./: ("charset", "utf-8") NE.:| [ "application" M.// "json" ]++instance JsonDecode t a => MimeUnrender (WaargJSON t) a where+ mimeUnrender _ = over _Left handleErr+ . simpleDecode (proxy mkDecoder (Proxy :: Proxy t)) parser+ . BSL.toStrict++ where+ parser =+ over _Left (ParseFailed . Text.pack)+ . eitherResult+ . parse parseWaargonaut++ handleErr (dErr, hist) = WL.display . WL.renderPrettyDefault $+ WL.text (show dErr) WL.<##> ppCursorHistory hist++instance JsonEncode t a => MimeRender (WaargJSON t) a where+ mimeRender _ = TextLE.encodeUtf8 . simplePureEncodeNoSpaces (proxy mkEncoder (Proxy :: Proxy t))
+ test/Main.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Data.Proxy (Proxy (..))++import qualified Data.Text.Lazy.Encoding as TextLE++import qualified Data.ByteString.Lazy as BSL+import Network.HTTP.Types (StdMethod (POST), status200)++import qualified Waargonaut.Encode as W+import qualified Waargonaut.Generic as W++import TestAPI (TestAARG, app, testPerson,+ testPersonBS)++import Test.Tasty (defaultMain, testGroup)+import Test.Tasty.Wai (assertBody, assertStatus',+ buildRequestWithHeaders, get,+ srequest, testWai)++main :: IO ()+main = defaultMain $ testGroup "Servant Waargonaut"++ [ testWai app "GET '/' - 200 and contains a Waarg Encoded Person" $ do+ res <- get "/"+ assertBody (BSL.fromStrict testPersonBS) res++ , testWai app "POST '/' - 200 and accepts a Waarg Decoded Person" $ do+ let bdy = W.simplePureEncodeNoSpaces (W.proxy W.mkEncoder (Proxy :: Proxy TestAARG)) testPerson++ res <- srequest $ buildRequestWithHeaders POST "/"+ (TextLE.encodeUtf8 bdy)+ [("Content-Type", "application/json")]++ assertBody "OMG" res+ assertStatus' status200 res+ ]
+ test/TestAPI.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeOperators #-}+module TestAPI+ ( TestAPI+ , TestAARG+ , Person (..)+ , testPersonBS+ , testPerson+ , app+ ) where++import qualified GHC.Generics as GHC++import Data.Bool (bool)+import Data.Proxy (Proxy (..))+import Servant.API ((:<|>) ((:<|>)), (:>),+ Get, PlainText, Post,+ ReqBody)+import Servant.Server (Server, serve)++import Network.Wai (Application)++import Data.ByteString (ByteString)+import qualified Data.Char as Char+import Data.Text (Text)+import qualified Data.Text as Text++import Waargonaut.Generic (Generic,+ HasDatatypeInfo,+ JsonDecode (..),+ JsonEncode (..),+ Options (..), defaultOpts,+ gDecoder, gEncoder)++import Servant.API.ContentTypes.Waargonaut (WaargJSON)++data TestAARG++data Person = Person+ { _personName :: Text+ , _personAge :: Int+ , _personAddress :: Text+ , _personFavouriteLotteryNumbers :: [Int]+ }+ deriving (Eq, Show, GHC.Generic)++instance HasDatatypeInfo Person+instance Generic Person++personWaargOpts :: Options+personWaargOpts = defaultOpts+ { _optionsFieldName =+ (\n ->+ maybe n (\(h',t') -> Text.unpack $ Text.cons (Char.toLower h') t')+ $ Text.uncons+ =<< Text.stripPrefix "_person" (Text.pack n)+ )+ }++instance JsonEncode TestAARG Person where mkEncoder = gEncoder personWaargOpts+instance JsonDecode TestAARG Person where mkDecoder = gDecoder personWaargOpts++testPersonBS :: ByteString+testPersonBS = "{\"name\":\"Krag\",\"age\":88,\"address\":\"Red House 4, Three Neck Lane, Greentown.\",\"favouriteLotteryNumbers\":[86,3,32,42,73]}"++testPerson :: Person+testPerson = Person "Krag" 88 "Red House 4, Three Neck Lane, Greentown." [86,3,32,42,73]++type TestAPI =+ {- | Test Encoding -} Get '[WaargJSON TestAARG] Person :<|>+ {- | Test Decoding -} ReqBody '[WaargJSON TestAARG] Person :> Post '[PlainText] Text++simpleApi :: Proxy TestAPI+simpleApi = Proxy++server :: Server TestAPI+server =+ pure testPerson :<|>+ pure . bool "NOOO" "OMG" . (== testPerson)++app :: Application+app = serve simpleApi server