summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorphadej <>2015-11-01 08:37:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2015-11-01 08:37:00 (GMT)
commit9f38860607836d0ff2900b3b8b32e7bf5a087af9 (patch)
tree9b710e8e1bda7c064fa8f8c34a4ba18094c315d8
version 0.1.0.00.1.0.0
-rw-r--r--LICENSE30
-rw-r--r--README.md50
-rw-r--r--Setup.hs3
-rw-r--r--example/Main.hs47
-rw-r--r--servant-yaml.cabal59
-rw-r--r--src/Servant/Yaml.hs37
6 files changed, 226 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..2abbe4b
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2015, Oleg Grenrus
+
+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 Oleg Grenrus 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.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..e9cb742
--- /dev/null
+++ b/README.md
@@ -0,0 +1,50 @@
+# servant-yaml
+
+> Servant support for yaml
+
+[![Build Status](https://travis-ci.org/phadej/servant-yaml.svg?branch=master)](https://travis-ci.org/phadej/servant-yaml)
+[![Hackage](https://img.shields.io/hackage/v/servant-yaml.svg)](http://hackage.haskell.org/package/servant-yaml)
+[![Stackage LTS 2](http://stackage.org/package/servant-yaml/badge/lts-2)](http://stackage.org/lts-2/package/servant-yaml)
+[![Stackage LTS 3](http://stackage.org/package/servant-yaml/badge/lts-3)](http://stackage.org/lts-3/package/servant-yaml)
+[![Stackage Nightly](http://stackage.org/package/servant-yaml/badge/nightly)](http://stackage.org/nightly/package/servant-yaml)
+
+## Example
+
+Check [`example/Main.hs`](https://github.com/phadej/servant-yaml/blob/master/example/Main.hs) for an example:
+
+```
+curl -i -H "Content-Type: application/x-yaml" -H "Accept: application/x-yaml" -X POST --data-binary @example.yaml 'localhost:8000/foo'
+
+$ curl -i localhost:8000
+HTTP/1.1 200 OK
+Transfer-Encoding: chunked
+Date: Sun, 01 Nov 2015 08:10:01 GMT
+Server: Warp/3.0.13.1
+Content-Type: application/x-yaml
+
+foo: 42
+bar: Yaml!
+
+$ curl -i -H "Accept: application/json" localhost:8000
+HTTP/1.1 200 OK
+Transfer-Encoding: chunked
+Date: Sun, 01 Nov 2015 08:14:08 GMT
+Server: Warp/3.0.13.1
+Content-Type: application/json
+
+{"foo":42,"bar":"Yaml!"
+
+$ cat example.yaml
+bar: "JSON?"
+foo: 1337
+
+$ curl -i -H "Content-Type: application/x-yaml" -H "Accept: application/x-yaml" -X POST --data-binary @example.yaml 'localhost:8000/foo'
+HTTP/1.1 201 Created
+Transfer-Encoding: chunked
+Date: Sun, 01 Nov 2015 08:15:21 GMT
+Server: Warp/3.0.13.1
+Content-Type: application/x-yaml
+
+foo: 1337
+bar: JSON?
+```
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..b55cb16
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+import Distribution.Simple
+main :: IO ()
+main = defaultMain
diff --git a/example/Main.hs b/example/Main.hs
new file mode 100644
index 0000000..afe31cf
--- /dev/null
+++ b/example/Main.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeOperators #-}
+module Main (main) where
+
+import Prelude ()
+import Prelude.Compat
+
+import Data.Aeson.TH
+import Data.Char (toLower)
+import Data.Maybe (fromMaybe)
+import Network.Wai (Application)
+import Servant
+import Servant.Yaml
+import System.Environment (getArgs, lookupEnv)
+import Text.Read (readMaybe)
+
+import qualified Network.Wai.Handler.Warp as Warp
+
+data Foo = Foo
+ { _fooFoo :: Int
+ , _fooBar :: String
+ }
+ deriving (Eq, Show)
+
+$(deriveJSON defaultOptions{fieldLabelModifier = map toLower . drop 4} ''Foo)
+
+type API = "foo" :> ReqBody '[JSON, YAML] Foo :> Post '[JSON, YAML] Foo
+ :<|> Get '[YAML, JSON] Foo
+
+api :: Proxy API
+api = Proxy
+
+server :: Server API
+server = pure :<|> pure (Foo 42 "Yaml!")
+
+app :: Application
+app = serve api server
+
+main :: IO ()
+main = do
+ args <- getArgs
+ case args of
+ ("run":_) -> do
+ port <- fromMaybe 8000 . (>>= readMaybe) <$> lookupEnv "PORT"
+ Warp.run port app
+ _ -> putStrLn "To run, pass run argument"
diff --git a/servant-yaml.cabal b/servant-yaml.cabal
new file mode 100644
index 0000000..2ba4ac3
--- /dev/null
+++ b/servant-yaml.cabal
@@ -0,0 +1,59 @@
+-- This file has been generated from package.yaml by hpack version 0.8.0.
+--
+-- see: https://github.com/sol/hpack
+
+name: servant-yaml
+version: 0.1.0.0
+synopsis: Servant support for yaml
+description: Servant support for yaml
+category: Web
+homepage: https://github.com/phadej/servant-yaml#readme
+bug-reports: https://github.com/phadej/servant-yaml/issues
+author: Oleg Grenrus <oleg.grenrus@iki.fi>
+maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
+license: BSD3
+license-file: LICENSE
+tested-with: GHC==7.8.4, GHC==7.10.2
+build-type: Simple
+cabal-version: >= 1.10
+
+extra-source-files:
+ README.md
+
+source-repository head
+ type: git
+ location: https://github.com/phadej/servant-yaml
+
+library
+ hs-source-dirs:
+ src
+ ghc-options: -Wall
+ build-depends:
+ base >=4.7 && <4.9
+ , bytestring >=0.10.4.0 && <0.11
+ , http-media >=0.6.2 && <0.7
+ , servant >=0.4.4.5 && <0.5
+ , yaml >=0.8.12 && <0.9
+ exposed-modules:
+ Servant.Yaml
+ default-language: Haskell2010
+
+test-suite example
+ type: exitcode-stdio-1.0
+ main-is: Main.hs
+ hs-source-dirs:
+ example
+ ghc-options: -Wall
+ build-depends:
+ base >=4.7 && <4.9
+ , bytestring >=0.10.4.0 && <0.11
+ , http-media >=0.6.2 && <0.7
+ , servant >=0.4.4.5 && <0.5
+ , yaml >=0.8.12 && <0.9
+ , servant-yaml
+ , servant-server >=0.4.4.5 && <0.5
+ , base-compat >=0.6.0 && <0.9
+ , aeson >=0.8.0.2 && <0.11
+ , wai >=3.0.3.0 && <3.1
+ , warp >=3.0.13.1 && <3.2
+ default-language: Haskell2010
diff --git a/src/Servant/Yaml.hs b/src/Servant/Yaml.hs
new file mode 100644
index 0000000..bc95c1d
--- /dev/null
+++ b/src/Servant/Yaml.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+-- |
+-- Module : Servant.Yaml
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>
+--
+-- An @YAML@ empty data type with `MimeRender` instances for @yaml@ /
+-- @aeson@'s `ToJSON` class and `Value` datatype. You should only need to
+-- import this module for it's instances and the `YAML` datatype.:
+--
+-- >>> type YamlGET a = Get '[YAML] a
+--
+-- Will then check that @a@ has a `ToJSON` instance (`Value` has).
+module Servant.Yaml where
+
+import Data.Yaml (FromJSON, ToJSON, decodeEither, encode)
+import Servant.API (Accept (..), MimeRender (..), MimeUnrender (..))
+
+import qualified Data.ByteString.Lazy as LBS
+import qualified Network.HTTP.Media as M
+
+data YAML -- deriving Typeable
+
+-- | @application/x-yaml@
+instance Accept YAML where
+ contentType _ = "application" M.// "x-yaml"
+
+-- | `encode`
+instance ToJSON a => MimeRender YAML a where
+ mimeRender _ = LBS.fromStrict . encode
+
+-- | `decodeEither`
+instance FromJSON a => MimeUnrender YAML a where
+ mimeUnrender _ = decodeEither . LBS.toStrict