module Debug.TraceEmbrace.ByteString where

import Data.ByteString.Lazy.Internal qualified as L
import Data.ByteString.Internal (ByteString(..))
import Data.Tagged
import Data.Maybe
import Prelude

-- | Show 'ByteString' structure.
--
-- >>> showLbsAsIs ("a" <> "b")
showLbsAsIs :: L.ByteString -> [ByteString]
showLbsAsIs :: ByteString -> [ByteString]
showLbsAsIs ByteString
L.Empty = []
showLbsAsIs (L.Chunk ByteString
x ByteString
xs) = ByteString
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
showLbsAsIs ByteString
xs

-- | Wrap value which has opaque 'Show' instance.
newtype ShowTrace a = ShowTrace { forall a. ShowTrace a -> a
unShowTrace :: a }

instance Show (ShowTrace L.ByteString) where
  show :: ShowTrace ByteString -> String
show = [ByteString] -> String
forall a. Show a => a -> String
show ([ByteString] -> String)
-> (ShowTrace ByteString -> [ByteString])
-> ShowTrace ByteString
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
showLbsAsIs (ByteString -> [ByteString])
-> (ShowTrace ByteString -> ByteString)
-> ShowTrace ByteString
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowTrace ByteString -> ByteString
forall a. ShowTrace a -> a
unShowTrace

instance Show (ShowTrace ByteString) where
  show :: ShowTrace ByteString -> String
show (ShowTrace bs :: ByteString
bs@(BS ForeignPtr Word8
fp Int
len)) = String
"BS " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ForeignPtr Word8 -> String
forall a. Show a => a -> String
show ForeignPtr Word8
fp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
len String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
bs

instance Show (ShowTrace a) => Show (ShowTrace (Maybe a)) where
  show :: ShowTrace (Maybe a) -> String
show (ShowTrace Maybe a
x) = Maybe (ShowTrace a) -> String
forall a. Show a => a -> String
show (a -> ShowTrace a
forall a. a -> ShowTrace a
ShowTrace (a -> ShowTrace a) -> Maybe a -> Maybe (ShowTrace a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
x)

instance Show (ShowTrace a) => Show (ShowTrace (Tagged t a)) where
  show :: ShowTrace (Tagged t a) -> String
show (ShowTrace Tagged t a
x) = Tagged t (ShowTrace a) -> String
forall a. Show a => a -> String
show (a -> ShowTrace a
forall a. a -> ShowTrace a
ShowTrace (a -> ShowTrace a) -> Tagged t a -> Tagged t (ShowTrace a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tagged t a
x)

instance {-# OVERLAPPABLE #-} Show (ShowTrace a) => Show (ShowTrace [a]) where
  show :: ShowTrace [a] -> String
show (ShowTrace [a]
x) = [ShowTrace a] -> String
forall a. Show a => a -> String
show (a -> ShowTrace a
forall a. a -> ShowTrace a
ShowTrace (a -> ShowTrace a) -> [a] -> [ShowTrace a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
x)

instance {-# OVERLAPPING #-} Show (ShowTrace a) => Show (ShowTrace [Tagged t a]) where
  show :: ShowTrace [Tagged t a] -> String
show (ShowTrace [Tagged t a]
x) = [Tagged t (ShowTrace a)] -> String
forall a. Show a => a -> String
show ((a -> ShowTrace a) -> Tagged t a -> Tagged t (ShowTrace a)
forall a b. (a -> b) -> Tagged t a -> Tagged t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ShowTrace a
forall a. a -> ShowTrace a
ShowTrace (Tagged t a -> Tagged t (ShowTrace a))
-> [Tagged t a] -> [Tagged t (ShowTrace a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tagged t a]
x)