diff --git a/LICENSE b/LICENSE new file mode 100644 --- /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 --- /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 --- /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 --- /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 --- /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 +maintainer: Oleg Grenrus +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 --- /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 +-- +-- 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