{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoFieldSelectors #-}

-- | You will need to import this module if you are planning to define
-- or use a 'Encoding' other than the defaults provided by this library.
module Wai.CryptoCookie.Encoding
   ( Encoding (..)
   , aeson
   , binary
   ) where

import Data.Aeson qualified as Ae
import Data.Binary qualified as Bin
import Data.ByteString.Lazy qualified as BL
import Data.Kind (Type)

-- | How to encode and decode a value of type @a@ into a 'BL.ByteString'.
data Encoding (a :: Type) = Encoding
   { forall a. Encoding a -> a -> ByteString
encode :: a -> BL.ByteString
   , forall a. Encoding a -> ByteString -> Maybe a
decode :: BL.ByteString -> Maybe a
   }

-- | Encode and decode use 'Bin.Binary' from the @binary@ library.
binary :: (Bin.Binary a) => Encoding a
binary :: forall a. Binary a => Encoding a
binary =
   Encoding
      { $sel:encode:Encoding :: a -> ByteString
encode = a -> ByteString
forall a. Binary a => a -> ByteString
Bin.encode
      , $sel:decode:Encoding :: ByteString -> Maybe a
decode = \ByteString
bl -> case ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
Bin.decodeOrFail ByteString
bl of
         Right (ByteString
_, ByteOffset
_, a
a) -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
         Left (ByteString, ByteOffset, String)
_ -> Maybe a
forall a. Maybe a
Nothing
      }

-- | Encode and decode use 'Ae.ToJSON' and 'Ae.FromJSON' from
-- the @aeson@ library.
aeson :: (Ae.FromJSON a, Ae.ToJSON a) => Encoding a
aeson :: forall a. (FromJSON a, ToJSON a) => Encoding a
aeson = Encoding{$sel:encode:Encoding :: a -> ByteString
encode = a -> ByteString
forall a. ToJSON a => a -> ByteString
Ae.encode, $sel:decode:Encoding :: ByteString -> Maybe a
decode = ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
Ae.decode}