{-|
Module      : Nauty.Parsing.Internal
Description : Internal functions for parsing.
Copyright   : (c) Marcelo Garlet Milani, 2026
License     : MIT
Maintainer  : mgmilani@pm.me
Stability   : unstable

This module contains internal functions used by other modules.
Except for test cases, you should not import this module.
-}

module Nauty.Internal.Parsing where

import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import qualified Data.ByteString.Lazy as B
import qualified Data.Text.Lazy as T
import Data.Bits
import Data.Word

-- | Read the given number of bytes.
consume :: Word64 -> StateT B.ByteString (Either T.Text) B.ByteString
consume :: Word64 -> StateT ByteString (Either Text) ByteString
consume Word64
l = do
  ByteString
b <- StateT ByteString (Either Text) ByteString
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let l' :: Int64
l' = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
l
  if (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length ByteString
b) Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
l then
     Either Text ByteString
-> StateT ByteString (Either Text) ByteString
forall (m :: * -> *) a. Monad m => m a -> StateT ByteString m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either Text ByteString
 -> StateT ByteString (Either Text) ByteString)
-> Either Text ByteString
-> StateT ByteString (Either Text) ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ByteString
forall a b. a -> Either a b
Left (Text -> Either Text ByteString) -> Text -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
       [ Text
"Error: ByteString has length "
       , (Int64 -> Text
forall a. Show a => a -> Text
T.show (Int64 -> Text) -> Int64 -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length ByteString
b)
       , Text
", but "
       , Word64 -> Text
forall a. Show a => a -> Text
T.show Word64
l
       , Text
" bytes were requested"
       ]
  else do
    ByteString -> StateT ByteString (Either Text) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (ByteString -> StateT ByteString (Either Text) ())
-> ByteString -> StateT ByteString (Either Text) ()
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
B.drop Int64
l' ByteString
b
    ByteString -> StateT ByteString (Either Text) ByteString
forall a. a -> StateT ByteString (Either Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> StateT ByteString (Either Text) ByteString)
-> ByteString -> StateT ByteString (Either Text) ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
B.take Int64
l' ByteString
b

-- | Read bytes until the given condition evaluates to false.
consumeWhile :: (Word8 -> Bool) -> StateT B.ByteString (Either T.Text) B.ByteString
consumeWhile :: (Word8 -> Bool) -> StateT ByteString (Either Text) ByteString
consumeWhile Word8 -> Bool
p = do
  ByteString
b <- StateT ByteString (Either Text) ByteString
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let (ByteString
b0, ByteString
b1) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span Word8 -> Bool
p ByteString
b
  ByteString -> StateT ByteString (Either Text) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put ByteString
b1
  ByteString -> StateT ByteString (Either Text) ByteString
forall a. a -> StateT ByteString (Either Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b0

-- | Parse a single number.
parseNumber :: StateT B.ByteString (Either T.Text) Word64
parseNumber :: StateT ByteString (Either Text) Word64
parseNumber = do
  ByteString
size <- (Word8 -> Bool) -> StateT ByteString (Either Text) ByteString
consumeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==Word8
126)
  if ByteString -> Int64
B.length ByteString
size Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 then do
    ByteString
be <- Word64 -> StateT ByteString (Either Text) ByteString
consume Word64
1
    Word64 -> StateT ByteString (Either Text) Word64
forall a. a -> StateT ByteString (Either Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> StateT ByteString (Either Text) Word64)
-> Word64 -> StateT ByteString (Either Text) Word64
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> Word8 -> Word64
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
be) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
63
  else do 
    ByteString
be <- Word64 -> StateT ByteString (Either Text) ByteString
parseVector (Word64
18 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ Int64
1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ ByteString -> Int64
B.length ByteString
size))
    Word64 -> StateT ByteString (Either Text) Word64
forall a. a -> StateT ByteString (Either Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> StateT ByteString (Either Text) Word64)
-> Word64 -> StateT ByteString (Either Text) Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Word64
bigendian ByteString
be

-- | Parse a single number with big-endian encoding.
bigendian :: B.ByteString -> Word64
bigendian :: ByteString -> Word64
bigendian ByteString
bs = (Word8 -> Word64 -> Word64) -> Word64 -> [Word8] -> Word64
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Word8
b Word64
n -> (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL Word64
n 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
b)) Word64
0 ([Word8] -> Word64) -> [Word8] -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
bs

-- | Parse a vector with the given amount bits.
parseVector :: Word64 -> StateT B.ByteString (Either T.Text) B.ByteString
parseVector :: Word64 -> StateT ByteString (Either Text) ByteString
parseVector Word64
len = do
  ByteString
v <- Word64 -> StateT ByteString (Either Text) ByteString
consume ((Word64
len Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
5) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
6)
  let ([Word8]
bs, Word8
_) = (([Word8], Word8) -> Word8 -> ([Word8], Word8))
-> ([Word8], Word8) -> ByteString -> ([Word8], Word8)
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl'
              ([Word8], Word8) -> Word8 -> ([Word8], Word8)
append6Bits
              ([], Word8
0)
              ByteString
v
  if (Word64
8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* ((Word64
len Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
7)Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
8)) Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< (Word64
6 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* ((Word64
len Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
5) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
6)) then
    ByteString -> StateT ByteString (Either Text) ByteString
forall a. a -> StateT ByteString (Either Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> StateT ByteString (Either Text) ByteString)
-> ByteString -> StateT ByteString (Either Text) ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> [Word8]
forall a. [a] -> [a]
reverse ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
drop Int
1 [Word8]
bs
  else
    ByteString -> StateT ByteString (Either Text) ByteString
forall a. a -> StateT ByteString (Either Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> StateT ByteString (Either Text) ByteString)
-> ByteString -> StateT ByteString (Either Text) ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> [Word8]
forall a. [a] -> [a]
reverse ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ [Word8]
bs

-- |Put 6 bits to a list of bytes.
append6Bits :: ([Word8], Word8) -> Word8 ->  ([Word8], Word8)
append6Bits :: ([Word8], Word8) -> Word8 -> ([Word8], Word8)
append6Bits ([], Word8
_) Word8
b     = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL (Word8
b Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
63) Int
2 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [], Word8
2)
append6Bits ([Word8]
bs, Word8
0) Word8
b = (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL (Word8
b Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
63) Int
2 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
bs, Word8
2)
append6Bits ((Word8
b0:[Word8]
bs), Word8
s) Word8
b = 
  let b' :: Word8
b' = Word8
b Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
63
      s' :: Int
s' = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
6 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
s
      b1 :: Word8
b1 = Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftR Word8
b' Int
s'
      b2 :: Word8
b2 = Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
b' (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
s Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
2
  in 
  if Word8
s Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
6 then
    ((Word8
b0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
b1) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
bs, Word8
0)
  else
    (Word8
b2 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: (Word8
b0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
b1) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
bs, (Word8
s Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
2) Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
`mod` Word8
8)

-- | Parse an optional header.
-- Returns the rest of the file.
header :: T.Text -> T.Text -> T.Text
header :: Text -> Text -> Text
header Text
h Text
t
  | Text
h Text -> Text -> Bool
`T.isPrefixOf` Text
t = Int64 -> Text -> Text
T.drop (Text -> Int64
T.length Text
h) Text
t
  | Bool
otherwise = Text
t

-- | Skips the header. Returns the rest of the text.
ignoreHeader :: T.Text -> T.Text
ignoreHeader :: Text -> Text
ignoreHeader Text
txt
  | Text
">>" Text -> Text -> Bool
`T.isPrefixOf` Text
txt = 
      let t1 :: Text
t1 = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<') Text
txt in
      if Text
"<<" Text -> Text -> Bool
`T.isPrefixOf` Text
t1 then
        Int64 -> Text -> Text
T.drop Int64
2 Text
t1
      else
        Text
txt
  | Bool
otherwise = Text
txt