{-|
Module      : Nauty.Graph6.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.Graph6" module.
Except for test cases, you should not import this module.
-}

{-# LANGUAGE OverloadedStrings #-}

module Nauty.Graph6.Internal where

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

-- |A graph represented as an adjacency matrix.
data AdjacencyMatrix = AdjacencyMatrix
  { AdjacencyMatrix -> Word64
numberOfVertices :: Word64
  -- |The upper diagonal of 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 two vertices are adjacent.
areAdjacent :: AdjacencyMatrix -> Word64 -> Word64 -> Bool
areAdjacent :: AdjacencyMatrix -> Word64 -> Word64 -> Bool
areAdjacent AdjacencyMatrix
m Word64
v Word64
u
  | Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
u = AdjacencyMatrix -> Word64 -> Word64 -> Bool
areAdjacent AdjacencyMatrix
m Word64
u Word64
v
  | Bool
otherwise = 
    let i :: Word64
i = Word64
v Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (((Word64
u) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* (Word64
u Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
2)
        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 into @graph6@ format.
encode :: AdjacencyMatrix -> T.Text
encode :: AdjacencyMatrix -> Text
encode AdjacencyMatrix
m = 
  (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 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
2)
      lastValidBits :: Word64
lastValidBits = Word64
bits Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`mod` Word64
8
  in
  if Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
1 Bool -> Bool -> Bool
&& [Word8
0] [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
== (UArray Word64 Word8 -> [Word8]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems (AdjacencyMatrix -> UArray Word64 Word8
adjacency AdjacencyMatrix
m)) then
    Text
""
  else
    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 edges.
-- Vertices need to be in the range from @0@ to @n - 1@.
fromEdgeList :: Word64 -- ^ Number of vertices
             -> [(Word64, Word64)] -- ^ List of edges
             -> AdjacencyMatrix
fromEdgeList :: Word64 -> [(Word64, Word64)] -> AdjacencyMatrix
fromEdgeList Word64
n [(Word64, Word64)]
es = 
  let m :: Word64
m = if Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
1 then Word64
0 else (((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
2) 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
  in
  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
m)
      [ (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 (Word64
v', Word64
u') = if Word64
v Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
u then (Word64
v,Word64
u) else (Word64
u,Word64
v)
      , let bitI :: Word64
bitI = Word64
v' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (((Word64
u') Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* (Word64
u' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
2)
      , let block :: Word64
block = Word64
bitI Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
8
      ]
  }

-- |The list of edges of a graph together with the number of vertices.
toEdgeList :: AdjacencyMatrix -> (Word64, [(Word64, Word64)])
toEdgeList :: AdjacencyMatrix -> (Word64, [(Word64, Word64)])
toEdgeList AdjacencyMatrix
m =
  ( AdjacencyMatrix -> Word64
numberOfVertices AdjacencyMatrix
m
  , Int -> Word64 -> Word64 -> [Word8] -> [(Word64, Word64)]
forall {a}.
Bits a =>
Int -> Word64 -> Word64 -> [a] -> [(Word64, Word64)]
edges Int
7 Word64
0 Word64
1 ([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
    edges :: Int -> Word64 -> Word64 -> [a] -> [(Word64, Word64)]
edges Int
_ Word64
_ Word64
_ [] = []
    edges 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)]
edges Int
7 Word64
v Word64
u [a]
bs
      | Word64
v Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
u = Int -> Word64 -> Word64 -> [a] -> [(Word64, Word64)]
edges Int
i Word64
0 (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)
      | Word64
u 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)]
edges (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Word64
vWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
1) Word64
u (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bs)
        else
          Int -> Word64 -> Word64 -> [a] -> [(Word64, Word64)]
edges (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Word64
vWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
1) Word64
u (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bs)

-- |Parse all graphs in the input text.
-- Graphs 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
">>graph6<<" Text
t
  in (Text -> Either Text AdjacencyMatrix)
-> [Text] -> [Either Text AdjacencyMatrix]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Either Text AdjacencyMatrix
graph ([Text] -> [Either Text AdjacencyMatrix])
-> [Text] -> [Either Text AdjacencyMatrix]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
t'

-- |Parse a single graph in @graph6@ format.
graph :: T.Text -> Either T.Text AdjacencyMatrix
graph :: Text -> Either Text AdjacencyMatrix
graph 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
  Word64
n <- StateT ByteString (Either Text) Word64
parseNumber
  Word64 -> StateT ByteString (Either Text) AdjacencyMatrix
parseMatrix Word64
n

-- |Parse the adjacency matrix of a graph.
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 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
2)
  let m :: Word64
m = if Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
1 then Word64
0 else (((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
2) 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
  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
m )
                          ([(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
    }