From 1bffaac2d0945da831f22c60763e3b233ddf60a3 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Sat, 29 Aug 2015 19:15:16 +0200 Subject: [PATCH] Add servant-cassava. --- servant-cassava/LICENSE | 30 ++++++++ servant-cassava/Setup.hs | 2 + servant-cassava/servant-cassava.cabal | 29 +++++++ servant-cassava/src/Servant/CSV/Cassava.hs | 88 ++++++++++++++++++++++ sources.txt | 1 + stack.yaml | 1 + 6 files changed, 151 insertions(+) create mode 100644 servant-cassava/LICENSE create mode 100644 servant-cassava/Setup.hs create mode 100644 servant-cassava/servant-cassava.cabal create mode 100644 servant-cassava/src/Servant/CSV/Cassava.hs diff --git a/servant-cassava/LICENSE b/servant-cassava/LICENSE new file mode 100644 index 00000000..0b0a2174 --- /dev/null +++ b/servant-cassava/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Julian K. Arni + +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 Julian K. Arni 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/servant-cassava/Setup.hs b/servant-cassava/Setup.hs new file mode 100644 index 00000000..9a994af6 --- /dev/null +++ b/servant-cassava/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/servant-cassava/servant-cassava.cabal b/servant-cassava/servant-cassava.cabal new file mode 100644 index 00000000..4d74612a --- /dev/null +++ b/servant-cassava/servant-cassava.cabal @@ -0,0 +1,29 @@ +-- Initial servant-cassava.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: servant-cassava +version: 0.4.4.2 +synopsis: Servant CSV content-type for cassava +-- description: +homepage: http://haskell-servant.github.io/ +license: BSD3 +license-file: LICENSE +author: Julian K. Arni +maintainer: jkarni@gmail.com +-- copyright: +-- category: +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +library + exposed-modules: Servant.CSV.Cassava + -- other-modules: + -- other-extensions: + build-depends: base >=4.6 && <5 + , cassava >0.4 && <0.5 + , servant ==0.5.* + , http-media + , vector + hs-source-dirs: src + default-language: Haskell2010 diff --git a/servant-cassava/src/Servant/CSV/Cassava.hs b/servant-cassava/src/Servant/CSV/Cassava.hs new file mode 100644 index 00000000..5bd5a374 --- /dev/null +++ b/servant-cassava/src/Servant/CSV/Cassava.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | A @CSV@ empty datatype with `MimeRender` and `MimeUnrender` instances for +-- @cassava@'s encoding and decoding classes. +-- +-- >>> type Eg = Get '[(CSV', MyEncodeOptions)] [(Int, String)] +-- +-- Default encoding and decoding options are also provided, along with the +-- @CSV@ type synonym that uses them. +-- +-- >>> type EgDefault = Get '[CSV] [(Int, String)] +module Servant.CSV.Cassava where + +import Data.Csv +import Data.Proxy (Proxy (..)) +import Data.Typeable (Typeable) +import Data.Vector (Vector) +import GHC.Generics (Generic) +import qualified Network.HTTP.Media as M +import Servant.API (Accept (..), MimeRender (..), + MimeUnrender (..)) + +data CSV' deriving (Typeable, Generic) + +type CSV = (CSV', DefaultDecodeOpts) + +-- | @text/csv;charset=utf-8@ +instance Accept (CSV', a) where + contentType _ = "text" M.// "csv" M./: ("charset", "utf-8") + +-- * Encoding + +-- ** Instances + +-- | Encode with 'encodeByNameWith'. The 'Header' param is used for determining +-- the order of headers and fields. +instance ( ToNamedRecord a, EncodeOpts opt + ) => MimeRender (CSV', opt) (Header, [a]) where + mimeRender _ (hdr, vals) = encodeByNameWith (encodeOpts p) hdr vals + where p = Proxy :: Proxy opt + +-- | Encode with 'encodeDefaultOrderedByNameWith' +instance ( DefaultOrdered a, ToNamedRecord a, EncodeOpts opt + ) => MimeRender (CSV', opt) [a] where + mimeRender _ = encodeDefaultOrderedByNameWith (encodeOpts p) + where p = Proxy :: Proxy opt + + +-- ** Encode Options + +class EncodeOpts a where + encodeOpts :: Proxy a -> EncodeOptions + +data DefaultEncodeOpts deriving (Typeable, Generic) + +instance EncodeOpts DefaultEncodeOpts where + encodeOpts _ = defaultEncodeOptions + +-- * Decoding + +-- ** Instances + +-- | Decode with 'decodeByNameWith' +instance ( FromNamedRecord a, DecodeOpts opt + ) => MimeUnrender (CSV', opt) (Header, Vector a) where + mimeUnrender _ = decodeByNameWith (decodeOpts p) + where p = Proxy :: Proxy opt + +-- | Decode with 'decodeWith'. Assumes data has headers, which are stripped. +instance ( FromRecord a, DecodeOpts opt + ) => MimeUnrender (CSV', opt) (Vector a) where + mimeUnrender _ = decodeWith (decodeOpts p) HasHeader + where p = Proxy :: Proxy opt + +-- ** Decode Options + +class DecodeOpts a where + decodeOpts :: Proxy a -> DecodeOptions + +data DefaultDecodeOpts deriving (Typeable, Generic) + +instance DecodeOpts DefaultDecodeOpts where + decodeOpts _ = defaultDecodeOptions diff --git a/sources.txt b/sources.txt index cc717266..bd229587 100644 --- a/sources.txt +++ b/sources.txt @@ -1,4 +1,5 @@ servant +servant-cassava servant-client servant-docs servant-js diff --git a/stack.yaml b/stack.yaml index b7e1438e..14421b9d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -4,6 +4,7 @@ flags: packages: - servant/ - servant-blaze/ +- servant-cassava/ - servant-client/ - servant-docs/ - servant-examples/