String.hs

{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans #-}
{-| 
This modules provides 'RegexMaker' and 'RegexLike' instances for using
'String' with the DFA backend ("Text.Regex.Lib.WrapDFAEngine" and
"Text.Regex.Lazy.DFAEngine").  This module is usually used via import
"Text.Regex.DFA".

This exports instances of the high level API and the medium level
API of 'compile','execute', and 'regexec'.
-}
module Text.Regex.DFA.String(
  -- ** Types
  Regex
 ,MatchOffset
 ,MatchLength
 ,CompOption
 ,ExecOption
  -- ** Medium level API functions
 ,compile
 ,execute
 ,regexec
 ) where

import Data.Array(listArray,Array,elems,(!))
import Text.Regex.DFA.ReadRegex(parseRegex)
import Text.Regex.Base.RegexLike(RegexMaker(..),RegexLike(..),RegexContext(..),MatchOffset,MatchLength)
import Text.Regex.DFA.Wrap(Regex(..),CompOption,ExecOption,makeCompat)
import Text.Regex.DFA.Engine(findRegex,matchesRegex,countRegex,accept)
import Text.Regex.DFA.Transitions(noLoop)
import Text.Regex.Base.Impl(polymatch,polymatchM)

instance RegexContext Regex String String where
  match = polymatch
  matchM = polymatchM

unwrap :: Either String v -> v
unwrap x = case x of Left err -> error ("Text.Regex.Parsec.String died: "++ err)
                     Right v -> v

compile  :: CompOption -- ^ Flags (summed together)
         -> ExecOption -- ^ Flags (summed together)
         -> String     -- ^ The regular expression to compile (ASCII only, no null bytes)
         -> Either String Regex -- ^ Returns: the compiled regular expression
compile compOpt execOpt source =
  case parseRegex source of
    Left err -> Left ("parseRegex for DFA failed:"++show err)
    Right (patternRead,_) ->
      let pattern = noLoop patternRead
          lexer = accept (makeCompat compOpt pattern)
      in Right (Regex pattern lexer compOpt execOpt)

execute :: Regex      -- ^ Compiled regular expression
        -> String     -- ^ String to match against
        -> Either String (Maybe (Array Int (MatchOffset,MatchLength)))
execute r s = Right (matchOnce r s)

regexec :: Regex      -- ^ Compiled regular expression
        -> String     -- ^ String to match against
        -> Either String (Maybe (String, String, String, [String]))
regexec r s =
  case matchOnceText r s of
    Nothing -> Right (Nothing)
    Just (pre,mt,post) ->
      let main = fst (mt!0)
          rest = map fst (tail (elems mt)) -- will be []
      in Right (Just (pre,main,post,rest))

instance RegexMaker Regex CompOption ExecOption String where
  makeRegexOpts c e source = unwrap (compile c e source)
  makeRegexOptsM c e source = either fail return (compile c e source)

instance RegexLike Regex String where
  matchOnce r source =
    case findRegex regex source of
      (_,_,Nothing) -> Nothing
      (_,lenBefore, Just (_,lenOf,_)) -> Just $
        listArray (0,0) [(lenBefore,lenOf)]
    where regex = asLexer r

  matchAll r source = loop 0 source
    where loop n s | n `seq` False = undefined
                   | otherwise =
            case findRegex regex s of
              (_,_,Nothing) -> []
              (_,lenBefore, Just (_,0,_)) ->
                listArray (0,0) [(n+lenBefore,0)] : []
              (_,lenBefore, Just (_,lenOf,s')) -> 
                listArray (0,0) [(n+lenBefore,lenOf)] : loop (n+lenBefore+lenOf) s'
          regex = asLexer r

  matchTest r source = matchesRegex regex source
    where regex = asLexer r

  matchCount r source = countRegex regex source
    where regex = asLexer r