{- |
A 'BS.ByteString' newtype wrapper indicating a human-readable bytestring, to be
displayed in hex form (e.g. 00 12 AB FF).
-}

module BytePatch.HexByteString
  ( HexByteString(..)
  , parseHexByteString
  , prettyHexByteString
  ) where

import           StreamPatch.Patch.Binary ( BinRep(..) )

import           Data.Void
import           Text.Megaparsec
import qualified Text.Megaparsec.Char       as MC
import qualified Data.ByteString            as BS
import qualified Data.Char                  as Char
import           Data.Word
import qualified Data.Text                  as Text
import           Data.Text                  ( Text )
import           Data.List                  as List
import           Data.Aeson

newtype HexByteString = HexByteString { HexByteString -> ByteString
unHexByteString :: BS.ByteString }
    deriving (HexByteString -> HexByteString -> Bool
(HexByteString -> HexByteString -> Bool)
-> (HexByteString -> HexByteString -> Bool) -> Eq HexByteString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HexByteString -> HexByteString -> Bool
$c/= :: HexByteString -> HexByteString -> Bool
== :: HexByteString -> HexByteString -> Bool
$c== :: HexByteString -> HexByteString -> Bool
Eq)

instance Show HexByteString where
    show :: HexByteString -> String
show = Text -> String
Text.unpack (Text -> String)
-> (HexByteString -> Text) -> HexByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
prettyHexByteString (ByteString -> Text)
-> (HexByteString -> ByteString) -> HexByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexByteString -> ByteString
unHexByteString

instance BinRep HexByteString where
    toBinRep :: HexByteString -> Either String ByteString
toBinRep = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> Either String ByteString)
-> (HexByteString -> ByteString)
-> HexByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexByteString -> ByteString
unHexByteString

instance FromJSON HexByteString where
    parseJSON :: Value -> Parser HexByteString
parseJSON = String
-> (Text -> Parser HexByteString) -> Value -> Parser HexByteString
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"hex bytestring" ((Text -> Parser HexByteString) -> Value -> Parser HexByteString)
-> (Text -> Parser HexByteString) -> Value -> Parser HexByteString
forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe @Void Parsec Void Text ByteString
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ByteString
parseHexByteString Text
t of
          Maybe ByteString
Nothing -> String -> Parser HexByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse hex bytestring (TODO)"
          Just ByteString
t' -> HexByteString -> Parser HexByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> HexByteString
HexByteString ByteString
t')
instance ToJSON   HexByteString where
    toJSON :: HexByteString -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (HexByteString -> Text) -> HexByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
prettyHexByteString (ByteString -> Text)
-> (HexByteString -> ByteString) -> HexByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexByteString -> ByteString
unHexByteString

-- | A hex bytestring looks like this: @00 01 89 8a   FEff@. You can mix and
-- match capitalization and spacing, but I prefer to space each byte, full caps.
parseHexByteString :: (MonadParsec e s m, Token s ~ Char) => m BS.ByteString
parseHexByteString :: forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ByteString
parseHexByteString = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> m [Word8] -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word8
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
parseHexByte m Word8 -> m () -> m [Word8]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MC.hspace

-- | Parse a byte formatted as two hex digits e.g. EF. You _must_ provide both
-- nibbles e.g. @0F@, not @F@. They cannot be spaced e.g. @E F@ is invalid.
--
-- Returns a value 0-255, so can fit in any Num type that can store that.
parseHexByte :: (MonadParsec e s m, Token s ~ Char, Num a) => m a
parseHexByte :: forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
parseHexByte = do
    Char
c1 <- m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
MC.hexDigitChar
    Char
c2 <- m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
MC.hexDigitChar
    a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ a
0x10 a -> a -> a
forall a. Num a => a -> a -> a
* Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
Char.digitToInt Char
c1) a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
Char.digitToInt Char
c2)

prettyHexByteString :: BS.ByteString -> Text
prettyHexByteString :: ByteString -> Text
prettyHexByteString =
    [Text] -> Text
Text.concat ([Text] -> Text) -> (ByteString -> [Text]) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
List.intersperse (Char -> Text
Text.singleton Char
' ') ([Text] -> [Text])
-> (ByteString -> [Text]) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Text) -> [Word8] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char, Char) -> Text
f ((Char, Char) -> Text) -> (Word8 -> (Char, Char)) -> Word8 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> (Char, Char)
prettyHexByte) ([Word8] -> [Text])
-> (ByteString -> [Word8]) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
  where
    f :: (Char, Char) -> Text
    f :: (Char, Char) -> Text
f (Char
c1, Char
c2) = Char -> Text -> Text
Text.cons Char
c1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
Text.singleton Char
c2

prettyHexByte :: Word8 -> (Char, Char)
prettyHexByte :: Word8 -> (Char, Char)
prettyHexByte Word8
w = (Int -> Char
prettyNibble Int
h, Int -> Char
prettyNibble Int
l)
  where
    (Int
h,Int
l) = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
0x10
    prettyNibble :: Int -> Char
prettyNibble = Char -> Char
Char.toUpper (Char -> Char) -> (Int -> Char) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
Char.intToDigit