module Wrap where

import Control.Monad(liftM)
import Data.Array(Array)
import Data.Bits(Bits(..))
import Data.Int(Int32,Int64)
import Foreign(Ptr, nullPtr,
               Storable(peekByteOff),
               allocaBytes, withForeignPtr,ForeignPtr,plusPtr,peekElemOff)
import Foreign.C(CSize,CInt,CChar)
import Foreign.C.String(CString)

type CRegex = ()

type RegOffset = Int64

type CompOption = CInt
type ExecOption = CInt
type ReturnCode = CInt

data Regex = Regex (ForeignPtr CRegex) CompOption ExecOption

type WrapError = (ReturnCode,String)

wrapCount :: Regex -> CString
          -> IO (Either WrapError Int)

type CRegMatch = ()

foreign import ccall unsafe "regexec"
  c_regexec :: Ptr CRegex -> CString -> CSize
            -> Ptr CRegMatch -> ExecOption -> IO ReturnCode

nullTest :: Ptr a -> String -> IO (Either WrapError b) -> IO (Either WrapError b)
nullTest ptr msg io = do
  if nullPtr == ptr
    then return (Left (0,"Ptr parameter was nullPtr in Text.Regex.TRE.Wrap."++msg))
    else io

isNewline,isNull :: Ptr CChar -> Int -> IO Bool
isNewline cstr pos = liftM (newline ==) (peekElemOff cstr pos)
  where newline = toEnum 10
isNull cstr pos = liftM (nullChar ==) (peekElemOff cstr pos)
  where nullChar = toEnum 0

wrapError :: ReturnCode -> Ptr CRegex -> IO (Either WrapError b)
wrapError = undefined

doMatch :: Ptr CRegex -> CString -> CSize -> Ptr CRegMatch -> ExecOption
        -> IO (Either WrapError (Maybe [(RegOffset,RegOffset)]))
doMatch regex_ptr cstr nsub p_match flags = do
  r <- c_regexec regex_ptr cstr (1 + nsub) p_match flags
  if r == 0
    then do
       regions <- mapM getOffsets . take (1+fromIntegral nsub)
                  . iterate (`plusPtr` (8)) $ p_match
       return (Right (Just regions))
    else if r == 1
       then return (Right Nothing)
       else wrapError r regex_ptr
  where
    getOffsets :: Ptr CRegMatch -> IO (RegOffset,RegOffset)
    getOffsets pmatch' = do
      start <- (\hsc_ptr -> peekByteOff hsc_ptr 0) pmatch' :: IO (Int32)
      end   <- (\hsc_ptr -> peekByteOff hsc_ptr 4) pmatch' :: IO (Int32)
      return (fromIntegral start,fromIntegral end)

wrapMatchAll :: Regex -> CString -> IO (Either WrapError ())
wrapMatchAll (Regex regex_fptr compileOptions flags) cstr = do
 nullTest cstr "wrapMatchAll cstr" $ do
  if (0 /= 8 .&. compileOptions)
    then undefined
    else do
      withForeignPtr regex_fptr $ \regex_ptr -> do
        nsub <- (\hsc_ptr -> peekByteOff hsc_ptr 48) regex_ptr :: IO CSize
        let nsub_int,nsub_bytes :: Int
            nsub_int = fromIntegral nsub
            nsub_bytes = (1 + nsub_int) * 8

        allocaBytes nsub_bytes $ \p_match -> do
         nullTest p_match "wrapMatchAll p_match" $ do
          let flagsBOL = complement 1 .&. flags
              flagsMIDDLE = 1 .|. flags
              atBOL pos = doMatch regex_ptr (plusPtr cstr pos) nsub p_match flagsBOL
              atMIDDLE pos = doMatch regex_ptr (plusPtr cstr pos) nsub p_match flagsMIDDLE
              loop acc old (s,e) | acc `seq` old `seq` False = undefined
                                 | s == e = do
                let pos = old + fromIntegral e
                atEnd <- isNull cstr pos
                if atEnd then return (Left undefined)
                  else loop acc old (s,succ e)
                                 | otherwise = do
                let pos = old + fromIntegral e
                prev'newline <- isNewline cstr (pred pos)
                result <- if prev'newline then atBOL pos else atMIDDLE pos
                case result of
                  Right Nothing -> return (Left undefined)
                  Right (Just parts@(whole:_)) -> let ma = toMA pos parts
                                                 in loop (acc.(ma:)) pos whole
                  Left err -> return (Left err)
                  Right (Just []) -> return (Left undefined)
          result <- doMatch regex_ptr cstr nsub p_match flags
          case result of
            Right Nothing -> return (Left undefined)
            Right (Just parts@(whole:_)) -> let ma = toMA 0 parts
                                            in loop (ma:) 0 whole
            Left err -> return (Left err)
            Right (Just []) -> return (Left undefined)
  where
    toMA :: Int -> [(RegOffset,RegOffset)] -> Array Int (Int,Int)
    toMA = undefined

wrapCount (Regex regex_fptr compileOptions flags) cstr = do
 nullTest cstr "wrapCount cstr" $ do
  if (0 /= 8 .&. compileOptions)
    then do
      r <- undefined
      case r of
        Right True -> return (Right 1)
        Right False -> return (Right 0)
        Left err -> return (Left err)
    else do
      withForeignPtr regex_fptr $ \regex_ptr -> do
        allocaBytes 8 $ \p_match -> do
         nullTest p_match "wrapCount p_match" $ do
          let flagsBOL = complement 1 .&. flags
              flagsMIDDLE = 1 .|. flags
              atBOL pos = doMatch regex_ptr (plusPtr cstr pos) 0 p_match flagsBOL
              atMIDDLE pos = doMatch regex_ptr (plusPtr cstr pos) 0 p_match flagsMIDDLE
              loop acc old (s,e) | acc `seq` old `seq` False = undefined
                                 | s == e = do
                let pos = old + fromIntegral e
                atEnd <- isNull cstr pos
                if atEnd then return (Right acc)
                  else loop acc old (s,succ e)
                                 | otherwise = do
                let pos = old + fromIntegral e
                prev'newline <- isNewline cstr (pred pos)
                result <- if prev'newline then atBOL pos else atMIDDLE pos
                case result of
                  Right Nothing -> return (Right acc)
                  Right (Just (whole:_)) -> loop (succ acc) pos whole
                  Left err -> return (Left err)
                  Right (Just []) -> return (Right acc)
          result <- doMatch regex_ptr cstr 0 p_match flags
          case result of
            Right Nothing -> return (Right 0)
            Right (Just (whole:_)) -> loop 1 0 whole
            Left err -> return (Left err)
            Right (Just []) -> return (Right 0)