{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_HADDOCK prune #-}

-- |
-- Binary (as opposed to textual) data is encountered in weird corners of the
-- Haskell ecosystem. We tend to forget (for example) that the content
-- recieved from a web server is /not/ text until we convert it from UTF-8 (if
-- that's what it is); and of course that glosses over the fact that something
-- of content-type @image/jpeg@ is not text in any way, shape, or form.
--
-- Bytes also show up when working with crypto algorithms, taking hashes, and
-- when doing serialization to external binary formats. Although we frequently
-- display these in terminals (and in URLs!) as text, but we take for granted
-- that we have actually deserialized the data or rendered the it in
-- hexidecimal or base64 or...
--
-- This module presents a simple wrapper around various representations of
-- binary data to make it easier to interoperate with libraries supplying
-- or consuming bytes.
module Core.Text.Bytes
  ( Bytes,
    Binary (fromBytes, intoBytes),
    hOutput,
    hInput,

    -- * Internals
    unBytes,
  )
where

import qualified Data.ByteString as B
  ( ByteString,
    hGetContents,
    hPut,
    pack,
    unpack,
  )
import qualified Data.ByteString.Builder as B (Builder, byteString, toLazyByteString)
import qualified Data.ByteString.Lazy as L (ByteString, fromStrict, toStrict)
import Data.Hashable (Hashable)
import Data.Word (Word8)
import GHC.Generics (Generic)
import System.IO (Handle)

-- |
-- A block of data in binary form.
newtype Bytes
  = StrictBytes B.ByteString
  deriving (Int -> Bytes -> ShowS
[Bytes] -> ShowS
Bytes -> String
(Int -> Bytes -> ShowS)
-> (Bytes -> String) -> ([Bytes] -> ShowS) -> Show Bytes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bytes] -> ShowS
$cshowList :: [Bytes] -> ShowS
show :: Bytes -> String
$cshow :: Bytes -> String
showsPrec :: Int -> Bytes -> ShowS
$cshowsPrec :: Int -> Bytes -> ShowS
Show, Bytes -> Bytes -> Bool
(Bytes -> Bytes -> Bool) -> (Bytes -> Bytes -> Bool) -> Eq Bytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bytes -> Bytes -> Bool
$c/= :: Bytes -> Bytes -> Bool
== :: Bytes -> Bytes -> Bool
$c== :: Bytes -> Bytes -> Bool
Eq, Eq Bytes
Eq Bytes
-> (Bytes -> Bytes -> Ordering)
-> (Bytes -> Bytes -> Bool)
-> (Bytes -> Bytes -> Bool)
-> (Bytes -> Bytes -> Bool)
-> (Bytes -> Bytes -> Bool)
-> (Bytes -> Bytes -> Bytes)
-> (Bytes -> Bytes -> Bytes)
-> Ord Bytes
Bytes -> Bytes -> Bool
Bytes -> Bytes -> Ordering
Bytes -> Bytes -> Bytes
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Bytes -> Bytes -> Bytes
$cmin :: Bytes -> Bytes -> Bytes
max :: Bytes -> Bytes -> Bytes
$cmax :: Bytes -> Bytes -> Bytes
>= :: Bytes -> Bytes -> Bool
$c>= :: Bytes -> Bytes -> Bool
> :: Bytes -> Bytes -> Bool
$c> :: Bytes -> Bytes -> Bool
<= :: Bytes -> Bytes -> Bool
$c<= :: Bytes -> Bytes -> Bool
< :: Bytes -> Bytes -> Bool
$c< :: Bytes -> Bytes -> Bool
compare :: Bytes -> Bytes -> Ordering
$ccompare :: Bytes -> Bytes -> Ordering
$cp1Ord :: Eq Bytes
Ord, (forall x. Bytes -> Rep Bytes x)
-> (forall x. Rep Bytes x -> Bytes) -> Generic Bytes
forall x. Rep Bytes x -> Bytes
forall x. Bytes -> Rep Bytes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bytes x -> Bytes
$cfrom :: forall x. Bytes -> Rep Bytes x
Generic)

-- |
-- Access the strict 'ByteString' underlying the @Bytes@ type.
unBytes :: Bytes -> B.ByteString
unBytes :: Bytes -> ByteString
unBytes (StrictBytes ByteString
b') = ByteString
b'
{-# INLINE unBytes #-}

instance Hashable Bytes

-- |
-- Conversion to and from various types containing binary data into our
-- convenience Bytes type.
--
-- As often as not these conversions are /expensive/; these methods are
-- here just to wrap calling the relevant functions in a uniform interface.
class Binary α where
  fromBytes :: Bytes -> α
  intoBytes :: α -> Bytes

instance Binary Bytes where
  fromBytes :: Bytes -> Bytes
fromBytes = Bytes -> Bytes
forall a. a -> a
id
  intoBytes :: Bytes -> Bytes
intoBytes = Bytes -> Bytes
forall a. a -> a
id

-- | from "Data.ByteString" Strict
instance Binary B.ByteString where
  fromBytes :: Bytes -> ByteString
fromBytes (StrictBytes ByteString
b') = ByteString
b'
  intoBytes :: ByteString -> Bytes
intoBytes ByteString
b' = ByteString -> Bytes
StrictBytes ByteString
b'

-- | from "Data.ByteString.Lazy"
instance Binary L.ByteString where
  fromBytes :: Bytes -> ByteString
fromBytes (StrictBytes ByteString
b') = ByteString -> ByteString
L.fromStrict ByteString
b'
  intoBytes :: ByteString -> Bytes
intoBytes ByteString
b' = ByteString -> Bytes
StrictBytes (ByteString -> ByteString
L.toStrict ByteString
b') -- expensive

instance Binary B.Builder where
  fromBytes :: Bytes -> Builder
fromBytes (StrictBytes ByteString
b') = ByteString -> Builder
B.byteString ByteString
b'
  intoBytes :: Builder -> Bytes
intoBytes Builder
b' = ByteString -> Bytes
StrictBytes (ByteString -> ByteString
L.toStrict (Builder -> ByteString
B.toLazyByteString Builder
b'))

-- | from "Data.Word"
instance Binary [Word8] where
  fromBytes :: Bytes -> [Word8]
fromBytes (StrictBytes ByteString
b') = ByteString -> [Word8]
B.unpack ByteString
b'
  intoBytes :: [Word8] -> Bytes
intoBytes = ByteString -> Bytes
StrictBytes (ByteString -> Bytes)
-> ([Word8] -> ByteString) -> [Word8] -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack

-- |
-- Output the content of the 'Bytes' to the specified 'Handle'.
--
-- @
--     hOutput h b
-- @
--
-- 'Core.Program.Execute.output' provides a convenient way to write a @Bytes@
-- to a file or socket handle from within the 'Core.Program.Execute.Program'
-- monad.
--
-- Don't use this function to write to @stdout@ if you are using any of the
-- other output or logging facililities of this libarary as you will corrupt
-- the ordering of output on the user's terminal. Instead do:
--
-- @
--     'Core.Program.Execute.write' ('intoRope' b)
-- @
--
-- on the assumption that the bytes in question are UTF-8 (or plain ASCII)
-- encoded.
hOutput :: Handle -> Bytes -> IO ()
hOutput :: Handle -> Bytes -> IO ()
hOutput Handle
handle (StrictBytes ByteString
b') = Handle -> ByteString -> IO ()
B.hPut Handle
handle ByteString
b'

-- |
-- Read the (entire) contents of a handle into a Bytes object.
--
-- If you want to read the entire contents of a file, you can do:
--
-- @
--     contents <- 'Core.System.Base.withFile' name 'Core.System.Base.ReadMode' 'hInput'
-- @
--
-- At any kind of scale, Streaming I/O is almost always for better, but for
-- small files you need to pick apart this is fine.
hInput :: Handle -> IO Bytes
hInput :: Handle -> IO Bytes
hInput Handle
handle = do
  ByteString
contents <- Handle -> IO ByteString
B.hGetContents Handle
handle
  Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Bytes
StrictBytes ByteString
contents)

{-
instance Show Bytes where
    show x = case x of
        StrictBytes b' ->
-}