{-# LANGUAGE MultiParamTypeClasses #-}

-- | This module provides access to the \"base32hex\" 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.Base32Hex as B32
--
-- If you want to explictly specify which 'Encode' and 'Decode' typeclass instance is used, you can use plain Haskell2010 type-signature annotations, e.g.
--
-- >>> (B32.encode :: ByteString -> Text) "\x00\x00"
-- "0000===="
--
-- >>> (B32.decode :: Text -> Either String ShortByteString) "6GT34C0="
-- 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):
--
-- >>> B32.encode @ShortByteString @Text "\xFF\239"
-- "VVNG===="
--
-- >>> B32.decode @Text @ShortByteString "VVNG===="
-- Right "\255\239"
--
-- @since 0.3.0.0
module Codec.Base32Hex
    ( Encode(encode)
    , Decode(decode)
    ) where

import qualified Codec.Base32.Impl as Impl

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 = Fmt -> ByteString -> Either String ByteString
Impl.decodeBs2Bs Fmt
Impl.Fmt'base32hex

decodeBsL2BsL :: BS.L.ByteString -> Either String BS.L.ByteString
decodeBsL2BsL :: ByteString -> Either String ByteString
decodeBsL2BsL = Fmt -> ByteString -> Either String ByteString
Impl.decodeBsL2BsL Fmt
Impl.Fmt'base32hex

encodeBs2Bs :: BS.ByteString -> BS.ByteString
encodeBs2Bs :: ByteString -> ByteString
encodeBs2Bs = Fmt -> ByteString -> ByteString
Impl.encodeBs2Bs Fmt
Impl.Fmt'base32hex

encodeBsL2BsL :: BS.L.ByteString -> BS.L.ByteString
encodeBsL2BsL :: ByteString -> ByteString
encodeBsL2BsL = Fmt -> ByteString -> ByteString
Impl.encodeBsL2BsL Fmt
Impl.Fmt'base32hex

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

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

-- | Typeclass representing types for which a text-to-binary @base32hex@ decoding is defined
class Decode txt bin where
  -- | Decode binary data encoded textually as @base32hex@
  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