servant-cassava 0.8 → 0.9
raw patch · 3 files changed
+110/−67 lines, 3 filesdep +base-compatdep +bytestringdep ~basedep ~cassavadep ~servantnew-uploader
Dependencies added: base-compat, bytestring
Dependency ranges changed: base, cassava, servant
Files
- include/overlapping-compat.h +0/−8
- servant-cassava.cabal +5/−10
- src/Servant/CSV/Cassava.hs +105/−49
− include/overlapping-compat.h
@@ -1,8 +0,0 @@-#if __GLASGOW_HASKELL__ >= 710-#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}-#define OVERLAPPING_ {-# OVERLAPPING #-}-#else-{-# LANGUAGE OverlappingInstances #-}-#define OVERLAPPABLE_-#define OVERLAPPING_-#endif
servant-cassava.cabal view
@@ -1,10 +1,7 @@--- Initial servant-cassava.cabal generated by cabal init. For further--- documentation, see http://haskell.org/cabal/users-guide/- name: servant-cassava-version: 0.8+version: 0.9 synopsis: Servant CSV content-type for cassava--- description:+description: Servant CSV content-type for cassava. homepage: http://haskell-servant.readthedocs.org/ license: BSD3 license-file: LICENSE@@ -13,7 +10,6 @@ copyright: 2015-2016 Servant Contributors category: Web build-type: Simple-extra-source-files: include/*.h cabal-version: >=1.10 bug-reports: http://github.com/haskell-servant/servant-cassava/issues @@ -23,14 +19,13 @@ library exposed-modules: Servant.CSV.Cassava- -- other-modules:- -- other-extensions: build-depends: base >=4.6 && <5+ , base-compat >=0.9.1 && <0.10+ , bytestring , cassava >0.4 && <0.5- , servant >=0.7 && <0.9+ , servant >=0.7 && <0.12 , http-media , vector hs-source-dirs: src default-language: Haskell2010- include-dirs: include ghc-options: -Wall
src/Servant/CSV/Cassava.hs view
@@ -1,7 +1,9 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -9,34 +11,56 @@ -- | A @CSV@ empty datatype with `MimeRender` and `MimeUnrender` instances for -- @cassava@'s encoding and decoding classes. ----- >>> type Eg = Get '[(CSV', MyEncodeOptions)] [(Int, String)]+-- >>> type Eg = Get '[CSV' 'HasHeader 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+--+module Servant.CSV.Cassava ( module Servant.CSV.Cassava+ , HasHeader(..)+ ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-#endif+import Prelude ()+import Prelude.Compat+ import Data.Csv-import Data.Proxy (Proxy (..))-import Data.Typeable (Typeable)-import Data.Vector (Vector, toList)-import GHC.Generics (Generic)-import qualified Network.HTTP.Media as M-import Servant.API (Accept (..), MimeRender (..),- MimeUnrender (..))+import Data.ByteString.Lazy (ByteString)+import Data.Proxy (Proxy (..))+import Data.Typeable (Typeable)+import Data.Vector (Vector, toList)+import GHC.Generics (Generic)+import qualified Network.HTTP.Media as M+import Servant.API (Accept (..), MimeRender (..),+ MimeUnrender (..)) -data CSV' deriving (Typeable, Generic)+data CSV' (hasHeader :: HasHeader) opt deriving (Typeable)+type CSV = CSV' 'HasHeader DefaultOpts -type CSV = (CSV', DefaultOpts)+-- | 'HasHeader singleton.+data SHasHeader (hasHeader :: HasHeader) where+ SHasHeader :: SHasHeader 'HasHeader+ SNoHeader :: SHasHeader 'NoHeader +-- | Class to provide 'SHasHeader' implicitly.+class SHasHeaderI (hasHeader :: HasHeader) where shasheader :: SHasHeader hasHeader+instance SHasHeaderI 'HasHeader where shasheader = SHasHeader+instance SHasHeaderI 'NoHeader where shasheader = SNoHeader++shasheaderToBool :: SHasHeader hasHeader -> Bool+shasheaderToBool SHasHeader = True+shasheaderToBool SNoHeader = False++lowerSHasHeader :: SHasHeader hasHeader -> HasHeader+lowerSHasHeader SHasHeader = HasHeader+lowerSHasHeader SNoHeader = NoHeader++-- | Default options, instances providing 'defaultDecodeOptions' and 'defaultEncodeOptions'. data DefaultOpts deriving (Typeable, Generic) -- | @text/csv;charset=utf-8@-instance Accept (CSV', a) where+instance Accept (CSV' hasHeader opt) where contentType _ = "text" M.// "csv" M./: ("charset", "utf-8") -- * Encoding@@ -45,35 +69,62 @@ -- | 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+instance ( ToNamedRecord a, EncodeOpts opt, SHasHeaderI hasHeader+ ) => MimeRender (CSV' hasHeader opt) (Header, [a]) where+ mimeRender _ (hdr, vals) = encodeByNameWith opts hdr vals+ where+ opts = encodeOpts' (Proxy :: Proxy opt) (Proxy :: Proxy hasHeader) --- | Encode with 'encodeDefaultOrderedByNameWith'-instance ( DefaultOrdered a, ToNamedRecord a, EncodeOpts opt- ) => MimeRender (CSV', opt) [a] where- mimeRender _ = encodeDefaultOrderedByNameWith (encodeOpts p)- where p = Proxy :: Proxy opt+-- | A class to determine how to encode a list of elements+--+-- * 'HasHeader' encode with 'encodeDefaultOrderedByNameWith'+--+-- * 'NoHeader' encode with 'encodeWith'+--+-- Currently, it's not possible to encode without headers using 'encodeDefaultOrderedByNameWith'.+--+class EncodeList (hasHeader :: HasHeader) a where+ encodeList :: Proxy hasHeader -> EncodeOptions -> [a] -> ByteString +-- | 'encodeDefaultOrderedByNameWith'+instance (DefaultOrdered a, ToNamedRecord a) => EncodeList 'HasHeader a where+ encodeList _ opts vals = encodeDefaultOrderedByNameWith opts { encIncludeHeader = True } vals++-- | 'encodeWith'+instance (ToRecord a) => EncodeList 'NoHeader a where+ encodeList _ opts vals = encodeWith opts { encIncludeHeader = False } vals++instance ( EncodeOpts opt, EncodeList hasHeader a+ ) => MimeRender (CSV' hasHeader opt) [a] where+ mimeRender _ = encodeList (Proxy :: Proxy hasHeader) opts+ where+ opts = encodeOpts (Proxy :: Proxy opt)+ -- | 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, Vector a) where- mimeRender _ (hdr, vals) = encodeByNameWith (encodeOpts p) hdr (toList vals)- where p = Proxy :: Proxy opt+instance ( ToNamedRecord a, EncodeOpts opt, SHasHeaderI hasHeader+ ) => MimeRender (CSV' hasHeader opt) (Header, Vector a) where+ mimeRender _ (hdr, vals) = encodeByNameWith opts hdr (toList vals)+ where+ opts = encodeOpts' (Proxy :: Proxy opt) (Proxy :: Proxy hasHeader) --- | Encode with 'encodeDefaultOrderedByNameWith'-instance ( DefaultOrdered a, ToNamedRecord a, EncodeOpts opt- ) => MimeRender (CSV', opt) (Vector a) where- mimeRender _ = encodeDefaultOrderedByNameWith (encodeOpts p) . toList- where p = Proxy :: Proxy opt+instance ( EncodeOpts opt, EncodeList hasHeader a+ ) => MimeRender (CSV' hasHeader opt) (Vector a) where+ mimeRender _ = encodeList (Proxy :: Proxy hasHeader) opts . toList+ where+ opts = encodeOpts (Proxy :: Proxy opt) -- ** Encode Options -class EncodeOpts a where- encodeOpts :: Proxy a -> EncodeOptions+class EncodeOpts opt where+ encodeOpts :: Proxy opt -> EncodeOptions +encodeOpts'+ :: forall opt hasHeader. (EncodeOpts opt, SHasHeaderI hasHeader)+ => Proxy opt -> Proxy hasHeader -> EncodeOptions+encodeOpts' p _ = (encodeOpts p)+ { encIncludeHeader = shasheaderToBool (shasheader :: SHasHeader hasHeader)+ } instance EncodeOpts DefaultOpts where encodeOpts _ = defaultEncodeOptions@@ -82,28 +133,33 @@ -- ** Instances --- | Decode with 'decodeByNameWith'+-- | Decode with 'decodeByNameWith'. instance ( FromNamedRecord a, DecodeOpts opt- ) => MimeUnrender (CSV', opt) (Header, [a]) where+ ) => MimeUnrender (CSV' 'HasHeader opt) (Header, [a]) where mimeUnrender _ bs = fmap toList <$> decodeByNameWith (decodeOpts p) bs where p = Proxy :: Proxy opt --- | Decode with 'decodeWith'. Assumes data has headers, which are stripped.-instance ( FromRecord a, DecodeOpts opt- ) => MimeUnrender (CSV', opt) [a] where- mimeUnrender _ bs = toList <$> decodeWith (decodeOpts p) HasHeader bs- where p = Proxy :: Proxy opt+-- | Decode with 'decodeWith'.+instance ( FromRecord a, DecodeOpts opt, SHasHeaderI hasHeader+ ) => MimeUnrender (CSV' hasHeader opt) [a] where+ mimeUnrender _ = fmap toList . decodeWith (decodeOpts p) (lowerSHasHeader sh)+ where+ p = Proxy :: Proxy opt+ sh = shasheader :: SHasHeader hasHeader instance ( FromNamedRecord a, DecodeOpts opt- ) => MimeUnrender (CSV', opt) (Header, Vector a) where+ ) => MimeUnrender (CSV' 'HasHeader 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 with 'decodeWith'.+instance ( FromRecord a, DecodeOpts opt, SHasHeaderI hasHeader+ ) => MimeUnrender (CSV' hasHeader opt) (Vector a) where+ mimeUnrender _ = decodeWith (decodeOpts p) (lowerSHasHeader sh)+ where+ p = Proxy :: Proxy opt+ sh = shasheader :: SHasHeader hasHeader+ -- ** Decode Options