{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE KindSignatures        #-}
{-# 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' '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 ( 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

-- | '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 'HasHeader
shasheader = SHasHeader 'HasHeader
SHasHeader
instance SHasHeaderI 'NoHeader  where shasheader :: SHasHeader 'NoHeader
shasheader = SHasHeader 'NoHeader
SNoHeader

shasheaderToBool :: SHasHeader hasHeader -> Bool
shasheaderToBool :: SHasHeader hasHeader -> Bool
shasheaderToBool SHasHeader hasHeader
SHasHeader = Bool
True
shasheaderToBool SHasHeader hasHeader
SNoHeader  = Bool
False

lowerSHasHeader :: SHasHeader hasHeader -> HasHeader
lowerSHasHeader :: SHasHeader hasHeader -> HasHeader
lowerSHasHeader SHasHeader hasHeader
SHasHeader = HasHeader
HasHeader
lowerSHasHeader SHasHeader hasHeader
SNoHeader  = HasHeader
NoHeader

-- | Default options, instances providing 'defaultDecodeOptions' and 'defaultEncodeOptions', and content type @text/csv;charset=utf-8@
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)

-- | Options that work for tab delimited data, with content type @text/tab-separated-values;charset=utf-8@
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)

-- | Content type can be determined to coincide with encode opts.
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)

-- * Encoding

-- ** Instances

-- | Encode with 'encodeByNameWith'. The 'Header' param is used for determining
-- the order of headers and fields.
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)

-- | 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 :: 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

-- | 'encodeWith'
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)

-- | Encode with 'encodeByNameWith'. The 'Header' param is used for determining
-- the order of headers and fields.
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)

-- ** Encode/Decode Options

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
        -- ord '\t' = 9
        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
    -- ord '\t' = 9
    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 }


-- * Decoding

-- ** Instances

-- | Decode with 'decodeByNameWith'.
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

-- | Decode with 'decodeWith'.
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

-- | Decode with 'decodeWith'.
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