{-# LANGUAGE MultiParamTypeClasses #-}

-- | This module provides access to the \"base64\" binary-to-text encoding as defined by [RFC 4648](https://tools.ietf.org/html/rfc4648).
--
-- This module is intended to be imported @qualified@, e.g.
--
-- > import qualified Codec.Base64 as B64
--
-- If you want to explictly specify which 'Encode' and 'Decode' typeclass instance is used, you can use plain Haskell2010 type-signature annotations, e.g.
--
-- >>> (B64.encode :: ByteString -> Text) "\x00\x00"
-- "AAA="
--
-- >>> (B64.decode :: Text -> Either String ShortByteString) "NDoyMA=="
-- Right "4:20"
--
-- Alternatively, starting with GHC 8.0.1, you can also use the [TypeApplications language extension](https://downloads.haskell.org/~ghc/8.4.1/docs/html/users_guide/glasgow_exts.html#ghc-flag--XTypeApplications):
--
-- >>> B64.encode @ShortByteString @Text "\xFF\239"
-- "/+8="
--
-- >>> B64.decode @Text @ShortByteString "/+8="
-- Right "\255\239"
--
-- @since 0.1.0.0
module Codec.Base64
    ( Encode(encode)
    , Decode(decode)
    ) where

import qualified Data.ByteString.Base64       as B64
import qualified Data.ByteString.Base64.Lazy  as B64.L

import qualified Data.ByteString              as BS
import qualified Data.ByteString.Builder      as BB
import qualified Data.ByteString.Lazy         as BS.L
import qualified Data.ByteString.Short        as SBS

import qualified Data.Text                    as T (Text)
import qualified Data.Text.Encoding           as T (decodeLatin1, encodeUtf8)
import qualified Data.Text.Lazy               as T.L (Text, fromStrict)
import qualified Data.Text.Lazy.Builder       as TB (Builder, fromLazyText,
                                                     fromText, toLazyText)
import qualified Data.Text.Lazy.Encoding      as T.L (decodeLatin1, encodeUtf8)

import           Internal

-- primitives

decodeBs2Bs :: BS.ByteString -> Either String BS.ByteString
decodeBs2Bs :: ByteString -> Either String ByteString
decodeBs2Bs = ByteString -> Either String ByteString
B64.decode

decodeBsL2BsL :: BS.L.ByteString -> Either String BS.L.ByteString
decodeBsL2BsL :: ByteString -> Either String ByteString
decodeBsL2BsL = ByteString -> Either String ByteString
B64.L.decode

encodeBs2Bs :: BS.ByteString -> BS.ByteString
encodeBs2Bs :: ByteString -> ByteString
encodeBs2Bs = ByteString -> ByteString
B64.encode

encodeBsL2BsL :: BS.L.ByteString -> BS.L.ByteString
encodeBsL2BsL :: ByteString -> ByteString
encodeBsL2BsL = ByteString -> ByteString
B64.L.encode

----------------------------------------------------------------------------
-- exposed API

-- | Typeclass representing types for which a binary-to-text @base64@ encoding is defined
class Encode bin txt where
  -- | Encode binary data using @base64@ text encoding
  encode :: bin -> txt

-- | Typeclass representing types for which a text-to-binary @base64@ decoding is defined
class Decode txt bin where
  -- | Decode binary data encoded textually as @base64@
  decode :: txt -> Either String bin

----------------------------------------------------------------------------
-- instance matrix

---- lazy BS -> *

-- PRIMITIVE
instance Encode BS.L.ByteString BS.L.ByteString where
  encode :: ByteString -> ByteString
encode = ByteString -> ByteString
encodeBsL2BsL

instance Encode BS.L.ByteString BS.ByteString where
  encode :: ByteString -> ByteString
encode = ByteString -> ByteString
bsToStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode

instance Encode BS.L.ByteString BB.Builder where
  encode :: ByteString -> Builder
encode = ByteString -> Builder
BB.lazyByteString (ByteString -> Builder)
-> (ByteString -> ByteString) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode

instance Encode BS.L.ByteString SBS.ShortByteString where
  encode :: ByteString -> ShortByteString
encode = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (ByteString -> ByteString) -> ByteString -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode

instance Encode BS.L.ByteString T.Text where
  encode :: ByteString -> Text
encode = ByteString -> Text
T.decodeLatin1 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode

instance Encode BS.L.ByteString T.L.Text where
  encode :: ByteString -> Text
encode = ByteString -> Text
T.L.decodeLatin1 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode

instance Encode BS.L.ByteString TB.Builder where
  encode :: ByteString -> Builder
encode = Text -> Builder
TB.fromLazyText (Text -> Builder) -> (ByteString -> Text) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall bin txt. Encode bin txt => bin -> txt
encode

---- strict BS  -> *

-- PRIMITIVE
instance Encode BS.ByteString BS.ByteString where
  encode :: ByteString -> ByteString
encode = ByteString -> ByteString
encodeBs2Bs

instance Encode BS.ByteString BS.L.ByteString where
  encode :: ByteString -> ByteString
encode = ByteString -> ByteString
bsFromStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode

instance Encode BS.ByteString BB.Builder where
  encode :: ByteString -> Builder
encode = ByteString -> Builder
BB.byteString (ByteString -> Builder)
-> (ByteString -> ByteString) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode

instance Encode BS.ByteString SBS.ShortByteString where
  encode :: ByteString -> ShortByteString
encode = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (ByteString -> ByteString) -> ByteString -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode

instance Encode BS.ByteString T.Text where
  encode :: ByteString -> Text
encode = ByteString -> Text
T.decodeLatin1 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode

instance Encode BS.ByteString T.L.Text where
  encode :: ByteString -> Text
encode = Text -> Text
T.L.fromStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeLatin1 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode

instance Encode BS.ByteString TB.Builder where
  encode :: ByteString -> Builder
encode = Text -> Builder
TB.fromText (Text -> Builder) -> (ByteString -> Text) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall bin txt. Encode bin txt => bin -> txt
encode

---- short BS  -> *

instance Encode SBS.ShortByteString SBS.ShortByteString where
  encode :: ShortByteString -> ShortByteString
encode = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (ShortByteString -> ByteString)
-> ShortByteString
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode (ByteString -> ByteString)
-> (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort

instance Encode SBS.ShortByteString BS.ByteString where
  encode :: ShortByteString -> ByteString
encode = ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode (ByteString -> ByteString)
-> (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort

instance Encode SBS.ShortByteString BS.L.ByteString where
  encode :: ShortByteString -> ByteString
encode = ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode (ByteString -> ByteString)
-> (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort

instance Encode SBS.ShortByteString BB.Builder where
  encode :: ShortByteString -> Builder
encode = ByteString -> Builder
forall bin txt. Encode bin txt => bin -> txt
encode (ByteString -> Builder)
-> (ShortByteString -> ByteString) -> ShortByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort

instance Encode SBS.ShortByteString T.Text where
  encode :: ShortByteString -> Text
encode = ByteString -> Text
T.decodeLatin1 (ByteString -> Text)
-> (ShortByteString -> ByteString) -> ShortByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode

instance Encode SBS.ShortByteString T.L.Text where
  encode :: ShortByteString -> Text
encode = Text -> Text
T.L.fromStrict (Text -> Text)
-> (ShortByteString -> Text) -> ShortByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeLatin1 (ByteString -> Text)
-> (ShortByteString -> ByteString) -> ShortByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode

instance Encode SBS.ShortByteString TB.Builder where
  encode :: ShortByteString -> Builder
encode = Text -> Builder
TB.fromText (Text -> Builder)
-> (ShortByteString -> Text) -> ShortByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Text
forall bin txt. Encode bin txt => bin -> txt
encode

---- BB  -> *

instance Encode BB.Builder SBS.ShortByteString where
  encode :: Builder -> ShortByteString
encode = ByteString -> ShortByteString
forall bin txt. Encode bin txt => bin -> txt
encode (ByteString -> ShortByteString)
-> (Builder -> ByteString) -> Builder -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString

instance Encode BB.Builder BB.Builder where
  encode :: Builder -> Builder
encode = ByteString -> Builder
forall bin txt. Encode bin txt => bin -> txt
encode (ByteString -> Builder)
-> (Builder -> ByteString) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString

instance Encode BB.Builder BS.ByteString where
  encode :: Builder -> ByteString
encode = ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString

instance Encode BB.Builder BS.L.ByteString where
  encode :: Builder -> ByteString
encode = ByteString -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString

instance Encode BB.Builder T.Text where
  encode :: Builder -> Text
encode = ByteString -> Text
T.decodeLatin1 (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode

instance Encode BB.Builder T.L.Text where
  encode :: Builder -> Text
encode = ByteString -> Text
T.L.decodeLatin1 (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
forall bin txt. Encode bin txt => bin -> txt
encode

instance Encode BB.Builder TB.Builder where
  encode :: Builder -> Builder
encode = Text -> Builder
TB.fromLazyText (Text -> Builder) -> (Builder -> Text) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
forall bin txt. Encode bin txt => bin -> txt
encode

------------------------------------------------------------------------------

-- PRIMITIVE
instance Decode BS.ByteString BS.ByteString where
  decode :: ByteString -> Either String ByteString
decode = ByteString -> Either String ByteString
decodeBs2Bs

instance Decode BS.ByteString BS.L.ByteString where
  decode :: ByteString -> Either String ByteString
decode = (ByteString -> ByteString)
-> Either String ByteString -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
bsFromStrict (Either String ByteString -> Either String ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode

instance Decode BS.ByteString SBS.ShortByteString where
  decode :: ByteString -> Either String ShortByteString
decode = (ByteString -> ShortByteString)
-> Either String ByteString -> Either String ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ShortByteString
SBS.toShort (Either String ByteString -> Either String ShortByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either String ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode

instance Decode BS.ByteString BB.Builder where
  decode :: ByteString -> Either String Builder
decode = (ByteString -> Builder)
-> Either String ByteString -> Either String Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Builder
BB.byteString (Either String ByteString -> Either String Builder)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either String Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode

----

-- PRIMITIVE
instance Decode BS.L.ByteString BS.L.ByteString where
  decode :: ByteString -> Either String ByteString
decode = ByteString -> Either String ByteString
decodeBsL2BsL

instance Decode BS.L.ByteString BS.ByteString where
  decode :: ByteString -> Either String ByteString
decode = (ByteString -> ByteString)
-> Either String ByteString -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
bsToStrict (Either String ByteString -> Either String ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode

instance Decode BS.L.ByteString SBS.ShortByteString where
  decode :: ByteString -> Either String ShortByteString
decode = (ByteString -> ShortByteString)
-> Either String ByteString -> Either String ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ShortByteString
SBS.toShort (Either String ByteString -> Either String ShortByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either String ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode

instance Decode BS.L.ByteString BB.Builder where
  decode :: ByteString -> Either String Builder
decode = (ByteString -> Builder)
-> Either String ByteString -> Either String Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Builder
BB.byteString (Either String ByteString -> Either String Builder)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either String Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode

----

instance Decode SBS.ShortByteString SBS.ShortByteString where
  decode :: ShortByteString -> Either String ShortByteString
decode = (ByteString -> ShortByteString)
-> Either String ByteString -> Either String ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ShortByteString
SBS.toShort (Either String ByteString -> Either String ShortByteString)
-> (ShortByteString -> Either String ByteString)
-> ShortByteString
-> Either String ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String ByteString)
-> (ShortByteString -> ByteString)
-> ShortByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort

instance Decode SBS.ShortByteString BS.ByteString where
  decode :: ShortByteString -> Either String ByteString
decode = ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String ByteString)
-> (ShortByteString -> ByteString)
-> ShortByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort

instance Decode SBS.ShortByteString BS.L.ByteString where
  decode :: ShortByteString -> Either String ByteString
decode = ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String ByteString)
-> (ShortByteString -> ByteString)
-> ShortByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort

instance Decode SBS.ShortByteString BB.Builder where
  decode :: ShortByteString -> Either String Builder
decode = ByteString -> Either String Builder
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String Builder)
-> (ShortByteString -> ByteString)
-> ShortByteString
-> Either String Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort

----

instance Decode BB.Builder SBS.ShortByteString where
  decode :: Builder -> Either String ShortByteString
decode = ByteString -> Either String ShortByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String ShortByteString)
-> (Builder -> ByteString)
-> Builder
-> Either String ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString

instance Decode BB.Builder BS.L.ByteString where
  decode :: Builder -> Either String ByteString
decode = ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String ByteString)
-> (Builder -> ByteString) -> Builder -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString

instance Decode BB.Builder BS.ByteString where
  decode :: Builder -> Either String ByteString
decode = ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String ByteString)
-> (Builder -> ByteString) -> Builder -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString

instance Decode BB.Builder BB.Builder where
  decode :: Builder -> Either String Builder
decode = ByteString -> Either String Builder
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String Builder)
-> (Builder -> ByteString) -> Builder -> Either String Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString

----

instance Decode T.Text BS.ByteString where
  decode :: Text -> Either String ByteString
decode = ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

instance Decode T.Text BS.L.ByteString where
  decode :: Text -> Either String ByteString
decode = ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

instance Decode T.Text SBS.ShortByteString where
  decode :: Text -> Either String ShortByteString
decode = ByteString -> Either String ShortByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String ShortByteString)
-> (Text -> ByteString) -> Text -> Either String ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

instance Decode T.Text BB.Builder where
  decode :: Text -> Either String Builder
decode = ByteString -> Either String Builder
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String Builder)
-> (Text -> ByteString) -> Text -> Either String Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

----

instance Decode T.L.Text BS.ByteString where
  decode :: Text -> Either String ByteString
decode = ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.L.encodeUtf8

instance Decode T.L.Text BS.L.ByteString where
  decode :: Text -> Either String ByteString
decode = ByteString -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.L.encodeUtf8

instance Decode T.L.Text SBS.ShortByteString where
  decode :: Text -> Either String ShortByteString
decode = ByteString -> Either String ShortByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String ShortByteString)
-> (Text -> ByteString) -> Text -> Either String ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.L.encodeUtf8

instance Decode T.L.Text BB.Builder where
  decode :: Text -> Either String Builder
decode = ByteString -> Either String Builder
forall txt bin. Decode txt bin => txt -> Either String bin
decode (ByteString -> Either String Builder)
-> (Text -> ByteString) -> Text -> Either String Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.L.encodeUtf8

----

instance Decode TB.Builder BS.ByteString where
  decode :: Builder -> Either String ByteString
decode = Text -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (Text -> Either String ByteString)
-> (Builder -> Text) -> Builder -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText

instance Decode TB.Builder BS.L.ByteString where
  decode :: Builder -> Either String ByteString
decode = Text -> Either String ByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (Text -> Either String ByteString)
-> (Builder -> Text) -> Builder -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText

instance Decode TB.Builder SBS.ShortByteString where
  decode :: Builder -> Either String ShortByteString
decode = Text -> Either String ShortByteString
forall txt bin. Decode txt bin => txt -> Either String bin
decode (Text -> Either String ShortByteString)
-> (Builder -> Text) -> Builder -> Either String ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText

instance Decode TB.Builder BB.Builder where
  decode :: Builder -> Either String Builder
decode = Text -> Either String Builder
forall txt bin. Decode txt bin => txt -> Either String bin
decode (Text -> Either String Builder)
-> (Builder -> Text) -> Builder -> Either String Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText