{-# OPTIONS_GHC -fno-warn-orphans #-}

module Redis.Codec where

import qualified Data.Aeson as Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy
import qualified Data.Text.Encoding
import qualified Redis.Internal as Internal
import qualified Prelude

data Codec a = Codec
  { Codec a -> Encoder a
codecEncoder :: Encoder a,
    Codec a -> Decoder a
codecDecoder :: Decoder a
  }

type Encoder a = a -> ByteString

type Decoder a = ByteString -> Result Internal.Error a

jsonCodec :: (Aeson.FromJSON a, Aeson.ToJSON a) => Codec a
jsonCodec :: Codec a
jsonCodec = Encoder a -> Decoder a -> Codec a
forall a. Encoder a -> Decoder a -> Codec a
Codec Encoder a
forall a. ToJSON a => Encoder a
jsonEncoder Decoder a
forall a. FromJSON a => Decoder a
jsonDecoder

jsonEncoder :: Aeson.ToJSON a => Encoder a
jsonEncoder :: Encoder a
jsonEncoder = a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (a -> ByteString) -> (ByteString -> ByteString) -> Encoder a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> ByteString -> ByteString
Data.ByteString.Lazy.toStrict

jsonDecoder :: Aeson.FromJSON a => Decoder a
jsonDecoder :: Decoder a
jsonDecoder ByteString
byteString =
  case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
byteString of
    Prelude.Right a
decoded -> a -> Result Error a
forall error value. value -> Result error value
Ok a
decoded
    Prelude.Left String
err ->
      Text -> Error
Internal.DecodingError (String -> Text
Text.fromList String
err)
        Error -> (Error -> Result Error a) -> Result Error a
forall a b. a -> (a -> b) -> b
|> Error -> Result Error a
forall error value. error -> Result error value
Err

byteStringCodec :: Codec ByteString
byteStringCodec :: Codec ByteString
byteStringCodec = Encoder ByteString -> Decoder ByteString -> Codec ByteString
forall a. Encoder a -> Decoder a -> Codec a
Codec Encoder ByteString
forall a. a -> a
identity Decoder ByteString
forall error value. value -> Result error value
Ok

textCodec :: Codec Text
textCodec :: Codec Text
textCodec = Encoder Text -> Decoder Text -> Codec Text
forall a. Encoder a -> Decoder a -> Codec a
Codec Encoder Text
Data.Text.Encoding.encodeUtf8 (ByteString -> Text
Data.Text.Encoding.decodeUtf8 (ByteString -> Text) -> (Text -> Result Error Text) -> Decoder Text
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Text -> Result Error Text
forall error value. value -> Result error value
Ok)