-- |
-- Module    : G500.GenerateFIle
-- Copyright : (C) 2013 Parallel Scientific Labs, LLC.
-- License   : GPLv2
--
-- File generation utilities.

module G500.GenerateFile
    ( generateWriteFile
    , GraphType(..)
    ) where

import G500
import System.IO
import Data.Word (Word8)
import Control.Monad
import Data.Array.IO
import Data.Bits

-------------------------------------------------------------------------------
-- Graph edges generation.

data GraphType = Graph500 | Simple

generateGraph :: GraphType -> Int -> Int -> IO (IOUArray Index Index, IOUArray Index Index)
generateGraph Simple scale edgeFactor = do
	fromA <- newArray (0,maxEdgeIndex) 0
	toA <- newArray (0,maxEdgeIndex) 0
	forM_ [1..factor] $ \n -> do
		let ofs = ((n-1)*verticesCount)
		writeEdges fromA ofs 0	-- start is always the same index
		writeEdges toA   ofs n	-- end varies from 1 to edgeFactor
	return (fromA, toA)
	where
		verticesCount = (2 :: Index) ^ scale
		maxVertexIndex = verticesCount - 1
		maxEdgeIndex = verticesCount * factor - 1
		factor :: Index
		factor = fromIntegral edgeFactor
		writeEdges arr indexOfs indexInc = do
			forM_ [0..maxVertexIndex] $ \i -> do
				writeArray arr (i+indexOfs) (min (i+indexInc) maxVertexIndex)
generateGraph Graph500 scale edgeFactor = do
	when (edgeFactor /= 16) $ putStrLn "It is preferable for edgeFactor to be 16 in Graph500 benchmark data."
	generate scale edgeFactor


-- | Generage file with graph
generateWriteFile :: String     -- ^ Filename
                  -> GraphType  -- ^ Type of the graph
                  -> Int        -- ^ Scale
                  -> Int        -- ^ Edge factor
                  -> IO ()
generateWriteFile fn ty scale edgeFactor = do
	(start,end) <- generateGraph ty scale edgeFactor
	buffer <- mkBuffer
	h <- openBinaryFile fn WriteMode
	write h 0 buffer start end
	hClose h
	where
		verticesExpected :: Index
		verticesExpected = shiftL 1 scale
		bufferPairs = min verticesExpected 8192
		bufferIndices = bufferPairs*2
		bufferBytes = fromIntegral (8*bufferIndices)

		mkBuffer :: IO (IOUArray Int Word8)
		mkBuffer = newArray (0,bufferBytes-1) 0

		write h start buffer edgeStart edgeEnd = do
			(_,top) <- getBounds edgeStart
			if start > top then return ()
				else do
					fill start buffer edgeStart edgeEnd
					-- !!! HACK !!!
					-- Int64 is not a Storable instance.
					hPutArray h buffer (8*fromIntegral bufferIndices)
					write h (start+bufferPairs) buffer edgeStart edgeEnd
		fill start buffer edgeStart edgeEnd = do
			forM_ [0..bufferPairs-1] $ \i -> do
				s <- readArray edgeStart (start + i)
				e <- readArray edgeEnd (start + i)
				writeIndexAsBytes buffer (fromIntegral i*2  ) s
				writeIndexAsBytes buffer (fromIntegral i*2+1) e
		writeIndexAsBytes :: IOUArray Int Word8 -> Int -> Index -> IO ()
		writeIndexAsBytes arr i ix = do
			forM_ [0..7] $ \s -> do
				writeArray arr (i*8 + s) (fromIntegral $ shiftR ix (s*8))