{-# LANGUAGE OverloadedStrings #-}

-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com
-- SPDX-License-Identifier: MIT

module Bytes
  ( numToBts
  , strToBts
  , bytesToBts
  , btsToStr
  , unescapeStr
  , btsToNum
  , btsToUnescapedStr
  , btsIsUtf8
  , btsAnd
  , btsOr
  , btsNot
  , btsConcat
  , btsEqual
  , btsSize
  , btsSlice
  , btsShift
  , nonFinites
  , nonFiniteName
  , nonFiniteBts
  , btsToNonFinite
  , nonFiniteOf
  , NonFinite (..)
  , BytesException (..)
  )
where

import AST
import Control.Exception (Exception, throw)
import Data.Binary.IEEE754
import Data.Bits (Bits (complement, shiftL, shiftR), (.&.), (.|.))
import qualified Data.ByteString as B
import Data.ByteString.Builder (toLazyByteString, word64BE)
import Data.ByteString.Lazy (unpack)
import qualified Data.ByteString.Lazy.UTF8 as U
import Data.Char (chr, isDigit, isPrint, ord)
import Data.List (find)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Word (Word64, Word8)
import Numeric (readHex)
import Text.Printf (printf)

newtype BytesException = InvalidNumberLength Int
  deriving (BytesException -> BytesException -> Bool
(BytesException -> BytesException -> Bool)
-> (BytesException -> BytesException -> Bool) -> Eq BytesException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BytesException -> BytesException -> Bool
== :: BytesException -> BytesException -> Bool
$c/= :: BytesException -> BytesException -> Bool
/= :: BytesException -> BytesException -> Bool
Eq, Int -> BytesException -> ShowS
[BytesException] -> ShowS
BytesException -> String
(Int -> BytesException -> ShowS)
-> (BytesException -> String)
-> ([BytesException] -> ShowS)
-> Show BytesException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BytesException -> ShowS
showsPrec :: Int -> BytesException -> ShowS
$cshow :: BytesException -> String
show :: BytesException -> String
$cshowList :: [BytesException] -> ShowS
showList :: [BytesException] -> ShowS
Show)

instance Exception BytesException

btsToWord8 :: Bytes -> [Word8]
btsToWord8 :: Bytes -> [Word8]
btsToWord8 Bytes
BtEmpty = []
btsToWord8 (BtOne String
bt) = [String -> Word8
hexByte String
bt]
btsToWord8 (BtMany [String]
bts) = (String -> Word8) -> [String] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map String -> Word8
hexByte [String]
bts
btsToWord8 (BtMeta Text
mt) = String -> [Word8]
forall a. HasCallStack => String -> a
error (String -> [Word8]) -> String -> [Word8]
forall a b. (a -> b) -> a -> b
$ String
"Cannot convert meta bytes to Word8; " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
mt
btsToWord8 (BtAny Slot
_) = String -> [Word8]
forall a. HasCallStack => String -> a
error String
"Cannot convert anonymous meta bytes to Word8"

hexByte :: String -> Word8
hexByte :: String -> Word8
hexByte [Char
hi, Char
lo] = (Char -> Word8
nibble Char
hi Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Char -> Word8
nibble Char
lo
  where
    nibble :: Char -> Word8
    nibble :: Char -> Word8
nibble Char
c
      | Char -> Bool
isDigit Char
c = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
      | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F' = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10)
      | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f' = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10)
      | Bool
otherwise = String -> Word8
forall a. HasCallStack => String -> a
error (String
"Invalid hex digit: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
c])
hexByte String
bt = String -> Word8
forall a. HasCallStack => String -> a
error (String -> Word8) -> String -> Word8
forall a b. (a -> b) -> a -> b
$ String
"Invalid hex byte; " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bt

word8ToBytes :: [Word8] -> Bytes
word8ToBytes :: [Word8] -> Bytes
word8ToBytes [] = Bytes
BtEmpty
word8ToBytes [Word8
w8] = String -> Bytes
BtOne (Word8 -> String
toHex Word8
w8)
word8ToBytes [Word8]
bts = [String] -> Bytes
BtMany ((Word8 -> String) -> [Word8] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> String
toHex [Word8]
bts)

toHex :: Word8 -> String
toHex :: Word8 -> String
toHex Word8
w = [Word8 -> Char
digit (Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4), Word8 -> Char
digit (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0F)]
  where
    digit :: Word8 -> Char
    digit :: Word8 -> Char
digit Word8
n
      | Word8
n Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
10 = Int -> Char
chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'0')
      | Bool
otherwise = Int -> Char
chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)

btsToNum :: Bytes -> Double
btsToNum :: Bytes -> Double
btsToNum Bytes
hx =
  let bytes :: [Word8]
bytes = Bytes -> [Word8]
btsToWord8 Bytes
hx
   in if [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
8
        then BytesException -> Double
forall a e. Exception e => e -> a
throw (Int -> BytesException
InvalidNumberLength ([Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
bytes))
        else Word64 -> Double
wordToDouble ([Word8] -> Word64
toWord64BE [Word8]
bytes)
  where
    toWord64BE :: [Word8] -> Word64
    toWord64BE :: [Word8] -> Word64
toWord64BE [Word8
a, Word8
b, Word8
c, Word8
d, Word8
e, Word8
f, Word8
g, Word8
h] =
      Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
56
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
48
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
40
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
e Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
24
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
f Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
g Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8
        Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
h
    toWord64BE [Word8]
_ = String -> Word64
forall a. HasCallStack => String -> a
error String
"Expected 8 bytes for Double"

numToBts :: Double -> Bytes
numToBts :: Double -> Bytes
numToBts Double
num = [Word8] -> Bytes
word8ToBytes (ByteString -> [Word8]
unpack (Builder -> ByteString
toLazyByteString (Word64 -> Builder
word64BE (Double -> Word64
doubleToWord Double
num))))

data NonFinite = NfNan | NfPinf | NfNinf
  deriving (NonFinite -> NonFinite -> Bool
(NonFinite -> NonFinite -> Bool)
-> (NonFinite -> NonFinite -> Bool) -> Eq NonFinite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonFinite -> NonFinite -> Bool
== :: NonFinite -> NonFinite -> Bool
$c/= :: NonFinite -> NonFinite -> Bool
/= :: NonFinite -> NonFinite -> Bool
Eq, Int -> NonFinite -> ShowS
[NonFinite] -> ShowS
NonFinite -> String
(Int -> NonFinite -> ShowS)
-> (NonFinite -> String)
-> ([NonFinite] -> ShowS)
-> Show NonFinite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonFinite -> ShowS
showsPrec :: Int -> NonFinite -> ShowS
$cshow :: NonFinite -> String
show :: NonFinite -> String
$cshowList :: [NonFinite] -> ShowS
showList :: [NonFinite] -> ShowS
Show)

nonFinites :: [NonFinite]
nonFinites :: [NonFinite]
nonFinites = [NonFinite
NfNan, NonFinite
NfPinf, NonFinite
NfNinf]

nonFiniteName :: NonFinite -> T.Text
nonFiniteName :: NonFinite -> Text
nonFiniteName NonFinite
NfNan = Text
"nan"
nonFiniteName NonFinite
NfPinf = Text
"pinf"
nonFiniteName NonFinite
NfNinf = Text
"ninf"

nonFiniteBts :: NonFinite -> Bytes
nonFiniteBts :: NonFinite -> Bytes
nonFiniteBts NonFinite
NfNan = [String] -> Bytes
BtMany [String
"7F", String
"F8", String
"00", String
"00", String
"00", String
"00", String
"00", String
"00"]
nonFiniteBts NonFinite
NfPinf = [String] -> Bytes
BtMany [String
"7F", String
"F0", String
"00", String
"00", String
"00", String
"00", String
"00", String
"00"]
nonFiniteBts NonFinite
NfNinf = [String] -> Bytes
BtMany [String
"FF", String
"F0", String
"00", String
"00", String
"00", String
"00", String
"00", String
"00"]

btsToNonFinite :: Bytes -> Maybe NonFinite
btsToNonFinite :: Bytes -> Maybe NonFinite
btsToNonFinite (BtMeta Text
_) = Maybe NonFinite
forall a. Maybe a
Nothing
btsToNonFinite (BtAny Slot
_) = Maybe NonFinite
forall a. Maybe a
Nothing
btsToNonFinite Bytes
bts = (NonFinite -> Bool) -> [NonFinite] -> Maybe NonFinite
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bytes -> Bytes -> Bool
btsEqual Bytes
bts (Bytes -> Bool) -> (NonFinite -> Bytes) -> NonFinite -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonFinite -> Bytes
nonFiniteBts) [NonFinite]
nonFinites

nonFiniteOf :: T.Text -> Maybe NonFinite
nonFiniteOf :: Text -> Maybe NonFinite
nonFiniteOf Text
name = (NonFinite -> Bool) -> [NonFinite] -> Maybe NonFinite
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) (Text -> Bool) -> (NonFinite -> Text) -> NonFinite -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonFinite -> Text
nonFiniteName) [NonFinite]
nonFinites

strToBts :: String -> Bytes
strToBts :: String -> Bytes
strToBts String
"" = Bytes
BtEmpty
strToBts [Char
ch] = [Word8] -> Bytes
word8ToBytes (ByteString -> [Word8]
unpack (String -> ByteString
U.fromString [Char
ch]))
strToBts String
str = [Word8] -> Bytes
word8ToBytes (ByteString -> [Word8]
unpack (String -> ByteString
U.fromString String
str))

bytesToBts :: String -> Bytes
bytesToBts :: String -> Bytes
bytesToBts String
"--" = Bytes
BtEmpty
bytesToBts String
str
  | String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 Bool -> Bool -> Bool
&& String -> Char
forall a. HasCallStack => [a] -> a
last String
str Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' = String -> Bytes
BtOne (ShowS
forall a. HasCallStack => [a] -> [a]
init String
str)
  | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str) Bool -> Bool -> Bool
&& String -> Char
forall a. HasCallStack => [a] -> a
last String
str Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' = String -> Bytes
forall a. HasCallStack => String -> a
error (String -> Bytes) -> String -> Bytes
forall a b. (a -> b) -> a -> b
$ String
"Invalid trailing separator in byte string; " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
  | Bool
otherwise = [String] -> Bytes
BtMany ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"-" (String -> Text
T.pack String
str)))

btsToStr :: Bytes -> String
btsToStr :: Bytes -> String
btsToStr Bytes
BtEmpty = String
""
btsToStr Bytes
bytes = ShowS
escapeStr (Bytes -> String
btsToUnescapedStr Bytes
bytes)
  where
    escapeStr :: String -> String
    escapeStr :: ShowS
escapeStr = (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escapeChar
      where
        escapeChar :: Char -> String
        escapeChar :: Char -> String
escapeChar Char
'"' = String
"\\\""
        escapeChar Char
'\\' = String
"\\\\"
        escapeChar Char
'\n' = String
"\\n"
        escapeChar Char
'\t' = String
"\\t"
        escapeChar Char
c
          | Char -> Bool
isPrint Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"' = [Char
c]
          | Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFF = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"\\x%02x" (Char -> Int
ord Char
c)
          | Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFFFF = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"\\u%04x" (Char -> Int
ord Char
c)
          | Bool
otherwise = Int -> String
surrogates (Char -> Int
ord Char
c)
        surrogates :: Int -> String
        surrogates :: Int -> String
surrogates Int
code =
          let rest :: Int
rest = Int
code Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000
              high :: Int
high = Int
0xD800 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rest Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
0x400
              low :: Int
low = Int
0xDC00 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rest Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x400
           in String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"\\u%04x\\u%04x" Int
high Int
low

unescapeStr :: String -> String
unescapeStr :: ShowS
unescapeStr = ShowS
go
  where
    go :: String -> String
    go :: ShowS
go String
"" = String
""
    go (Char
'\\' : Char
'u' : String
digits) = ShowS
goUnicode String
digits
    go (Char
'\\' : Char
'x' : Char
high : Char
low : String
rest)
      | Just Int
code <- Char -> Char -> Maybe Int
hexPair Char
high Char
low = Int -> Char
chr Int
code Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
rest
    go (Char
'\\' : Char
escaped : String
rest)
      | Just Char
unescaped <- Char -> [(Char, Char)] -> Maybe Char
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
escaped [(Char, Char)]
escapes = Char
unescaped Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
rest
    go (Char
char : String
rest) = Char
char Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
rest
    goUnicode :: String -> String
    goUnicode :: ShowS
goUnicode (Char
h1 : Char
h2 : Char
h3 : Char
h4 : String
rest)
      | Just Int
code <- Char -> Char -> Char -> Char -> Maybe Int
hexQuad Char
h1 Char
h2 Char
h3 Char
h4 =
          if Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xD800 Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xDBFF
            then case String
rest of
              (Char
'\\' : Char
'u' : Char
l1 : Char
l2 : Char
l3 : Char
l4 : String
rest')
                | Just Int
low <- Char -> Char -> Char -> Char -> Maybe Int
hexQuad Char
l1 Char
l2 Char
l3 Char
l4
                , Int
low Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xDC00 Bool -> Bool -> Bool
&& Int
low Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xDFFF ->
                    Int -> Char
chr (Int
0x10000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
code Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0xD800) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
0x400 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
low Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0xDC00)) Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
rest'
              String
_ -> Int -> Char
chr Int
code Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
rest
            else Int -> Char
chr Int
code Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
rest
    goUnicode String
rest = Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'u' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
rest
    hexQuad :: Char -> Char -> Char -> Char -> Maybe Int
    hexQuad :: Char -> Char -> Char -> Char -> Maybe Int
hexQuad Char
a Char
b Char
c Char
d = case ReadS Int
forall a. (Eq a, Num a) => ReadS a
readHex [Char
a, Char
b, Char
c, Char
d] of
      [(Int
code, String
"")] -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
code
      [(Int, String)]
_ -> Maybe Int
forall a. Maybe a
Nothing
    hexPair :: Char -> Char -> Maybe Int
    hexPair :: Char -> Char -> Maybe Int
hexPair Char
high Char
low = case ReadS Int
forall a. (Eq a, Num a) => ReadS a
readHex [Char
high, Char
low] of
      [(Int
code, String
"")] -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
code
      [(Int, String)]
_ -> Maybe Int
forall a. Maybe a
Nothing
    escapes :: [(Char, Char)]
    escapes :: [(Char, Char)]
escapes = [(Char
'"', Char
'"'), (Char
'\\', Char
'\\'), (Char
'n', Char
'\n'), (Char
't', Char
'\t'), (Char
'r', Char
'\r'), (Char
'b', Char
'\b'), (Char
'f', Char
'\f')]

btsToUnescapedStr :: Bytes -> String
btsToUnescapedStr :: Bytes -> String
btsToUnescapedStr Bytes
bytes = Text -> String
T.unpack (ByteString -> Text
T.decodeUtf8 ([Word8] -> ByteString
B.pack (Bytes -> [Word8]
btsToWord8 Bytes
bytes)))

btsIsUtf8 :: Bytes -> Bool
btsIsUtf8 :: Bytes -> Bool
btsIsUtf8 Bytes
bytes =
  case ByteString -> Either UnicodeException Text
T.decodeUtf8' ([Word8] -> ByteString
B.pack (Bytes -> [Word8]
btsToWord8 Bytes
bytes)) of
    Left UnicodeException
_ -> Bool
False
    Right Text
_ -> Bool
True

btsAnd :: Bytes -> Bytes -> Maybe Bytes
btsAnd :: Bytes -> Bytes -> Maybe Bytes
btsAnd = (Word8 -> Word8 -> Word8) -> Bytes -> Bytes -> Maybe Bytes
zipBytes Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
(.&.)

btsOr :: Bytes -> Bytes -> Maybe Bytes
btsOr :: Bytes -> Bytes -> Maybe Bytes
btsOr = (Word8 -> Word8 -> Word8) -> Bytes -> Bytes -> Maybe Bytes
zipBytes Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
(.|.)

zipBytes :: (Word8 -> Word8 -> Word8) -> Bytes -> Bytes -> Maybe Bytes
zipBytes :: (Word8 -> Word8 -> Word8) -> Bytes -> Bytes -> Maybe Bytes
zipBytes Word8 -> Word8 -> Word8
op Bytes
left Bytes
right
  | [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
lefts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
rights = Maybe Bytes
forall a. Maybe a
Nothing
  | Bool
otherwise = Bytes -> Maybe Bytes
forall a. a -> Maybe a
Just ([Word8] -> Bytes
word8ToBytes ((Word8 -> Word8 -> Word8) -> [Word8] -> [Word8] -> [Word8]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word8 -> Word8 -> Word8
op [Word8]
lefts [Word8]
rights))
  where
    lefts :: [Word8]
    lefts :: [Word8]
lefts = Bytes -> [Word8]
btsToWord8 Bytes
left
    rights :: [Word8]
    rights :: [Word8]
rights = Bytes -> [Word8]
btsToWord8 Bytes
right

btsNot :: Bytes -> Bytes
btsNot :: Bytes -> Bytes
btsNot = [Word8] -> Bytes
word8ToBytes ([Word8] -> Bytes) -> (Bytes -> [Word8]) -> Bytes -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word8
forall a. Bits a => a -> a
complement ([Word8] -> [Word8]) -> (Bytes -> [Word8]) -> Bytes -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> [Word8]
btsToWord8

btsConcat :: Bytes -> Bytes -> Bytes
btsConcat :: Bytes -> Bytes -> Bytes
btsConcat Bytes
left Bytes
right = [Word8] -> Bytes
word8ToBytes (Bytes -> [Word8]
btsToWord8 Bytes
left [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ Bytes -> [Word8]
btsToWord8 Bytes
right)

btsEqual :: Bytes -> Bytes -> Bool
btsEqual :: Bytes -> Bytes -> Bool
btsEqual Bytes
left Bytes
right = Bytes -> [Word8]
btsToWord8 Bytes
left [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
== Bytes -> [Word8]
btsToWord8 Bytes
right

btsSize :: Bytes -> Int
btsSize :: Bytes -> Int
btsSize = [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Word8] -> Int) -> (Bytes -> [Word8]) -> Bytes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> [Word8]
btsToWord8

btsSlice :: Int -> Int -> Bytes -> Maybe Bytes
btsSlice :: Int -> Int -> Bytes -> Maybe Bytes
btsSlice Int
start Int
len Bytes
bts
  | Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
size Bool -> Bool -> Bool
|| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start = Maybe Bytes
forall a. Maybe a
Nothing
  | Bool
otherwise = Bytes -> Maybe Bytes
forall a. a -> Maybe a
Just ([Word8] -> Bytes
word8ToBytes (Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
len (Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
drop Int
start [Word8]
octets)))
  where
    octets :: [Word8]
    octets :: [Word8]
octets = Bytes -> [Word8]
btsToWord8 Bytes
bts
    size :: Int
    size :: Int
size = [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
octets

btsShift :: Int -> Bytes -> Bytes
btsShift :: Int -> Bytes -> Bytes
btsShift Int
bits Bytes
bts
  | Integer
magnitude Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
8 = [Word8] -> Bytes
word8ToBytes (Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
size Word8
0)
  | Int
bits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Word8] -> Bytes
word8ToBytes ((Int -> Word8) -> [Int] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Word8
leftwards [Int]
indices)
  | Bool
otherwise = [Word8] -> Bytes
word8ToBytes ((Int -> Word8) -> [Int] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Word8
rightwards [Int]
indices)
  where
    magnitude :: Integer
    magnitude :: Integer
magnitude = Integer -> Integer
forall a. Num a => a -> a
abs (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
bits)
    octets :: [Word8]
    octets :: [Word8]
octets = Bytes -> [Word8]
btsToWord8 Bytes
bts
    size :: Int
    size :: Int
size = [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
octets
    indices :: [Int]
    indices :: [Int]
indices = [Int
0 .. Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
    modulo :: Int
    modulo :: Int
modulo = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
magnitude Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
8)
    offset :: Int
    offset :: Int
offset = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
magnitude Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
8)
    octet :: Int -> Word8
    octet :: Int -> Word8
octet Int
index = [Word8]
octets [Word8] -> Int -> Word8
forall a. HasCallStack => [a] -> Int -> a
!! Int
index
    rightwards :: Int -> Word8
    rightwards :: Int -> Word8
rightwards Int
index
      | Int
source Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Word8
0
      | Int
source Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Word8
shifted Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Int -> Word8
octet (Int
source Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
modulo)) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
carry)
      | Bool
otherwise = Word8
shifted
      where
        source :: Int
        source :: Int
source = Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset
        shifted :: Word8
        shifted :: Word8
shifted = Int -> Word8
octet Int
source Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
modulo
        carry :: Word8
        carry :: Word8
carry = Word8
0xFF Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
modulo)
    leftwards :: Int -> Word8
    leftwards :: Int -> Word8
leftwards Int
index
      | Int
source Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
size = Word8
0
      | Int
source Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size = Word8
shifted Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. ((Int -> Word8
octet (Int
source Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
modulo)) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
carry)
      | Bool
otherwise = Word8
shifted
      where
        source :: Int
        source :: Int
source = Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset
        shifted :: Word8
        shifted :: Word8
shifted = Int -> Word8
octet Int
source Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
modulo
        carry :: Word8
        carry :: Word8
carry = (Word8
0x01 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
modulo) Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
1