{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Servant.CSV.Cassava ( module Servant.CSV.Cassava
, HasHeader(..)
) where
import Prelude ()
import Prelude.Compat
import Data.Csv
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' (hasHeader :: HasHeader) opt deriving (Typeable)
type CSV = CSV' 'HasHeader DefaultOpts
data (hasHeader :: HasHeader) where
:: SHasHeader 'HasHeader
:: SHasHeader 'NoHeader
class (hasHeader :: HasHeader) where :: SHasHeader hasHeader
instance SHasHeaderI 'HasHeader where shasheader :: SHasHeader 'HasHeader
shasheader = SHasHeader 'HasHeader
SHasHeader
instance SHasHeaderI 'NoHeader where shasheader :: SHasHeader 'NoHeader
shasheader = SHasHeader 'NoHeader
SNoHeader
shasheaderToBool :: SHasHeader hasHeader -> Bool
SHasHeader hasHeader
SHasHeader = Bool
True
shasheaderToBool SHasHeader hasHeader
SNoHeader = Bool
False
lowerSHasHeader :: SHasHeader hasHeader -> HasHeader
SHasHeader hasHeader
SHasHeader = HasHeader
HasHeader
lowerSHasHeader SHasHeader hasHeader
SNoHeader = HasHeader
NoHeader
data DefaultOpts deriving (Typeable, (forall x. DefaultOpts -> Rep DefaultOpts x)
-> (forall x. Rep DefaultOpts x -> DefaultOpts)
-> Generic DefaultOpts
forall x. Rep DefaultOpts x -> DefaultOpts
forall x. DefaultOpts -> Rep DefaultOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DefaultOpts x -> DefaultOpts
$cfrom :: forall x. DefaultOpts -> Rep DefaultOpts x
Generic)
data TabSeparatedOpts deriving (Typeable, (forall x. TabSeparatedOpts -> Rep TabSeparatedOpts x)
-> (forall x. Rep TabSeparatedOpts x -> TabSeparatedOpts)
-> Generic TabSeparatedOpts
forall x. Rep TabSeparatedOpts x -> TabSeparatedOpts
forall x. TabSeparatedOpts -> Rep TabSeparatedOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TabSeparatedOpts x -> TabSeparatedOpts
$cfrom :: forall x. TabSeparatedOpts -> Rep TabSeparatedOpts x
Generic)
instance EncodeOpts opt => Accept (CSV' hasHeader opt) where
contentType :: Proxy (CSV' hasHeader opt) -> MediaType
contentType Proxy (CSV' hasHeader opt)
_ = Proxy opt -> MediaType
forall opt. EncodeOpts opt => Proxy opt -> MediaType
csvContentType (Proxy opt
forall k (t :: k). Proxy t
Proxy :: Proxy opt)
instance ( ToNamedRecord a, EncodeOpts opt, SHasHeaderI hasHeader
) => MimeRender (CSV' hasHeader opt) (Header, [a]) where
mimeRender :: Proxy (CSV' hasHeader opt) -> (Header, [a]) -> ByteString
mimeRender Proxy (CSV' hasHeader opt)
_ (Header
hdr, [a]
vals) = EncodeOptions -> Header -> [a] -> ByteString
forall a.
ToNamedRecord a =>
EncodeOptions -> Header -> [a] -> ByteString
encodeByNameWith EncodeOptions
opts Header
hdr [a]
vals
where
opts :: EncodeOptions
opts = Proxy opt -> Proxy hasHeader -> EncodeOptions
forall opt (hasHeader :: HasHeader).
(EncodeOpts opt, SHasHeaderI hasHeader) =>
Proxy opt -> Proxy hasHeader -> EncodeOptions
encodeOpts' (Proxy opt
forall k (t :: k). Proxy t
Proxy :: Proxy opt) (Proxy hasHeader
forall k (t :: k). Proxy t
Proxy :: Proxy hasHeader)
class EncodeList (hasHeader :: HasHeader) a where
encodeList :: Proxy hasHeader -> EncodeOptions -> [a] -> ByteString
instance (DefaultOrdered a, ToNamedRecord a) => EncodeList 'HasHeader a where
encodeList :: Proxy 'HasHeader -> EncodeOptions -> [a] -> ByteString
encodeList Proxy 'HasHeader
_ EncodeOptions
opts [a]
vals = EncodeOptions -> [a] -> ByteString
forall a.
(DefaultOrdered a, ToNamedRecord a) =>
EncodeOptions -> [a] -> ByteString
encodeDefaultOrderedByNameWith EncodeOptions
opts { encIncludeHeader :: Bool
encIncludeHeader = Bool
True } [a]
vals
instance (ToRecord a) => EncodeList 'NoHeader a where
encodeList :: Proxy 'NoHeader -> EncodeOptions -> [a] -> ByteString
encodeList Proxy 'NoHeader
_ EncodeOptions
opts [a]
vals = EncodeOptions -> [a] -> ByteString
forall a. ToRecord a => EncodeOptions -> [a] -> ByteString
encodeWith EncodeOptions
opts { encIncludeHeader :: Bool
encIncludeHeader = Bool
False } [a]
vals
instance ( EncodeOpts opt, EncodeList hasHeader a
) => MimeRender (CSV' hasHeader opt) [a] where
mimeRender :: Proxy (CSV' hasHeader opt) -> [a] -> ByteString
mimeRender Proxy (CSV' hasHeader opt)
_ = Proxy hasHeader -> EncodeOptions -> [a] -> ByteString
forall (hasHeader :: HasHeader) a.
EncodeList hasHeader a =>
Proxy hasHeader -> EncodeOptions -> [a] -> ByteString
encodeList (Proxy hasHeader
forall k (t :: k). Proxy t
Proxy :: Proxy hasHeader) EncodeOptions
opts
where
opts :: EncodeOptions
opts = Proxy opt -> EncodeOptions
forall opt. EncodeOpts opt => Proxy opt -> EncodeOptions
encodeOpts (Proxy opt
forall k (t :: k). Proxy t
Proxy :: Proxy opt)
instance ( ToNamedRecord a, EncodeOpts opt, SHasHeaderI hasHeader
) => MimeRender (CSV' hasHeader opt) (Header, Vector a) where
mimeRender :: Proxy (CSV' hasHeader opt) -> (Header, Vector a) -> ByteString
mimeRender Proxy (CSV' hasHeader opt)
_ (Header
hdr, Vector a
vals) = EncodeOptions -> Header -> [a] -> ByteString
forall a.
ToNamedRecord a =>
EncodeOptions -> Header -> [a] -> ByteString
encodeByNameWith EncodeOptions
opts Header
hdr (Vector a -> [a]
forall a. Vector a -> [a]
toList Vector a
vals)
where
opts :: EncodeOptions
opts = Proxy opt -> Proxy hasHeader -> EncodeOptions
forall opt (hasHeader :: HasHeader).
(EncodeOpts opt, SHasHeaderI hasHeader) =>
Proxy opt -> Proxy hasHeader -> EncodeOptions
encodeOpts' (Proxy opt
forall k (t :: k). Proxy t
Proxy :: Proxy opt) (Proxy hasHeader
forall k (t :: k). Proxy t
Proxy :: Proxy hasHeader)
instance ( EncodeOpts opt, EncodeList hasHeader a
) => MimeRender (CSV' hasHeader opt) (Vector a) where
mimeRender :: Proxy (CSV' hasHeader opt) -> Vector a -> ByteString
mimeRender Proxy (CSV' hasHeader opt)
_ = Proxy hasHeader -> EncodeOptions -> [a] -> ByteString
forall (hasHeader :: HasHeader) a.
EncodeList hasHeader a =>
Proxy hasHeader -> EncodeOptions -> [a] -> ByteString
encodeList (Proxy hasHeader
forall k (t :: k). Proxy t
Proxy :: Proxy hasHeader) EncodeOptions
opts ([a] -> ByteString) -> (Vector a -> [a]) -> Vector a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Vector a -> [a]
toList
where
opts :: EncodeOptions
opts = Proxy opt -> EncodeOptions
forall opt. EncodeOpts opt => Proxy opt -> EncodeOptions
encodeOpts (Proxy opt
forall k (t :: k). Proxy t
Proxy :: Proxy opt)
class EncodeOpts opt where
encodeOpts :: Proxy opt -> EncodeOptions
decodeOpts :: Proxy opt -> DecodeOptions
decodeOpts Proxy opt
p = DecodeOptions :: Word8 -> DecodeOptions
DecodeOptions
{ decDelimiter :: Word8
decDelimiter = EncodeOptions -> Word8
encDelimiter EncodeOptions
e
}
where
e :: EncodeOptions
e = Proxy opt -> EncodeOptions
forall opt. EncodeOpts opt => Proxy opt -> EncodeOptions
encodeOpts Proxy opt
p
csvContentType :: Proxy opt -> M.MediaType
csvContentType Proxy opt
p = case EncodeOptions -> Word8
encDelimiter (Proxy opt -> EncodeOptions
forall opt. EncodeOpts opt => Proxy opt -> EncodeOptions
encodeOpts Proxy opt
p) of
Word8
9 -> ByteString
"text" ByteString -> ByteString -> MediaType
M.// ByteString
"tab-separated-values" MediaType -> (ByteString, ByteString) -> MediaType
M./: (ByteString
"charset", ByteString
"utf-8")
Word8
_ -> ByteString
"text" ByteString -> ByteString -> MediaType
M.// ByteString
"csv" MediaType -> (ByteString, ByteString) -> MediaType
M./: (ByteString
"charset", ByteString
"utf-8")
encodeOpts'
:: forall opt hasHeader. (EncodeOpts opt, SHasHeaderI hasHeader)
=> Proxy opt -> Proxy hasHeader -> EncodeOptions
encodeOpts' :: Proxy opt -> Proxy hasHeader -> EncodeOptions
encodeOpts' Proxy opt
p Proxy hasHeader
_ = (Proxy opt -> EncodeOptions
forall opt. EncodeOpts opt => Proxy opt -> EncodeOptions
encodeOpts Proxy opt
p)
{ encIncludeHeader :: Bool
encIncludeHeader = SHasHeader hasHeader -> Bool
forall (hasHeader :: HasHeader). SHasHeader hasHeader -> Bool
shasheaderToBool (SHasHeader hasHeader
forall (hasHeader :: HasHeader).
SHasHeaderI hasHeader =>
SHasHeader hasHeader
shasheader :: SHasHeader hasHeader)
}
instance EncodeOpts DefaultOpts where
encodeOpts :: Proxy DefaultOpts -> EncodeOptions
encodeOpts Proxy DefaultOpts
_ = EncodeOptions
defaultEncodeOptions
decodeOpts :: Proxy DefaultOpts -> DecodeOptions
decodeOpts Proxy DefaultOpts
_ = DecodeOptions
defaultDecodeOptions
instance EncodeOpts TabSeparatedOpts where
encodeOpts :: Proxy TabSeparatedOpts -> EncodeOptions
encodeOpts Proxy TabSeparatedOpts
_ = EncodeOptions
defaultEncodeOptions { encDelimiter :: Word8
encDelimiter = Word8
9 }
decodeOpts :: Proxy TabSeparatedOpts -> DecodeOptions
decodeOpts Proxy TabSeparatedOpts
_ = DecodeOptions
defaultDecodeOptions { decDelimiter :: Word8
decDelimiter = Word8
9 }
instance ( FromNamedRecord a, EncodeOpts opt
) => MimeUnrender (CSV' 'HasHeader opt) (Header, [a]) where
mimeUnrender :: Proxy (CSV' 'HasHeader opt)
-> ByteString -> Either String (Header, [a])
mimeUnrender Proxy (CSV' 'HasHeader opt)
_ ByteString
bs = (Vector a -> [a]) -> (Header, Vector a) -> (Header, [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> [a]
forall a. Vector a -> [a]
toList ((Header, Vector a) -> (Header, [a]))
-> Either String (Header, Vector a) -> Either String (Header, [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeOptions -> ByteString -> Either String (Header, Vector a)
forall a.
FromNamedRecord a =>
DecodeOptions -> ByteString -> Either String (Header, Vector a)
decodeByNameWith (Proxy opt -> DecodeOptions
forall opt. EncodeOpts opt => Proxy opt -> DecodeOptions
decodeOpts Proxy opt
p) ByteString
bs
where p :: Proxy opt
p = Proxy opt
forall k (t :: k). Proxy t
Proxy :: Proxy opt
instance ( FromRecord a, EncodeOpts opt, SHasHeaderI hasHeader
) => MimeUnrender (CSV' hasHeader opt) [a] where
mimeUnrender :: Proxy (CSV' hasHeader opt) -> ByteString -> Either String [a]
mimeUnrender Proxy (CSV' hasHeader opt)
_ = (Vector a -> [a]) -> Either String (Vector a) -> Either String [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector a -> [a]
forall a. Vector a -> [a]
toList (Either String (Vector a) -> Either String [a])
-> (ByteString -> Either String (Vector a))
-> ByteString
-> Either String [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeOptions
-> HasHeader -> ByteString -> Either String (Vector a)
forall a.
FromRecord a =>
DecodeOptions
-> HasHeader -> ByteString -> Either String (Vector a)
decodeWith (Proxy opt -> DecodeOptions
forall opt. EncodeOpts opt => Proxy opt -> DecodeOptions
decodeOpts Proxy opt
p) (SHasHeader hasHeader -> HasHeader
forall (hasHeader :: HasHeader). SHasHeader hasHeader -> HasHeader
lowerSHasHeader SHasHeader hasHeader
sh)
where
p :: Proxy opt
p = Proxy opt
forall k (t :: k). Proxy t
Proxy :: Proxy opt
sh :: SHasHeader hasHeader
sh = SHasHeader hasHeader
forall (hasHeader :: HasHeader).
SHasHeaderI hasHeader =>
SHasHeader hasHeader
shasheader :: SHasHeader hasHeader
instance ( FromNamedRecord a, EncodeOpts opt
) => MimeUnrender (CSV' 'HasHeader opt) (Header, Vector a) where
mimeUnrender :: Proxy (CSV' 'HasHeader opt)
-> ByteString -> Either String (Header, Vector a)
mimeUnrender Proxy (CSV' 'HasHeader opt)
_ = DecodeOptions -> ByteString -> Either String (Header, Vector a)
forall a.
FromNamedRecord a =>
DecodeOptions -> ByteString -> Either String (Header, Vector a)
decodeByNameWith (Proxy opt -> DecodeOptions
forall opt. EncodeOpts opt => Proxy opt -> DecodeOptions
decodeOpts Proxy opt
p)
where p :: Proxy opt
p = Proxy opt
forall k (t :: k). Proxy t
Proxy :: Proxy opt
instance ( FromRecord a, EncodeOpts opt, SHasHeaderI hasHeader
) => MimeUnrender (CSV' hasHeader opt) (Vector a) where
mimeUnrender :: Proxy (CSV' hasHeader opt)
-> ByteString -> Either String (Vector a)
mimeUnrender Proxy (CSV' hasHeader opt)
_ = DecodeOptions
-> HasHeader -> ByteString -> Either String (Vector a)
forall a.
FromRecord a =>
DecodeOptions
-> HasHeader -> ByteString -> Either String (Vector a)
decodeWith (Proxy opt -> DecodeOptions
forall opt. EncodeOpts opt => Proxy opt -> DecodeOptions
decodeOpts Proxy opt
p) (SHasHeader hasHeader -> HasHeader
forall (hasHeader :: HasHeader). SHasHeader hasHeader -> HasHeader
lowerSHasHeader SHasHeader hasHeader
sh)
where
p :: Proxy opt
p = Proxy opt
forall k (t :: k). Proxy t
Proxy :: Proxy opt
sh :: SHasHeader hasHeader
sh = SHasHeader hasHeader
forall (hasHeader :: HasHeader).
SHasHeaderI hasHeader =>
SHasHeader hasHeader
shasheader :: SHasHeader hasHeader