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