{-# LANGUAGE CPP, BangPatterns #-}
module Data.RangeMin.Int (
	unsafeIntRangeMin,
	intRangeMin) where

import Control.Exception
import Data.RangeMin.Common
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Primitive as PV
import qualified Data.RangeMin.Int.Quadratic as N2
import qualified Data.RangeMin.Int.Linearithmic as Nlogn
import qualified Data.RangeMin.Int.NearLinear as NearN
import qualified Data.RangeMin.Int.Linear as N

negativeStart :: Int -> String
negativeStart i = "Data.RangeMin: starting index " ++ shows i " must be nonnegative" 

nonPositiveWidth :: Int -> String
nonPositiveWidth m = "Data.RangeMin: query width " ++ shows m " must be positive"

outOfBoundsQuery :: Int -> Int -> Int -> String
outOfBoundsQuery n i m = "Data.RangeMin: query " ++ shows (i, m) 
	(" is too big for a vector of size " ++ show n)

checkBounds :: Int -> (Int -> Int -> a) -> Int -> Int -> a
checkBounds !n f !i !m
	| i < 0	= throw (IndexOutOfBounds (negativeStart i))
	| m < 1 = throw (IndexOutOfBounds (nonPositiveWidth m))
	| i + m > n
		= throw (IndexOutOfBounds (outOfBoundsQuery n i m))
	| otherwise
		= f i m

internalIntRangeMin :: PV.Vector Int -> RM
internalIntRangeMin !xs
  | n <= n2Cross	= N2.rangeMin xs
  | n <= nlognCross	= Nlogn.rangeMin xs
  | n <= nearNCross	= NearN.rangeMin xs
  | otherwise		= N.rangeMin xs
  where !n = PV.length xs

#define vec ('PV.fromList' [0,7,-10,4,5,4])
-- | /O(n)/.  Returns a range-min function on the vector, under the natural ordering of 'Int'.
-- This function can be, depending on the 'G.Vector' implementation, three to four
-- times as fast as @'unsafeVecRangeMinBy' ('<=')@.
-- 
-- Example:
-- 
-- @
-- 'unsafeIntRangeMin' vec 0 6 == 2
-- 'unsafeIntRangeMin' vec 2 3 == 2
-- 'unsafeIntRangeMin' vec 3 3 == 3
-- @
-- 
-- The returned function /does not/ do bounds checks.  If @n@ is the length of the vector,
-- and @i@ and @m@ are passed as arguments to the 'RangeMin', then if @i < 0@, @m < 1@, or
-- @i + m > n@, a segfault may occur.
unsafeIntRangeMin :: 
	PV.Vector Int	-- ^ A vector of 'Int's.
	-> RangeMin	-- ^ A range-min function on the vector which runs in /O(1)/.
unsafeIntRangeMin xs = runRM (internalIntRangeMin xs)

-- | /O(n)/.  Returns a range-min function on the vector, with the natural ordering of 'Int'.
-- This function can be, depending on the 'G.Vector' implementation, three to four
-- times as fast as @'vecRangeMinBy' ('<=')@.
-- 
-- Equivalent to 'unsafeIntRangeMin', except that the returned function /does/ do bounds checks.
-- When it receives a bad query, it throws an 'ArrayException'.
intRangeMin :: 
	PV.Vector Int	-- ^ A vector of 'Int's.
	-> RangeMin	-- ^ A range-min function on the vector which runs in /O(1)/.
intRangeMin !xs = 
  let !rM = internalIntRangeMin xs in checkBounds (PV.length xs) (runRM rM)