module Text.Hex
    (
    -- * Encoding and decoding
      encodeHex
    , decodeHex
    , lazilyEncodeHex

    -- * Types
    , Text
    , LazyText
    , ByteString
    , LazyByteString

    -- * Type conversions
    , lazyText
    , strictText
    , lazyByteString
    , strictByteString

    ) where

import Prelude (either, Maybe (..), const)

-- base16-bytestring
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Base16.Lazy as LazyBase16

-- bytestring
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LazyByteString

-- text
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Encoding as LazyText

-- | Strict byte string

type ByteString =
    ByteString.ByteString

-- | Lazy byte string

type LazyByteString =
    LazyByteString.ByteString

-- | Strict text

type Text =
    Text.Text

-- | Lazy text

type LazyText =
    LazyText.Text

-- |
-- Encodes a byte string as hexidecimal number represented in text.
-- Each byte of the input is converted into two characters in the
-- resulting text.
--
-- >>> (encodeHex . ByteString.singleton) 192
-- "c0"
--
-- >>> (encodeHex . ByteString.singleton) 168
-- "a8"
--
-- >>> (encodeHex . ByteString.pack) [192, 168, 1, 2]
-- "c0a80102"
--
-- 'Text' produced by @encodeHex@ can be converted back to a
-- 'ByteString' using 'decodeHex'.
--
-- The lazy variant of @encodeHex@ is 'lazilyEncodeHex'.

encodeHex :: ByteString -> Text
encodeHex :: ByteString -> Text
encodeHex ByteString
bs =
    ByteString -> Text
Text.decodeUtf8 (ByteString -> ByteString
Base16.encode ByteString
bs)

-- |
-- Decodes hexidecimal text as a byte string. If the text contains
-- an even number of characters and consists only of the digits @0@
-- through @9@ and letters @a@ through @f@, then the result is a
-- 'Just' value.
--
-- Unpacking the ByteString in the following examples allows for
-- prettier printing in the REPL.
--
-- >>> (fmap ByteString.unpack . decodeHex . Text.pack) "c0a80102"
-- Just [192,168,1,2]
--
-- If the text contains an odd number of characters, decoding fails
-- and produces 'Nothing'.
--
-- >>> (fmap ByteString.unpack . decodeHex . Text.pack) "c0a8010"
-- Nothing
--
-- If the text contains non-hexidecimal characters, decoding fails
-- and produces 'Nothing'.
--
-- >>> (fmap ByteString.unpack . decodeHex . Text.pack) "x0a80102"
-- Nothing
--
-- The letters may be in either upper or lower case. This next
-- example therefore gives the same result as the first one above:
--
-- >>> (fmap ByteString.unpack . decodeHex . Text.pack) "C0A80102"
-- Just [192,168,1,2]

decodeHex :: Text -> Maybe ByteString
decodeHex :: Text -> Maybe ByteString
decodeHex Text
txt =
    (String -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either String ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> String -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Either String ByteString
Base16.decode (Text -> ByteString
Text.encodeUtf8 Text
txt))

-- |
-- @lazilyEncodeHex@ is the lazy variant of 'encodeHex'.
--
-- With laziness, it is possible to encode byte strings of
-- infinite length:
--
-- >>> (LazyText.take 8 . lazilyEncodeHex . LazyByteString.pack . cycle) [1, 2, 3]
-- "01020301"

lazilyEncodeHex :: LazyByteString -> LazyText
lazilyEncodeHex :: LazyByteString -> LazyText
lazilyEncodeHex LazyByteString
bs =
    LazyByteString -> LazyText
LazyText.decodeUtf8 (LazyByteString -> LazyByteString
LazyBase16.encode LazyByteString
bs)

lazyText :: Text -> LazyText
lazyText :: Text -> LazyText
lazyText = Text -> LazyText
LazyText.fromStrict

strictText :: LazyText -> Text
strictText :: LazyText -> Text
strictText = LazyText -> Text
LazyText.toStrict

lazyByteString :: ByteString -> LazyByteString
lazyByteString :: ByteString -> LazyByteString
lazyByteString = ByteString -> LazyByteString
LazyByteString.fromStrict

strictByteString :: LazyByteString -> ByteString
strictByteString :: LazyByteString -> ByteString
strictByteString = LazyByteString -> ByteString
LazyByteString.toStrict