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

This module contains internal functions used by the "Nauty.Digraph6" module.
Except for test cases, you should not import this module.
-}

{-# LANGUAGE OverloadedStrings #-}

module Nauty.Digraph6.Internal where

import           Control.Monad.Trans.Class
import           Control.Monad.Trans.State
import           Data.Bits
import           Data.Word
import           Nauty.Internal.Encoding
import           Nauty.Internal.Parsing
import qualified Data.Array.Unboxed as A
import qualified Data.ByteString.Lazy as B
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Encoding as T

-- | A digraph represented as an adjacency matrix.
data AdjacencyMatrix = AdjacencyMatrix
  { AdjacencyMatrix -> Word64
numberOfVertices :: Word64
  -- | The adjacency matrix, represented as a bit string, stored column-by-column.
  , AdjacencyMatrix -> UArray Word64 Word8
adjacency :: A.UArray Word64 Word8
  } deriving (AdjacencyMatrix -> AdjacencyMatrix -> Bool
(AdjacencyMatrix -> AdjacencyMatrix -> Bool)
-> (AdjacencyMatrix -> AdjacencyMatrix -> Bool)
-> Eq AdjacencyMatrix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AdjacencyMatrix -> AdjacencyMatrix -> Bool
== :: AdjacencyMatrix -> AdjacencyMatrix -> Bool
$c/= :: AdjacencyMatrix -> AdjacencyMatrix -> Bool
/= :: AdjacencyMatrix -> AdjacencyMatrix -> Bool
Eq, Int -> AdjacencyMatrix -> ShowS
[AdjacencyMatrix] -> ShowS
AdjacencyMatrix -> String
(Int -> AdjacencyMatrix -> ShowS)
-> (AdjacencyMatrix -> String)
-> ([AdjacencyMatrix] -> ShowS)
-> Show AdjacencyMatrix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AdjacencyMatrix -> ShowS
showsPrec :: Int -> AdjacencyMatrix -> ShowS
$cshow :: AdjacencyMatrix -> String
show :: AdjacencyMatrix -> String
$cshowList :: [AdjacencyMatrix] -> ShowS
showList :: [AdjacencyMatrix] -> ShowS
Show)
  
-- | Whether there is an arc from the first vertex to the second.
arcExists :: AdjacencyMatrix
          -> Word64 -- ^ Tail
          -> Word64 -- ^ Head
          -> Bool
arcExists :: AdjacencyMatrix -> Word64 -> Word64 -> Bool
arcExists AdjacencyMatrix
m Word64
u Word64
v =
    let i :: Word64
i = Word64
u Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* (AdjacencyMatrix -> Word64
numberOfVertices AdjacencyMatrix
m) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
v 
        b :: Word64
b = Word64
i Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
8
    in Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit ((AdjacencyMatrix -> UArray Word64 Word8
adjacency AdjacencyMatrix
m) UArray Word64 Word8 -> Word64 -> Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
A.! Word64
b) (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8))

-- | Encode a graph in @digraph6@ format.
encode :: AdjacencyMatrix -> T.Text
encode :: AdjacencyMatrix -> Text
encode AdjacencyMatrix
m = 
  Text
"&"
  Text -> Text -> Text
`T.append`
  (Word64 -> Text
encodeNumber (Word64 -> Text) -> Word64 -> Text
forall a b. (a -> b) -> a -> b
$ AdjacencyMatrix -> Word64
numberOfVertices AdjacencyMatrix
m)
  Text -> Text -> Text
`T.append`
  (AdjacencyMatrix -> Text
encodeMatrix AdjacencyMatrix
m)

-- |Encode the adjacency matrix.
encodeMatrix :: AdjacencyMatrix -> T.Text
encodeMatrix :: AdjacencyMatrix -> Text
encodeMatrix AdjacencyMatrix
m = 
  let n :: Word64
n = AdjacencyMatrix -> Word64
numberOfVertices AdjacencyMatrix
m
      bits :: Word64
bits = Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
n
      lastValidBits' :: Word64
lastValidBits' = Word64
bits Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`mod` Word64
8
      lastValidBits :: Word64
lastValidBits = if Word64
lastValidBits' Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then Word64
8 else Word64
lastValidBits'
  in
    String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> (Word8 -> Word8) -> Word8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+Word8
63)) ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ Word64 -> [Word8] -> Word8 -> Int -> [Word8]
encodeVector Word64
lastValidBits (UArray Word64 Word8 -> [Word8]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems (UArray Word64 Word8 -> [Word8]) -> UArray Word64 Word8 -> [Word8]
forall a b. (a -> b) -> a -> b
$ AdjacencyMatrix -> UArray Word64 Word8
adjacency AdjacencyMatrix
m) Word8
0 Int
6

-- | Create an adjacency matrix from a list of arcs.
-- Vertices need to be in the range from @0@ to @n - 1@.
fromArcList :: Word64 -- ^ Number of vertices
            -> [(Word64, Word64)] -- ^ List of arcs
            -> AdjacencyMatrix
fromArcList :: Word64 -> [(Word64, Word64)] -> AdjacencyMatrix
fromArcList Word64
n [(Word64, Word64)]
es = 
  AdjacencyMatrix
  { numberOfVertices :: Word64
numberOfVertices = Word64
n
  , adjacency :: UArray Word64 Word8
adjacency = (Word8 -> Word8 -> Word8)
-> Word8
-> (Word64, Word64)
-> [(Word64, Word8)]
-> UArray Word64 Word8
forall (a :: * -> * -> *) e i e'.
(IArray a e, Ix i) =>
(e -> e' -> e) -> e -> (i, i) -> [(i, e')] -> a i e
A.accumArray Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
(.|.) Word8
0 (Word64
0, ( Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
0 (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ((Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
n) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
8))
      [ (Word64
block, Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
1 (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Word64
bitI Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`mod` Word64
8)))
      | (Word64
v,Word64
u) <- [(Word64, Word64)]
es
      , let bitI :: Word64
bitI = Word64
v Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
u 
      , let block :: Word64
block = Word64
bitI Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
8
      ]
  }

-- | The the number of vertices of a digraph together with a list of its arcs.
toArcList :: AdjacencyMatrix -> (Word64, [(Word64, Word64)])
toArcList :: AdjacencyMatrix -> (Word64, [(Word64, Word64)])
toArcList AdjacencyMatrix
m =
  ( AdjacencyMatrix -> Word64
numberOfVertices AdjacencyMatrix
m
  , Int -> Word64 -> Word64 -> [Word8] -> [(Word64, Word64)]
forall {a}.
Bits a =>
Int -> Word64 -> Word64 -> [a] -> [(Word64, Word64)]
arcs Int
7 Word64
0 Word64
0 ([Word8] -> [(Word64, Word64)]) -> [Word8] -> [(Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ UArray Word64 Word8 -> [Word8]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems (UArray Word64 Word8 -> [Word8]) -> UArray Word64 Word8 -> [Word8]
forall a b. (a -> b) -> a -> b
$ AdjacencyMatrix -> UArray Word64 Word8
adjacency AdjacencyMatrix
m)
  where
    arcs :: Int -> Word64 -> Word64 -> [a] -> [(Word64, Word64)]
arcs Int
_ Word64
_ Word64
_ [] = []
    arcs Int
i Word64
v Word64
u (a
b:[a]
bs)
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 = Int -> Word64 -> Word64 -> [a] -> [(Word64, Word64)]
arcs Int
7 Word64
v Word64
u [a]
bs
      | Word64
u Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== AdjacencyMatrix -> Word64
numberOfVertices AdjacencyMatrix
m = Int -> Word64 -> Word64 -> [a] -> [(Word64, Word64)]
arcs Int
i (Word64
v Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) Word64
0 (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bs)
      | Word64
v Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== AdjacencyMatrix -> Word64
numberOfVertices AdjacencyMatrix
m = []
      | Bool
otherwise = 
        if a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
b Int
i then
          (Word64
v,Word64
u) (Word64, Word64) -> [(Word64, Word64)] -> [(Word64, Word64)]
forall a. a -> [a] -> [a]
: Int -> Word64 -> Word64 -> [a] -> [(Word64, Word64)]
arcs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word64
v (Word64
u Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bs)
        else
          Int -> Word64 -> Word64 -> [a] -> [(Word64, Word64)]
arcs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word64
v (Word64
u Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bs)

-- |Parse all digraphs in the input text.
-- Digraphs are stored one per line.
parse :: T.Text -> [Either T.Text AdjacencyMatrix]
parse :: Text -> [Either Text AdjacencyMatrix]
parse Text
t = 
  let t' :: Text
t' = Text -> Text -> Text
header Text
">>digraph6<<" Text
t
  in (Text -> Either Text AdjacencyMatrix)
-> [Text] -> [Either Text AdjacencyMatrix]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Either Text AdjacencyMatrix
digraph ([Text] -> [Either Text AdjacencyMatrix])
-> [Text] -> [Either Text AdjacencyMatrix]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
t'

-- |Parse a single digraph in @digraph6@ format.
digraph :: T.Text -> Either T.Text AdjacencyMatrix
digraph :: Text -> Either Text AdjacencyMatrix
digraph Text
t = ((StateT ByteString (Either Text) AdjacencyMatrix
 -> ByteString -> Either Text AdjacencyMatrix)
-> ByteString
-> StateT ByteString (Either Text) AdjacencyMatrix
-> Either Text AdjacencyMatrix
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT ByteString (Either Text) AdjacencyMatrix
-> ByteString -> Either Text AdjacencyMatrix
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT) (Text -> ByteString
T.encodeUtf8 Text
t) (StateT ByteString (Either Text) AdjacencyMatrix
 -> Either Text AdjacencyMatrix)
-> StateT ByteString (Either Text) AdjacencyMatrix
-> Either Text AdjacencyMatrix
forall a b. (a -> b) -> a -> b
$ do
  ByteString
h <- Word64 -> StateT ByteString (Either Text) ByteString
consume Word64
1
  if ByteString -> [Word8]
B.unpack ByteString
h [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'&'] then
    Either Text AdjacencyMatrix
-> StateT ByteString (Either Text) AdjacencyMatrix
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 AdjacencyMatrix
 -> StateT ByteString (Either Text) AdjacencyMatrix)
-> Either Text AdjacencyMatrix
-> StateT ByteString (Either Text) AdjacencyMatrix
forall a b. (a -> b) -> a -> b
$ Text -> Either Text AdjacencyMatrix
forall a b. a -> Either a b
Left (Text -> Either Text AdjacencyMatrix)
-> Text -> Either Text AdjacencyMatrix
forall a b. (a -> b) -> a -> b
$ Text
"Expected '&', but found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
h)
  else do
    Word64
n <- StateT ByteString (Either Text) Word64
parseNumber
    if Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then
      AdjacencyMatrix -> StateT ByteString (Either Text) AdjacencyMatrix
forall a. a -> StateT ByteString (Either Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return AdjacencyMatrix{numberOfVertices :: Word64
numberOfVertices = Word64
0, adjacency :: UArray Word64 Word8
adjacency = (Word64, Word64) -> [(Word64, Word8)] -> UArray Word64 Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
A.array (Word64
0,Word64
0) [(Word64
0,Word8
0)]}
    else do
      Word64 -> StateT ByteString (Either Text) AdjacencyMatrix
parseMatrix Word64
n

-- |Parse the adjacency matrix of a digraph.
parseMatrix :: Word64 -> StateT B.ByteString (Either T.Text) AdjacencyMatrix
parseMatrix :: Word64 -> StateT ByteString (Either Text) AdjacencyMatrix
parseMatrix Word64
n = do
  ByteString
v <- Word64 -> StateT ByteString (Either Text) ByteString
parseVector (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
n)
  AdjacencyMatrix -> StateT ByteString (Either Text) AdjacencyMatrix
forall a. a -> StateT ByteString (Either Text) a
forall (m :: * -> *) a. Monad m => a -> m a
return (AdjacencyMatrix
 -> StateT ByteString (Either Text) AdjacencyMatrix)
-> AdjacencyMatrix
-> StateT ByteString (Either Text) AdjacencyMatrix
forall a b. (a -> b) -> a -> b
$ AdjacencyMatrix
    { numberOfVertices :: Word64
numberOfVertices = Word64
n
    , adjacency :: UArray Word64 Word8
adjacency = (Word64, Word64) -> [(Word64, Word8)] -> UArray Word64 Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
A.array (Word64
0, ( Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
0 (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
8)
                          ([(Word64, Word8)] -> UArray Word64 Word8)
-> [(Word64, Word8)] -> UArray Word64 Word8
forall a b. (a -> b) -> a -> b
$ [Word64] -> [Word8] -> [(Word64, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word64
0..] ([Word8] -> [(Word64, Word8)]) -> [Word8] -> [(Word64, Word8)]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
v
    }