Sequence.hs

{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans #-}
{-| 
This modules provides 'RegexMaker' and 'RegexLike' instances for using
'Seq Char' 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.Sequence(
  -- ** Types
  Regex
 ,MatchOffset
 ,MatchLength
 ,CompOption
 ,ExecOption
  -- ** Medium level API functions
 ,compile
 ,execute
 ,regexec
 ) where

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

instance RegexContext Regex (Seq Char) (Seq Char) where
  match = polymatch
  matchM = polymatchM

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

compile  :: CompOption -- ^ Flags (summed together)
         -> ExecOption -- ^ Flags (summed together)
         -> Seq Char   -- ^ The regular expression to compile
         -> Either String Regex -- ^ Returns: the compiled regular expression
compile compOpt execOpt source =
  case parseRegex (toList 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
        -> Seq Char   -- ^ Seq Char to match against
        -> Either String (Maybe (Array Int (MatchOffset,MatchLength)))
execute r s = Right (matchOnce r s)

regexec :: Regex      -- ^ Compiled regular expression
        -> Seq Char   -- ^ Seq Char to match against
        -> Either String (Maybe (Seq Char, Seq Char, Seq Char, [Seq Char]))
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 (Seq Char) where
  makeRegexOpts c e source = unwrap $ compile c e source
  makeRegexOptsM c e source = either fail return $ compile c e source

instance RegexLike Regex (Seq Char) 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