@@ -1,115 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DeriveDataTypeable #-}
3−{-# LANGUAGE DeriveGeneric #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE MultiParamTypeClasses #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE ScopedTypeVariables #-}
8−
9−-- | A @CSV@ empty datatype with `MimeRender` and `MimeUnrender` instances for
10−-- @cassava@'s encoding and decoding classes.
11−--
12−-- >>> type Eg = Get '[(CSV', MyEncodeOptions)] [(Int, String)]
13−--
14−-- Default encoding and decoding options are also provided, along with the
15−-- @CSV@ type synonym that uses them.
16−--
17−-- >>> type EgDefault = Get '[CSV] [(Int, String)]
18−module Servant.CSV.Cassava where
19−
20−#if !MIN_VERSION_base(4,8,0)
21−import Control.Applicative ((<$>))
22−#endif
23−import Data.Csv
24−import Data.Proxy (Proxy (..))
25−import Data.Typeable (Typeable)
26−import Data.Vector (Vector, toList)
27−import GHC.Generics (Generic)
28−import qualified Network.HTTP.Media as M
29−import Servant.API (Accept (..), MimeRender (..),
30− MimeUnrender (..))
31−
32−data CSV' deriving (Typeable, Generic)
33−
34−type CSV = (CSV', DefaultDecodeOpts)
35−
36−-- | @text/csv;charset=utf-8@
37−instance Accept (CSV', a) where
38− contentType _ = "text" M.// "csv" M./: ("charset", "utf-8")
39−
40−-- * Encoding
41−
42−-- ** Instances
43−
44−-- | Encode with 'encodeByNameWith'. The 'Header' param is used for determining
45−-- the order of headers and fields.
46−instance ( ToNamedRecord a, EncodeOpts opt
47− ) => MimeRender (CSV', opt) (Header, [a]) where
48− mimeRender _ (hdr, vals) = encodeByNameWith (encodeOpts p) hdr vals
49− where p = Proxy :: Proxy opt
50−
51−-- | Encode with 'encodeDefaultOrderedByNameWith'
52−instance ( DefaultOrdered a, ToNamedRecord a, EncodeOpts opt
53− ) => MimeRender (CSV', opt) [a] where
54− mimeRender _ = encodeDefaultOrderedByNameWith (encodeOpts p)
55− where p = Proxy :: Proxy opt
56−
57−-- | Encode with 'encodeByNameWith'. The 'Header' param is used for determining
58−-- the order of headers and fields.
59−instance ( ToNamedRecord a, EncodeOpts opt
60− ) => MimeRender (CSV', opt) (Header, Vector a) where
61− mimeRender _ (hdr, vals) = encodeByNameWith (encodeOpts p) hdr (toList vals)
62− where p = Proxy :: Proxy opt
63−
64−-- | Encode with 'encodeDefaultOrderedByNameWith'
65−instance ( DefaultOrdered a, ToNamedRecord a, EncodeOpts opt
66− ) => MimeRender (CSV', opt) (Vector a) where
67− mimeRender _ = encodeDefaultOrderedByNameWith (encodeOpts p) . toList
68− where p = Proxy :: Proxy opt
69−
70−-- ** Encode Options
71−
72−class EncodeOpts a where
73− encodeOpts :: Proxy a -> EncodeOptions
74−
75−data DefaultEncodeOpts deriving (Typeable, Generic)
76−
77−instance EncodeOpts DefaultEncodeOpts where
78− encodeOpts _ = defaultEncodeOptions
79−
80−-- * Decoding
81−
82−-- ** Instances
83−
84−-- | Decode with 'decodeByNameWith'
85−instance ( FromNamedRecord a, DecodeOpts opt
86− ) => MimeUnrender (CSV', opt) (Header, [a]) where
87− mimeUnrender _ bs = fmap toList <$> decodeByNameWith (decodeOpts p) bs
88− where p = Proxy :: Proxy opt
89−
90−-- | Decode with 'decodeWith'. Assumes data has headers, which are stripped.
91−instance ( FromRecord a, DecodeOpts opt
92− ) => MimeUnrender (CSV', opt) [a] where
93− mimeUnrender _ bs = toList <$> decodeWith (decodeOpts p) HasHeader bs
94− where p = Proxy :: Proxy opt
95−
96−instance ( FromNamedRecord a, DecodeOpts opt
97− ) => MimeUnrender (CSV', opt) (Header, Vector a) where
98− mimeUnrender _ = decodeByNameWith (decodeOpts p)
99− where p = Proxy :: Proxy opt
100−
101−-- | Decode with 'decodeWith'. Assumes data has headers, which are stripped.
102−instance ( FromRecord a, DecodeOpts opt
103− ) => MimeUnrender (CSV', opt) (Vector a) where
104− mimeUnrender _ = decodeWith (decodeOpts p) HasHeader
105− where p = Proxy :: Proxy opt
106−
107−-- ** Decode Options
108−
109−class DecodeOpts a where
110− decodeOpts :: Proxy a -> DecodeOptions
111−
112−data DefaultDecodeOpts deriving (Typeable, Generic)
113−
114−instance DecodeOpts DefaultDecodeOpts where
115− decodeOpts _ = defaultDecodeOptions