{-# OPTIONS_HADDOCK prune not-home #-}

{- |
Copyright   : (c) 2022 Tim Emiola
Maintainer  : Tim Emiola <adetokunbo@emio.la>
SPDX-License-Identifier: BSD3
-}
module KeyedVals.Handle.Codec.HttpApiData (
  -- * newtypes
  HttpApiDataOf (..),
) where

import KeyedVals.Handle.Codec (DecodeKV (..), EncodeKV (..))
import Web.HttpApiData (
  FromHttpApiData (..),
  ToHttpApiData (..),
 )


{- | A deriving-via helper type for types that implement 'DecodeKV' and 'EncodeKV'
 using 'FromHttpApiData' and 'ToHttpApiData' type classes.
-}
newtype HttpApiDataOf a = HttpApiDataOf {forall a. HttpApiDataOf a -> a
fromHttpApiDataOf :: a}


instance FromHttpApiData a => DecodeKV (HttpApiDataOf a) where
  decodeKV :: Val -> Either Text (HttpApiDataOf a)
decodeKV = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> HttpApiDataOf a
HttpApiDataOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromHttpApiData a => Val -> Either Text a
parseHeader


instance ToHttpApiData a => EncodeKV (HttpApiDataOf a) where
  encodeKV :: HttpApiDataOf a -> Val
encodeKV = forall a. ToHttpApiData a => a -> Val
toHeader forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HttpApiDataOf a -> a
fromHttpApiDataOf