{-|
Module      : WebApi.Param
License     : BSD3
Stability   : experimental

Param serialization and deserialization. 'ToParam' and 'EncodeParam' are responsible for serialization part.
'EncodeParam' converts the value into a wire format. 'ToParam' is responsible for creating (nested) key value pairs, which can be then used to deserialize to original type. For example

@
encodeParam 5 == "5"

data Foo = Foo { foo :: Int }
         deriving (Show, Eq, Generic)

data Bar = Bar { bar :: Foo }
         deriving (Show, Eq, Generic)

instance ToParam Foo 'FormParam
instance ToParam Bar 'FormParam

toParam (Proxy :: Proxy 'FormParam) "" (Bar (Foo 5)) == [("bar.foo","5")]
@

Deserialization works analogously, 'FromParam' and 'DecodeParam' are counterparts to 'ToParam' and 'EncodeParam' respectively. Generic instances are provided for all of them. This means that the user only need to derive Generic in their type, and provide instance with an empty body. Note that for headers 'FromHeader' and 'ToHeader' is being used in place of 'FromParam' and 'ToParam'. Nesting is not supported for headers.
-}

{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DefaultSignatures     #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
module WebApi.Param
       ( -- * Serialization
         ToParam (..)
       , EncodeParam (..)
       , ToHeader (..)
       , SerializedData
       , toQueryParam
       , toFormParam
       , toFileParam
       , toPathParam
       , toCookie
       , toNonNestedParam

       -- * Deserialization
       , FromParam (..)
       , DecodeParam (..)
       , FromHeader (..)
       , Validation (..)
       , ParamErr (..)
       , ParamErrToApiErr (..)
       , DeSerializedData
       , fromQueryParam
       , fromFormParam
       , fromFileParam
       , fromCookie
       , lookupParam
       , fromNonNestedParam

       -- * Wrappers
       , CookieInfo (..)
       , JsonOf (..)
       , OptValue (..)
       , FileInfo (..)
       , NonNested (..)

       -- * Helpers
       , ParamK (..)
       , ParamSettings, fieldModifier
       , filePath
       , nest
       , defaultParamSettings
       -- * Generic (De)Serialization fn
       , genericToQueryParam
       , genericFromQueryParam
       , genericToFormParam
       , genericFromFormParam
       , genericToFileParam
       , genericFromFileParam
       , genericToPathParam
       , genericFromPathParam
       , genericToCookie
       , genericFromCookie
       ) where


import           Blaze.ByteString.Builder           (toByteString)
import           Blaze.ByteString.Builder.Char.Utf8 (fromChar)
import           Data.Aeson                         (FromJSON (..), ToJSON (..), (.:))
import qualified Data.Aeson                         as A
import           Data.ByteString                    as SB hiding (index,
                                                           isPrefixOf)
import qualified Data.ByteString                    as SB (isPrefixOf)
import           Data.ByteString.Builder            (byteString, char7,
                                                     toLazyByteString)
import           Data.ByteString.Char8              as ASCII (pack, readInteger,
                                                              split, unpack)
import           Data.ByteString.Lazy               (toStrict)
import qualified Data.ByteString.Lex.Fractional     as LexF
import           Data.ByteString.Lex.Integral
import           Data.CaseInsensitive               as CI
import           Data.Foldable                      as Fold (foldl')
import           Data.Int
import qualified Data.List                          as L (find)
import           Data.Monoid                        ((<>))
import           Data.Proxy
import qualified Data.Text                          as T (Text, pack, uncons)
import           Data.Text.Encoding                 (decodeUtf8', encodeUtf8)
import           Data.Time.Calendar                 (Day)
import           Data.Time.Clock                    (UTCTime, DiffTime)
import           Data.Time.LocalTime                (LocalTime, TimeOfDay)
import           Data.Time.Format                   (FormatTime,
                                                     defaultTimeLocale,
                                                     formatTime, parseTimeM)
import           Data.Trie                          as Trie
import           Data.Typeable
import           Data.Vector                        (Vector)
import qualified Data.Vector                        as V
import           Data.Word
import           GHC.Generics
import           Network.HTTP.Types
import           Network.HTTP.Types                 as Http (Header, QueryItem)
import qualified Network.Wai.Parse                  as Wai (FileInfo (..))
import           Control.Applicative

-- | A type for holding a file.
newtype FileInfo = FileInfo { fileInfo :: Wai.FileInfo FilePath }
                 deriving (Eq, Show)

-- | Obtain the file path from 'FileInfo'.
filePath :: FileInfo -> FilePath
filePath = Wai.fileContent . fileInfo

-- | (Kind) Describes the various types of Param.
data ParamK = QueryParam
            | FormParam
            | FileParam
            | PathParam
            | Cookie

-- | Use this type if a key is required but the value is optional.
newtype OptValue a = OptValue { toMaybe :: Maybe a}
                   deriving (Show, Read, Eq, Ord)

-- | Serializing 'JsonOf' will produce a JSON representation of the value contained within. This is useful if params has to be sent as JSON.
newtype JsonOf a = JsonOf {getValue :: a}
                    deriving (Show, Read, Eq, Ord)

data Unit = Unit
          deriving (Show, Eq)

instance ToJSON a => ToJSON (JsonOf a) where
  toJSON (JsonOf a) = toJSON a

instance FromJSON a => FromJSON (JsonOf a) where
  parseJSON jval = JsonOf `fmap` parseJSON jval

data CookieInfo a = CookieInfo
  { cookieValue    :: a
  , cookiePath     :: Maybe ByteString
  , cookieExpires  :: Maybe UTCTime
  , cookieMaxAge   :: Maybe DiffTime
  , cookieDomain   :: Maybe ByteString
  , cookieHttpOnly :: Maybe Bool
  , cookieSecure   :: Maybe Bool
  }

defCookieInfo :: a -> CookieInfo a
defCookieInfo val = CookieInfo
  { cookieValue    = val
  , cookiePath     = Nothing
  , cookieExpires  = Nothing
  , cookieMaxAge   = Nothing
  , cookieDomain   = Nothing
  , cookieHttpOnly = Nothing
  , cookieSecure   = Nothing
  }

-- | Define result of serialization of a type of kind 'ParamK'.
type family SerializedData (par :: ParamK) where
  SerializedData 'QueryParam = Http.QueryItem
  SerializedData 'FormParam  = (ByteString, ByteString)
  SerializedData 'FileParam  = (ByteString, Wai.FileInfo FilePath)
  SerializedData 'PathParam  = ByteString
  SerializedData 'Cookie     = (ByteString, CookieInfo ByteString)

-- | Define result of deserialization of a type of kind 'ParamK'.
type family DeSerializedData (par :: ParamK) where
  DeSerializedData 'QueryParam = Maybe ByteString
  DeSerializedData 'FormParam  = ByteString
  DeSerializedData 'FileParam  = Wai.FileInfo FilePath
  DeSerializedData 'PathParam  = ByteString
  DeSerializedData 'Cookie     = ByteString

-- | Datatype representing the parsed result of params.
newtype Validation e a = Validation { getValidation :: Either e a }
                       deriving (Eq, Functor, Show)

instance Monoid e => Applicative (Validation e) where
  pure = Validation . Right
  Validation a <*> Validation b = Validation $
    case a of
      Right va -> fmap va b
      Left ea -> either (Left . mappend ea) (const $ Left ea) b

-- | Serialize a type into query params.
toQueryParam :: (ToParam 'QueryParam a) => a -> Query
toQueryParam = toParam (Proxy :: Proxy 'QueryParam) ""

-- | Serialize a type into form params.
toFormParam :: (ToParam 'FormParam a) => a -> [(ByteString, ByteString)]
toFormParam = toParam (Proxy :: Proxy 'FormParam) ""

-- | Serialize a type into file params.
toFileParam :: (ToParam 'FileParam a) => a -> [(ByteString, Wai.FileInfo FilePath)]
toFileParam = toParam (Proxy :: Proxy 'FileParam) ""

-- | Serialize a type into path params.
toPathParam :: (ToParam 'PathParam a) => a -> [ByteString]
toPathParam = toParam (Proxy :: Proxy 'PathParam) ""

-- | Serialize a type into cookie.
toCookie :: (ToParam 'Cookie a) => a -> [(ByteString, CookieInfo ByteString)]
toCookie = toParam (Proxy :: Proxy 'Cookie) ""

-- | (Try to) Deserialize a type from query params.
fromQueryParam :: (FromParam 'QueryParam a) => Query -> Validation [ParamErr] a
fromQueryParam par = fromParam (Proxy :: Proxy 'QueryParam) "" $ Trie.fromList par

-- | (Try to) Deserialize a type from form params.
fromFormParam :: (FromParam 'FormParam a) => [(ByteString, ByteString)] -> Validation [ParamErr] a
fromFormParam par = fromParam (Proxy :: Proxy 'FormParam) "" $ Trie.fromList par

-- | (Try to) Deserialize a type from file params.
fromFileParam :: (FromParam 'FileParam a) => [(ByteString, Wai.FileInfo FilePath)] -> Validation [ParamErr] a
fromFileParam par = fromParam (Proxy :: Proxy 'FileParam) "" $ Trie.fromList par

-- | (Try to) Deserialize a type from cookie.
fromCookie :: (FromParam 'Cookie a) => [(ByteString, ByteString)] -> Validation [ParamErr] a
fromCookie par = fromParam (Proxy :: Proxy 'Cookie) "" $ Trie.fromList par

genericToQueryParam :: (Generic a, GToParam (Rep a) 'QueryParam) => ParamSettings -> ByteString -> a -> [Http.QueryItem]
genericToQueryParam opts pfx = gtoParam (Proxy :: Proxy 'QueryParam) pfx (ParamAcc 0 False) opts . from

genericFromQueryParam :: (Generic a, GFromParam (Rep a) 'QueryParam) => ParamSettings -> ByteString -> Trie (Maybe ByteString) -> Validation [ParamErr] a
genericFromQueryParam opts pfx = (fmap to) . gfromParam (Proxy :: Proxy 'QueryParam) pfx (ParamAcc 0 False) opts

genericToFormParam :: (Generic a, GToParam (Rep a) 'FormParam) => ParamSettings -> ByteString -> a -> [(ByteString, ByteString)]
genericToFormParam opts pfx = gtoParam (Proxy :: Proxy 'FormParam) pfx (ParamAcc 0 False) opts . from

genericFromFormParam :: (Generic a, GFromParam (Rep a) 'FormParam) => ParamSettings -> ByteString -> Trie ByteString -> Validation [ParamErr] a
genericFromFormParam opts pfx = (fmap to) . gfromParam (Proxy :: Proxy 'FormParam) pfx (ParamAcc 0 False) opts

genericToFileParam :: (Generic a, GToParam (Rep a) 'FileParam) => ParamSettings -> ByteString -> a -> [(ByteString, Wai.FileInfo FilePath)]
genericToFileParam opts pfx = gtoParam (Proxy :: Proxy 'FileParam) pfx (ParamAcc 0 False) opts . from

genericFromFileParam :: (Generic a, GFromParam (Rep a) 'FileParam) => ParamSettings -> ByteString -> Trie (Wai.FileInfo FilePath) -> Validation [ParamErr] a
genericFromFileParam opts pfx = (fmap to) . gfromParam (Proxy :: Proxy 'FileParam) pfx (ParamAcc 0 False) opts

genericToPathParam :: (Generic a, GToParam (Rep a) 'PathParam) => ParamSettings -> ByteString -> a -> [ByteString]
genericToPathParam opts pfx = gtoParam (Proxy :: Proxy 'PathParam) pfx (ParamAcc 0 False) opts . from

genericFromPathParam :: (Generic a, GFromParam (Rep a) 'PathParam) => ParamSettings -> ByteString -> Trie ByteString -> Validation [ParamErr] a
genericFromPathParam opts pfx = (fmap to) . gfromParam (Proxy :: Proxy 'PathParam) pfx (ParamAcc 0 False) opts

genericToCookie :: (Generic a, GToParam (Rep a) 'Cookie) => ParamSettings -> ByteString -> a -> [(ByteString, CookieInfo ByteString)]
genericToCookie opts pfx = gtoParam (Proxy :: Proxy 'Cookie) pfx (ParamAcc 0 False) opts . from

genericFromCookie :: (Generic a, GFromParam (Rep a) 'Cookie) => ParamSettings -> ByteString -> Trie ByteString -> Validation [ParamErr] a
genericFromCookie opts pfx = (fmap to) . gfromParam (Proxy :: Proxy 'Cookie) pfx (ParamAcc 0 False) opts

-- | Serialize a type to a given type of kind 'ParamK'.
class ToParam (parK :: ParamK) a where
  toParam :: Proxy (parK :: ParamK) -> ByteString -> a -> [SerializedData parK]

  default toParam :: (Generic a, GToParam (Rep a) parK) => Proxy (parK :: ParamK) -> ByteString -> a -> [SerializedData parK]
  toParam pt pfx = gtoParam pt pfx (ParamAcc 0 False) defaultParamSettings . from

-- | (Try to) Deserialize a type from a given type of kind 'ParamK'.
class FromParam (parK :: ParamK) a where
  fromParam :: Proxy (parK :: ParamK) -> ByteString -> Trie (DeSerializedData parK) -> Validation [ParamErr] a

  default fromParam :: (Generic a, GFromParam (Rep a) parK) => Proxy (parK :: ParamK) -> ByteString -> Trie (DeSerializedData parK) -> Validation [ParamErr] a
  fromParam pt pfx = (fmap to) . gfromParam pt pfx (ParamAcc 0 False) defaultParamSettings

-- | Serialize a type to 'ByteString'.
class EncodeParam (t :: *) where
  encodeParam :: t -> ByteString

  default encodeParam :: (Generic t, GHttpParam (Rep t)) => t -> ByteString
  encodeParam = gEncodeParam . from

-- | (Try to) Deserialize a type from 'ByteString'.
class DecodeParam (t :: *) where
  decodeParam :: ByteString -> Maybe t

  default decodeParam :: (Generic t, GHttpParam (Rep t)) => ByteString -> Maybe t
  decodeParam = (fmap to) . gDecodeParam

instance EncodeParam ByteString where
  encodeParam   = id

instance DecodeParam ByteString where
  decodeParam = Just

instance EncodeParam Int where
  encodeParam i = ASCII.pack $ show i

instance DecodeParam Int where
  decodeParam str = case readSigned readDecimal str of
    Just (v, "") -> Just v
    _            -> Nothing

instance EncodeParam Int8 where
  encodeParam i = ASCII.pack $ show i

instance DecodeParam Int8 where
  decodeParam str = case readSigned readDecimal str of
    Just (v, "") -> Just v
    _            -> Nothing

instance EncodeParam Int16 where
  encodeParam i = ASCII.pack $ show i

instance DecodeParam Int16 where
  decodeParam str = case readSigned readDecimal str of
    Just (v, "") -> Just v
    _            -> Nothing

instance EncodeParam Int32 where
  encodeParam i = ASCII.pack $ show i

instance DecodeParam Int32 where
  decodeParam str = case readSigned readDecimal str of
    Just (v, "") -> Just v
    _            -> Nothing

instance EncodeParam Int64 where
  encodeParam i = ASCII.pack $ show i

instance DecodeParam Int64 where
  decodeParam str = case readSigned readDecimal str of
    Just (v, "") -> Just v
    _            -> Nothing

instance EncodeParam Word where
  encodeParam i = ASCII.pack $ show i

instance DecodeParam Word where
  decodeParam str = case readDecimal str of
    Just (v, "") -> Just v
    _            -> Nothing

instance EncodeParam Word8 where
  encodeParam i = ASCII.pack $ show i

instance DecodeParam Word8 where
  decodeParam str = case readDecimal str of
    Just (v, "") -> Just v
    _            -> Nothing

instance EncodeParam Word16 where
  encodeParam i = ASCII.pack $ show i

instance DecodeParam Word16 where
  decodeParam str = case readDecimal str of
    Just (v, "") -> Just v
    _            -> Nothing

instance EncodeParam Word32 where
  encodeParam i = ASCII.pack $ show i

instance DecodeParam Word32 where
  decodeParam str = case readDecimal str of
    Just (v, "") -> Just v
    _            -> Nothing

instance EncodeParam Word64 where
  encodeParam i = ASCII.pack $ show i

instance DecodeParam Word64 where
  decodeParam str = case readDecimal str of
    Just (v, "") -> Just v
    _            -> Nothing

instance EncodeParam Float where
  encodeParam d = ASCII.pack $ show d

instance DecodeParam Float where
  decodeParam str = case readSigned LexF.readExponential str of
    Just (v, "") -> Just v
    _            -> Nothing

instance EncodeParam Double where
  encodeParam d = ASCII.pack $ show d

instance DecodeParam Double where
  decodeParam str = case readSigned LexF.readExponential str of
    Just (v, "") -> Just v
    _            -> Nothing

instance EncodeParam Char where
  encodeParam       = toByteString . fromChar

instance DecodeParam Char where
  decodeParam str = case decodeUtf8' str of
    Right txt -> fmap fst (T.uncons txt)
    Left _    -> Nothing

instance EncodeParam T.Text where
  encodeParam = encodeUtf8

instance DecodeParam T.Text where
  decodeParam str = case decodeUtf8' str of
    Right txt -> Just txt
    Left _    -> Nothing

instance EncodeParam Day where
  encodeParam day = ASCII.pack $ show day

instance DecodeParam Day where
  decodeParam str = case reads $ ASCII.unpack str of
    [(a,"")] -> Just a
    _        -> Nothing

instance EncodeParam UTCTime where
  encodeParam t = ASCII.pack $ formatTime defaultTimeLocale format t
    where
      format = "%FT%T." ++ formatSubseconds t ++ "Z"

instance DecodeParam UTCTime where
  decodeParam str = case parseTimeM True defaultTimeLocale "%FT%T%QZ" (ASCII.unpack str) of
    Just d -> Just d
    _      -> Nothing

instance EncodeParam LocalTime where
  encodeParam t = ASCII.pack $ formatTime defaultTimeLocale format t
    where
      format = "%FT%T"

instance DecodeParam LocalTime where
  decodeParam str = case parseTimeM True defaultTimeLocale "%FT%T" (ASCII.unpack str) of
    Just d -> Just d
    _      -> Nothing

instance EncodeParam TimeOfDay where
  encodeParam t = ASCII.pack $ formatTime defaultTimeLocale "%T" t

instance DecodeParam TimeOfDay where
  decodeParam str = case parseTimeM True defaultTimeLocale "%T" (ASCII.unpack str) of
    Just d -> Just d
    _      -> Nothing

formatSubseconds :: (FormatTime t) => t -> String
formatSubseconds = formatTime defaultTimeLocale "%q"

instance EncodeParam Unit where
  encodeParam _ = "()"

instance DecodeParam Unit where
  decodeParam str = case str of
    "()" -> Just Unit
    _    -> Nothing

instance (EncodeParam a, EncodeParam b) => EncodeParam (a,b) where
  encodeParam (a,b) = toStrict $ toLazyByteString $ byteString (encodeParam a)
                                                  <> char7 ','
                                                  <> byteString (encodeParam b)

instance (DecodeParam a, DecodeParam b) => DecodeParam (a,b) where
  decodeParam str = case ASCII.split ',' str of
    [str1, str2] -> (,) <$> decodeParam str1 <*> decodeParam str2
    _            -> Nothing

instance EncodeParam Bool where
  encodeParam i = ASCII.pack $ show i

instance DecodeParam Bool where
  decodeParam str | str == "True"  = Just True
  decodeParam str | str == "False" = Just False
                    | otherwise     = Nothing

instance EncodeParam Integer where
  encodeParam i = ASCII.pack $ show i

instance DecodeParam Integer where
  decodeParam str = case ASCII.readInteger str of
    Just (i, "") -> Just i
    _            -> Nothing

instance (ToJSON a) => EncodeParam (JsonOf a) where
  encodeParam (JsonOf a) = toStrict $ A.encode a

instance (FromJSON a) => DecodeParam (JsonOf a) where
  decodeParam str = A.decodeStrict' str

class GHttpParam f where
  gEncodeParam   :: f a -> ByteString
  gDecodeParam :: ByteString -> Maybe (f a)

instance (GHttpParam f) => GHttpParam (D1 c f) where
  gEncodeParam (M1 c) = gEncodeParam c
  gDecodeParam str  = M1 <$> (gDecodeParam str)

instance (GHttpParam f, GHttpParam g) => GHttpParam (f :+: g) where
  gEncodeParam (L1 l) = gEncodeParam l
  gEncodeParam (R1 r) = gEncodeParam r
  gDecodeParam str  = case L1 <$> gDecodeParam str of
    l1@(Just _) -> l1
    _           -> R1 <$> gDecodeParam str

instance (GHttpParam f, Constructor c) => GHttpParam (C1 c f) where
  gEncodeParam con@(M1 c) = const (ASCII.pack $ conName con) $ gEncodeParam c
  gDecodeParam str = if (ASCII.pack $ conName (undefined :: (C1 c f) a)) == str
                       then M1 <$> gDecodeParam str
                       else Nothing

instance GHttpParam U1 where
  gEncodeParam U1    = error "Panic! Unreacheable code @ GHttpParam U1"
  gDecodeParam _   = Just U1

-- | Use this type if for serialization \/ deserialization nesting is not required. The type contained within most likely requires 'EncodeParam' \/ 'DecodeParam'.
newtype NonNested a = NonNested { getNonNestedParam :: a }
                    deriving (Show, Eq, Read)

-- | Serialize a type without nesting.
toNonNestedParam :: (ToParam parK (NonNested a)) => Proxy (parK :: ParamK) -> ByteString -> a -> [SerializedData parK]
toNonNestedParam par pfx a = toParam par pfx (NonNested a)

-- | (Try to) Deserialize a type without nesting.
fromNonNestedParam :: (FromParam parK (NonNested a)) => Proxy (parK :: ParamK) -> ByteString -> Trie (DeSerializedData parK) -> Validation [ParamErr] a
fromNonNestedParam par pfx kvs = getNonNestedParam <$> fromParam par pfx kvs

instance (EncodeParam a) => ToParam 'QueryParam (NonNested a) where
  toParam _ pfx (NonNested val) = [(pfx, Just $ encodeParam val)]

instance (EncodeParam a) => ToParam 'FormParam (NonNested a) where
  toParam _ pfx (NonNested val) = [(pfx, encodeParam val)]

instance (EncodeParam a) => ToParam 'Cookie (NonNested a) where
  toParam _ pfx (NonNested val) = [(pfx, defCookieInfo $ encodeParam val)]

instance (DecodeParam a, Typeable a) => FromParam 'QueryParam (NonNested a) where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
         Just v -> Validation $ Right $ NonNested v
         _      -> Validation $ Left [ParseErr key $ T.pack $ "Unable to cast to " ++ (show $ typeOf (Proxy :: Proxy a))]
   _ ->  Validation $ Left [NotFound key]

instance (DecodeParam a, Typeable a) => FromParam 'FormParam (NonNested a) where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right $ NonNested v
         _      -> Validation $ Left [ParseErr key $ T.pack $ "Unable to cast to " ++ (show $ typeOf (Proxy :: Proxy a))]
   _ ->  Validation $ Left [NotFound key]

instance (DecodeParam a, Typeable a) => FromParam 'Cookie (NonNested a) where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right $ NonNested v
         _      -> Validation $ Left [ParseErr key $ T.pack $ "Unable to cast to " ++ (show $ typeOf (Proxy :: Proxy a))]
   _ ->  Validation $ Left [NotFound key]

instance ToParam parK () where
  toParam _ _ _ = []

instance ToHeader () where
  toHeader _ = []

instance ToParam 'QueryParam Unit where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Unit where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Unit where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Int where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Int where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Int where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Int8 where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Int8 where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Int8 where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Int16 where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Int16 where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Int16 where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Int32 where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Int32 where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Int32 where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Int64 where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Int64 where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Int64 where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Word where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Word where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Word where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Word8 where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Word8 where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Word8 where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Word16 where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Word16 where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Word16 where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Word32 where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Word32 where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Word32 where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Word64 where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Word64 where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Word64 where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Integer where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Integer where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Integer where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Bool where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Bool where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Bool where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Double where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Double where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Double where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Float where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Float where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Float where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam Char where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Char where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Char where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam T.Text where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam T.Text where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie T.Text where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam ByteString where
  toParam _ pfx val = [(pfx, Just $ val)]

instance ToParam 'FormParam ByteString where
  toParam _ pfx val = [(pfx, val)]

instance ToParam 'Cookie ByteString where
  toParam _ pfx val = [(pfx, defCookieInfo $ val)]

instance ToParam 'QueryParam Day where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam Day where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie Day where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam UTCTime where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam UTCTime where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie UTCTime where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam LocalTime where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam LocalTime where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie LocalTime where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam 'QueryParam TimeOfDay where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance ToParam 'FormParam TimeOfDay where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance ToParam 'Cookie TimeOfDay where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance (ToParam 'Cookie a) => ToParam 'Cookie (CookieInfo a) where
  toParam p pfx val = Prelude.map (\(k, v) -> (k, val { cookieValue = cookieValue v })) $ toParam p pfx (cookieValue val)

instance (EncodeParam a) => ToParam 'QueryParam (OptValue a) where
  toParam _ pfx (OptValue (Just val)) = [(pfx, Just $ encodeParam val)]
  toParam _ pfx (OptValue Nothing)    = [(pfx, Nothing)]

instance (EncodeParam a) => ToParam 'FormParam (OptValue a) where
  toParam _ pfx (OptValue (Just val)) = [(pfx, encodeParam val)]
  toParam _ _ (OptValue Nothing)     = []

instance (EncodeParam a) => ToParam 'Cookie (OptValue a) where
  toParam _ pfx (OptValue (Just val)) = [(pfx, defCookieInfo $ encodeParam val)]
  toParam _ _ (OptValue Nothing)     = []

instance (ToJSON a) => ToParam 'QueryParam (JsonOf a) where
  toParam _ pfx val = [(pfx, Just $ encodeParam val)]

instance (ToJSON a) => ToParam 'FormParam (JsonOf a) where
  toParam _ pfx val = [(pfx, encodeParam val)]

instance (ToJSON a) => ToParam 'Cookie (JsonOf a) where
  toParam _ pfx val = [(pfx, defCookieInfo $ encodeParam val)]

instance ToParam par a => ToParam par (Maybe a) where
  toParam pt pfx (Just val) = toParam pt pfx val
  toParam _ _ Nothing      = []

instance (ToParam par a, ToParam par b) => ToParam par (Either a b) where
  toParam pt pfx (Left e)  = toParam pt (pfx `nest` "Left") e
  toParam pt pfx (Right v) = toParam pt (pfx `nest` "Right") v

instance ToParam par a => ToParam par [a] where
  toParam pt pfx vals = Prelude.concatMap (\(ix, v) -> toParam pt (pfx `nest` (ASCII.pack $ show ix)) v) $ Prelude.zip [(0 :: Word)..] vals

instance ToParam par a => ToParam par (Vector a) where
  toParam pt pfx vals = toParam pt pfx (V.toList vals)

instance FromParam parK () where
  fromParam _ _ _ = pure ()

instance FromHeader () where
  fromHeader _ = pure ()

instance FromParam 'QueryParam Unit where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to NullaryConstructor"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Unit where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to NullaryConstructor"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Unit where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to NullaryConstructor"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Bool where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Bool"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Bool where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Bool"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Bool where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Bool"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Char where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Char"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Char where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Char"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Char where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Char"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam UTCTime where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to UTCTime (ISO-8601)"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam UTCTime where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to UTCTime (ISO-8601)"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie UTCTime where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to UTCTime (ISO-8601)"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam LocalTime where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to LocalTime (ISO-8601)"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam LocalTime where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to LocalTime (ISO-8601)"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie LocalTime where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to LocalTime (ISO-8601)"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam TimeOfDay where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to TimeOfDay (ISO-8601)"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam TimeOfDay where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to TimeOfDay (ISO-8601)"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie TimeOfDay where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to TimeOfDay (ISO-8601)"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Int where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Int where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Int where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Int8 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int8"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Int8 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int8"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Int8 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int8"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Int16 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int16"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Int16 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int16"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Int16 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int16"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Int32 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int32"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Int32 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int32"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Int32 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int32"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Int64 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int64"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Int64 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int64"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Int64 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int64"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Integer where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int64"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Integer where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int64"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Integer where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Int64"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Word where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Word"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Word where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Word"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Word where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Word"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Word8 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Word8"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Word8 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Word8"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Word8 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Word8"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Word16 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Word16"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Word16 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Word16"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Word16 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Word16"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Word32 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Word32"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Word32 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Word32"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Word32 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Word32"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Word64 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Word64"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Word64 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Word64"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Word64 where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Word64"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Double where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Double"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Double where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Double"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Double where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Double"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Float where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Float"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Float where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Float"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Float where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to Float"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam ByteString where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to ByteString"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam ByteString where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to ByteString"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie ByteString where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
         Just v -> Validation $ Right v
         _      -> Validation $ Left [ParseErr key "Unable to cast to ByteString"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam par a => FromParam par (Maybe a) where
  fromParam pt key kvs = case Trie.null kvs' of
    True  ->  Validation $ Right Nothing
    False -> case (fromParam pt key kvs' :: Validation [ParamErr] a) of
      Validation (Right val) -> Validation $ Right $ Just val
      Validation (Left errs) -> Validation $ Left errs
    where kvs' = submap key kvs

instance (FromParam par a, FromParam par b) => FromParam par (Either a b) where
  fromParam pt key kvs = case Trie.null kvsL of
    True -> case Trie.null kvsR of
      True -> Validation $ Left [ParseErr key "Unable to cast to Either"]
      False -> Right <$> fromParam pt keyR kvsR
    False -> Left <$> fromParam pt keyL kvsL
    where kvsL = submap keyL kvs
          kvsR = submap keyR kvs
          keyL = (key `nest` "Left")
          keyR = (key `nest` "Right")

instance FromParam 'QueryParam T.Text where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Text"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam T.Text where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Text"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie T.Text where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Text"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'QueryParam Day where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Day"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'FormParam Day where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Day"]
   _ ->  Validation $ Left [NotFound key]

instance FromParam 'Cookie Day where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right v
     _      -> Validation $ Left [ParseErr key "Unable to cast to Day"]
   _ ->  Validation $ Left [NotFound key]

instance (FromParam par a) => FromParam par [a] where
  fromParam pt key kvs = case Trie.null kvs' of
    True  ->  Validation $ Right []
    False ->
      let pars = Prelude.map (\(nkey, kv) -> fromParam pt nkey kv :: Validation [ParamErr] a) kvitems
      in Prelude.reverse <$> Fold.foldl' accRes (Validation $ Right []) pars
    where kvs' = submap key kvs
          kvitems = Prelude.takeWhile (not . Prelude.null . snd)  (Prelude.map (\ix ->
            let ixkey = key `nest` (ASCII.pack $ show ix)
            in (ixkey, submap ixkey kvs')) [(0 :: Word) .. 2000])
          accRes acc elemt = case (acc, elemt) of
            (Validation (Right as), Validation (Right e)) -> Validation $ Right (e:as)
            (Validation (Left as), Validation (Right _)) -> Validation $ Left as
            (Validation (Right _), Validation (Left es)) -> Validation $ Left es
            (Validation (Left as), Validation (Left es)) -> Validation $ Left (es ++ as)

instance (FromParam par a) => FromParam par (Vector a) where
  fromParam pt key kvs = case fromParam pt key kvs of
    Validation (Right v)  -> Validation $ Right (V.fromList v)
    Validation (Left err) -> Validation (Left err)

instance (DecodeParam a) => FromParam 'QueryParam (OptValue a) where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just (Just par) -> case decodeParam par of
     Just v     -> Validation $ Right $ OptValue $ Just v
     _          -> Validation $ Left [ParseErr key "Unable to cast to OptValue"]
   Just Nothing -> Validation $ Right $ OptValue Nothing
   _            -> Validation $ Left [NotFound key]

instance (DecodeParam a) => FromParam 'FormParam (OptValue a) where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right $ OptValue $ Just v
     _      -> Validation $ Left [ParseErr key "Unable to cast to OptValue"]
   _        -> Validation $ Left [NotFound key]

instance (DecodeParam a) => FromParam 'Cookie (OptValue a) where
  fromParam pt key kvs = case lookupParam pt key kvs of
   Just par -> case decodeParam par of
     Just v -> Validation $ Right $ OptValue $ Just v
     _      -> Validation $ Left [ParseErr key "Unable to cast to OptValue"]
   _        -> Validation $ Left [NotFound key]

instance (FromParam 'Cookie a) => FromParam 'Cookie (CookieInfo a) where
  fromParam pt key kvs = case (fromParam pt key kvs :: Validation [ParamErr] a) of
    Validation (Right val) -> Validation $ Right $ defCookieInfo val
    Validation (Left errs) -> Validation $ Left errs


instance ToParam 'FileParam FileInfo where
  toParam _ key (FileInfo val) = [(key, val)]

instance FromParam 'FileParam FileInfo where
  fromParam pt key kvs = case lookupParam pt key kvs of
    Just par -> Validation $ Right (FileInfo par)
    Nothing  -> Validation $ Left [NotFound key]

instance ToParam 'PathParam ByteString where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Int where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Int8 where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Int16 where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Int32 where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Int64 where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Word where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Word8 where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Word16 where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Word32 where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Word64 where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Float where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Double where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Char where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam T.Text where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Day where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam UTCTime where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Bool where
  toParam _ _ v = [encodeParam v]

instance ToParam 'PathParam Integer where
  toParam _ _ v = [encodeParam v]

instance (ToJSON a) => ToParam 'PathParam (JsonOf a) where
  toParam _ _ v = [encodeParam v]

instance ( EncodeParam a
         , EncodeParam b
         ) => ToParam 'PathParam (a, b) where
  toParam _ _ (a, b) = [encodeParam a, encodeParam b]

instance ( EncodeParam a
         , EncodeParam b
         , EncodeParam c
         ) => ToParam 'PathParam (a, b, c) where
  toParam _ _ (a, b, c) = [ encodeParam a
                          , encodeParam b
                          , encodeParam c
                          ]

instance ( EncodeParam a
         , EncodeParam b
         , EncodeParam c
         , EncodeParam d
         ) => ToParam 'PathParam (a, b, c, d) where
  toParam _ _ (a, b, c, d)
    = [ encodeParam a
      , encodeParam b
      , encodeParam c
      , encodeParam d
      ]

instance ( EncodeParam a
         , EncodeParam b
         , EncodeParam c
         , EncodeParam d
         , EncodeParam e
         ) => ToParam 'PathParam (a, b, c, d, e) where
  toParam _ _ (a, b, c, d, e)
    = [ encodeParam a
      , encodeParam b
      , encodeParam c
      , encodeParam d
      , encodeParam e
      ]

instance ( EncodeParam a
         , EncodeParam b
         , EncodeParam c
         , EncodeParam d
         , EncodeParam e
         , EncodeParam f
         ) => ToParam 'PathParam (a, b, c, d, e, f) where
  toParam _ _ (a, b, c, d, e, f)
    = [ encodeParam a
      , encodeParam b
      , encodeParam c
      , encodeParam d
      , encodeParam e
      , encodeParam f
      ]

instance ( EncodeParam a
         , EncodeParam b
         , EncodeParam c
         , EncodeParam d
         , EncodeParam e
         , EncodeParam f
         , EncodeParam g
         , EncodeParam h
         ) => ToParam 'PathParam (a, b, c, d, e, f, g, h) where
  toParam _ _ (a, b, c, d, e, f, g, h)
    = [ encodeParam a
      , encodeParam b
      , encodeParam c
      , encodeParam d
      , encodeParam e
      , encodeParam f
      , encodeParam g
      , encodeParam h
      ]

instance ( EncodeParam a
         , EncodeParam b
         , EncodeParam c
         , EncodeParam d
         , EncodeParam e
         , EncodeParam f
         , EncodeParam g
         , EncodeParam h
         , EncodeParam i
         ) => ToParam 'PathParam (a, b, c, d, e, f, g, h, i) where
  toParam _ _ (a, b, c, d, e, f, g, h, i)
    = [ encodeParam a
      , encodeParam b
      , encodeParam c
      , encodeParam d
      , encodeParam e
      , encodeParam f
      , encodeParam g
      , encodeParam h
      , encodeParam i
      ]

instance ( EncodeParam a
         , EncodeParam b
         , EncodeParam c
         , EncodeParam d
         , EncodeParam e
         , EncodeParam f
         , EncodeParam g
         , EncodeParam h
         , EncodeParam i
         , EncodeParam j
         ) => ToParam 'PathParam (a, b, c, d, e, f, g, h, i, j) where
  toParam _ _ (a, b, c, d, e, f, g, h, i, j)
    = [ encodeParam a
      , encodeParam b
      , encodeParam c
      , encodeParam d
      , encodeParam e
      , encodeParam f
      , encodeParam g
      , encodeParam h
      , encodeParam i
      , encodeParam j
      ]

-- | Errors that occured during deserialization.
data ParamErr = NotFound ByteString -- ^ The key was not found.
              | ParseErr ByteString T.Text -- ^ A parse error occured while deserializing the type.
                deriving (Show, Eq)

utf8DecodeError :: String -> String -> a
utf8DecodeError src msg = error $ "Error decoding Bytes into UTF8 string at: " ++ src ++ " Message: " ++ msg

instance ToJSON ParamErr where
  toJSON (NotFound bs) = case decodeUtf8' bs of
    Left ex   -> utf8DecodeError "ToJSON ParamErr" (show ex)
    Right bs' -> A.object ["NotFound" A..= bs']
  toJSON (ParseErr bs msg) = case decodeUtf8' bs of
    Left ex -> utf8DecodeError "ToJSON ParamErr" (show ex)
    Right bs' -> A.object ["ParseErr" A..= [bs', msg]]

instance FromJSON ParamErr where
  parseJSON = A.withObject "ParamErr" $ \obj ->
    (NotFound . encodeUtf8 <$> obj .: "NotFound")
    <|> (mkParseErr <$> obj .: "ParseErr")
    where mkParseErr [key, msg] = ParseErr (encodeUtf8 key) msg
          mkParseErr vals = error $ "Error parsing ParseErr as JSON. ParseErr accepts exactly two arg but recieved " ++ (show $ Prelude.length vals)


-- | Convert the 'ParamErr' that occured during deserialization into 'ApiErr' type which can then be put in 'Response'.
class ParamErrToApiErr apiErr where
  toApiErr :: [ParamErr] -> apiErr

instance ParamErrToApiErr () where
  toApiErr = const ()

instance ParamErrToApiErr T.Text where
  toApiErr errs = T.pack (show errs)

instance ParamErrToApiErr A.Value where
  toApiErr errs = toJSON errs

-- | Nest the key with a prefix.
--
-- > nest "pfx" "key" == "pfx.key"
-- > nest "" "key" == "key"
nest :: ByteString -> ByteString -> ByteString
nest s1 s2 | SB.null s1 = s2
           | otherwise = SB.concat [s1, ".", s2]

-- | Lookup a value from the 'Trie' using the given key.
lookupParam :: Proxy (parK :: ParamK) -> ByteString -> Trie (DeSerializedData parK) -> Maybe (DeSerializedData parK)
lookupParam _ key kvs = Trie.lookup key kvs

data ParamAcc = ParamAcc { index :: Int, isSum :: Bool }
              deriving (Show, Eq)

data ParamSettings = ParamSettings
  { fieldModifier :: (ByteString -> ByteString)
  }

defaultParamSettings :: ParamSettings
defaultParamSettings = ParamSettings {fieldModifier = id}

-- | Serialize a type to the header params
class ToHeader a where
  toHeader :: a -> [Http.Header]

  default toHeader :: (Generic a, GToHeader (Rep a)) => a -> [Http.Header]
  toHeader = gtoHeader "" (ParamAcc 0 False) defaultParamSettings . from

-- | (Try to) Deserialize a type from the header params
class FromHeader a where
  fromHeader :: [Http.Header] -> Validation [ParamErr] a

  default fromHeader :: (Generic a, GFromHeader (Rep a)) => [Http.Header] -> Validation [ParamErr] a
  fromHeader = (fmap to) . gfromHeader "" (ParamAcc 0 False) defaultParamSettings

class GToHeader f where
  gtoHeader :: ByteString -> ParamAcc -> ParamSettings -> f a -> [Http.Header]

instance (GToHeader f, GToHeader g) => GToHeader (f :+: g) where
  gtoHeader pfx pa psett (L1 x) = gtoHeader pfx (pa { isSum = True }) psett x
  gtoHeader pfx pa psett (R1 y) = gtoHeader pfx (pa { isSum = True }) psett y

instance (GToHeader f, GToHeader g) => GToHeader (f :*: g) where
  gtoHeader pfx pa psett (x :*: y) = gtoHeader pfx pa psett x ++ gtoHeader pfx (pa { index = index pa + 1 }) psett y

instance (EncodeParam c) => GToHeader (K1 i c) where
  gtoHeader pfx _ _ (K1 x) = [(mk pfx, encodeParam x)]

instance (GToHeader f, Constructor t) => GToHeader (M1 C t f) where
  gtoHeader pfx pa psett con@(M1 x) = case isSum pa of
    True  -> gtoHeader (pfx `nest` ASCII.pack (conName con)) (pa { index = 0 }) psett x
    False -> gtoHeader pfx (pa { index = 0 }) psett x

instance (GToHeader f) => GToHeader (M1 D t f) where
  gtoHeader pfx pa psett (M1 x) = gtoHeader pfx pa psett x

instance (GToHeader f, Selector t) => GToHeader (M1 S t f) where
  gtoHeader pfx pa psett m@(M1 x) = let fldN = ASCII.pack (selName m)
                                    in case fldN of
                                      "" -> gtoHeader (pfx `nest` numberedFld pa) pa psett x
                                      _  -> gtoHeader (pfx `nest` fldN) pa psett x

instance GToHeader U1 where
  gtoHeader pfx _ _ _ = [(mk pfx, encodeParam Unit)]

class GFromHeader f where
  gfromHeader :: ByteString -> ParamAcc -> ParamSettings -> [Http.Header] -> Validation [ParamErr] (f a)

instance (GFromHeader f, GFromHeader g) => GFromHeader (f :*: g) where
  gfromHeader pfx pa psett kvs = (:*:) <$> gfromHeader pfx pa psett kvs
                                 <*> gfromHeader pfx (pa { index = index pa + 1 }) psett kvs

instance (GFromHeader f, GFromHeader g) => GFromHeader (f :+: g) where
  gfromHeader pfx pa psett kvs = case L1 <$> gfromHeader pfx (pa { isSum = True }) psett kvs of
    l1@(Validation (Right _)) -> l1
    Validation (Left []) -> R1 <$> gfromHeader pfx (pa { isSum = True }) psett kvs
    l1 -> l1

instance (GFromHeader f, Constructor t) => GFromHeader (M1 C t f) where
  gfromHeader pfx pa psett kvs =
    let conN = ASCII.pack (conName (undefined :: (M1 C t f) a))
    in case isSum pa of
      True -> case isMemberH (pfx `nest` conN) kvs of
        True -> M1 <$> gfromHeader (pfx `nest` conN) pa psett kvs
        False -> Validation $ Left []
      False -> M1 <$> gfromHeader pfx pa psett kvs

instance (GFromHeader f, Datatype t) => GFromHeader (M1 D t f) where
  gfromHeader pfx pa psett kvs = case M1 <$> gfromHeader pfx pa psett kvs of
    Validation (Left []) -> Validation (Left [ParseErr pfx ("Unable to cast to SumType: " <> dtN)])
    v                    -> v

    where dtN = T.pack $ datatypeName (undefined :: (M1 D t f) a)

instance (GFromHeader f, Selector t) => GFromHeader (M1 S t f) where
  gfromHeader pfx pa psett kvs = let fldN = (ASCII.pack $ (selName (undefined :: (M1 S t f) a)))
                                 in case fldN of
                                   "" -> M1 <$> gfromHeader (pfx `nest` numberedFld pa) pa psett kvs
                                   _  -> M1 <$> gfromHeader (pfx `nest` fldN) pa psett kvs

instance (DecodeParam c) => GFromHeader (K1 i c) where
  gfromHeader key _ _ kvs = case lookupH key kvs of
    Just v -> case decodeParam v of
      Just v' -> Validation (Right $ K1 v') -- K1 <$> fromParam pt pfx kvs
      Nothing -> Validation $ Left [ParseErr key "Unable to cast to <Type>"]
    _ ->  Validation $ Left [NotFound key]

instance GFromHeader U1 where
  gfromHeader key _ _ kvs = case lookupH key kvs of
    Just v -> case (decodeParam v :: Maybe Unit) of
      Just _ -> Validation (Right U1)
      Nothing -> Validation $ Left [ParseErr key "Unable to cast to <NullaryType>"]
    _ ->  Validation $ Left [NotFound key]

class GFromParam f (parK :: ParamK) where
  gfromParam :: Proxy (parK :: ParamK) -> ByteString -> ParamAcc -> ParamSettings -> Trie (DeSerializedData parK) -> Validation [ParamErr] (f a)

instance (GFromParam f parK, GFromParam g parK) => GFromParam (f :*: g) parK where
  gfromParam pt pfx pa psett kvs = (:*:) <$> gfromParam pt pfx pa psett kvs
                                         <*> gfromParam pt pfx (pa { index = index pa + 1 }) psett kvs

instance (GFromParam f parK, GFromParam g parK) => GFromParam (f :+: g) parK where
  gfromParam pt pfx pa psett kvs = case L1 <$> gfromParam pt pfx (pa { isSum = True }) psett kvs of
    l1@(Validation (Right _)) -> l1
    Validation (Left []) -> R1 <$> gfromParam pt pfx (pa { isSum = True }) psett kvs
    l1 -> l1

instance (GFromParam f parK, Constructor t) => GFromParam (M1 C t f) parK where
  gfromParam pt pfx pa psett kvs =
    let conN = ASCII.pack (conName (undefined :: (M1 C t f) a))
    in case isSum pa of
      True -> case Trie.null $ submap (pfx `nest` conN) kvs of
        False  -> M1 <$> gfromParam pt (pfx `nest` conN) pa psett kvs
        True -> Validation $ Left []
      False -> M1 <$> gfromParam pt pfx pa psett kvs

instance (GFromParam f parK, Datatype t) => GFromParam (M1 D t f) parK where
  gfromParam pt pfx pa psett kvs = case M1 <$> gfromParam pt pfx pa psett kvs of
    Validation (Left []) -> Validation (Left [ParseErr pfx ("Unable to cast to SumType: " <> dtN)])
    v                    -> v

    where dtN = T.pack $ datatypeName (undefined :: (M1 D t f) a)

instance (GFromParam f parK, Selector t, f ~ (K1 i c)) => GFromParam (M1 S t f) parK where
  gfromParam pt pfx pa psett kvs = let fldN = (ASCII.pack $ (selName (undefined :: (M1 S t f) a)))
                                   in case fldN of
                                     "" -> M1 <$> gfromParam pt (pfx `nest` numberedFld pa) pa psett (submap pfx kvs)
                                     _  -> M1 <$> gfromParam pt (pfx `nest` fieldModifier psett fldN) pa psett (submap pfx kvs)

instance (FromParam parK c) => GFromParam (K1 i c) parK where
  gfromParam pt pfx _ _ kvs = K1 <$> fromParam pt pfx kvs

instance (FromParam parK Unit) => GFromParam U1 parK where
  gfromParam pt key _ _ kvs = const U1 <$> (fromParam pt key kvs :: Validation [ParamErr] Unit)

class GToParam f (parK :: ParamK) where
  gtoParam :: Proxy (parK :: ParamK) -> ByteString -> ParamAcc -> ParamSettings -> f a -> [SerializedData parK]

instance (GToParam f parK, GToParam g parK) => GToParam (f :*: g) parK where
  gtoParam pt pfx pa psett (x :*: y) = gtoParam pt pfx pa psett x ++ gtoParam pt pfx (pa { index = index pa + 1 }) psett y

instance (GToParam f parK, GToParam g parK) => GToParam (f :+: g) parK where
  gtoParam pt pfx pa psett(L1 x) = gtoParam pt pfx (pa { isSum = True }) psett x
  gtoParam pt pfx pa psett (R1 y) = gtoParam pt pfx (pa { isSum = True }) psett y

instance (ToParam parK c) => GToParam (K1 i c) parK where
  gtoParam pt pfx _ _ (K1 x) = toParam pt pfx x

instance (GToParam f parK, Constructor t) => GToParam (M1 C t f) parK where
  gtoParam pt pfx pa psett con@(M1 x) = case isSum pa of
    True  -> gtoParam pt (pfx `nest` ASCII.pack (conName con)) (pa { index = 0 }) psett x
    False -> gtoParam pt pfx (pa { index = 0 }) psett x

instance (GToParam f parK) => GToParam (M1 D t f) parK where
  gtoParam pt pfx pa psett (M1 x) = gtoParam pt pfx pa psett x

instance (GToParam f parK, Selector t, f ~ (K1 i c)) => GToParam (M1 S t f) parK where
  gtoParam pt pfx pa psett  m@(M1 x) = let fldN = ASCII.pack (selName m)
                                       in case fldN of
                                         "" -> gtoParam pt (pfx `nest` numberedFld pa) pa psett x
                                         _  -> gtoParam pt (pfx `nest` (fieldModifier psett fldN)) pa psett x

instance (ToParam parK Unit) => GToParam U1 parK where
  gtoParam pt pfx _ _ _ = toParam pt pfx Unit

numberedFld :: ParamAcc -> ByteString
numberedFld pa = ASCII.pack $ show (index pa)

isMemberH :: ByteString -> [Header] -> Bool
isMemberH k = maybe False (const True) . lookupH' isPrefixOf k

lookupH :: ByteString -> [Header] -> Maybe ByteString
lookupH = lookupH' (==)

lookupH' :: (CI ByteString -> CI ByteString -> Bool) -> ByteString -> [Header] -> Maybe ByteString
lookupH' f k = fmap snd . L.find ((f $ mk k) . fst)

isPrefixOf :: CI ByteString -> CI ByteString -> Bool
isPrefixOf n h = foldedCase n `SB.isPrefixOf` foldedCase h