-----------------------------------------------------------------------------
$Id: RegexString.lhs,v 1.4 2000/01/14 10:25:19 simonmar Exp $

A simple high-level interface to Regex

(c) Simon Marlow 1997-1999

Modified 1999 by Ian Jackson to fix an apparent fatal bug (?!)  and to
provide matchRegexAll.
-----------------------------------------------------------------------------

> module RegexString (
>    Regex, 
>    mkRegex, 
>    matchRegex, 
>    matchRegexAll,
>    MatcherFlag(..)) where

> import Regex
> import PackedString
> import Array
> import GlaExts

> type Regex = PatBuffer
> 
> class RegExable regex where
>    mkRegex :: regex -> Regex
> 
> instance RegExable String where
>    mkRegex s = mkRegex (s,[]::[MatcherFlag])
>
> instance RegExable (String,[MatcherFlag]) where
>    mkRegex (s,flags) = 
>       unsafePerformPrimIO (
>          re_compile_pattern 
>            (packString s)
>            (lineModeIsSingle flags) (caseInSensitive flags)
>          )
> 
> data MatcherFlag = Case_Insensitive | Case_Sensitive | Single_Line | Multi_Line
> -- (names stolen from the old Haskell RegExp library).
>
> caseInSensitive :: [MatcherFlag] -> Bool
> caseInSensitive [] = False
> caseInSensitive (Case_Sensitive : _) = False
> caseInSensitive (Case_Insensitive : _) = True
> caseInSensitive (_ : rest) = caseInSensitive rest
>
> lineModeIsSingle :: [MatcherFlag] -> Bool
> lineModeIsSingle [] = False
> lineModeIsSingle (Single_Line : _) = True
> lineModeIsSingle (Multi_Line : _) = False
> lineModeIsSingle (_ : rest) = lineModeIsSingle rest
> 
> matchRegex :: Regex -> String -> Maybe [String]
> matchRegex = matchRegexIB matches
> 
> matchRegexAll :: Regex -> String ->
>         Maybe ( String, -- $`
>                 String, -- $&
>                 String, -- $'
>                 String, -- $+
>                 [String] -- $1..
>               )
> matchRegexAll = matchRegexIB matchesAll
>
> matchRegexIB interpretBy p s = unsafePerformPrimIO (
>         re_match p str 0 True >>= \m ->
>         case m of
>                 Nothing -> return Nothing
>                 Just m  -> return (Just (interpretBy m str))
>         )
>    where
>         str = packString s
>
> matches (REmatch arr _ _ _ _) s = map (getFromBounds s) (elems arr)
>
> matchesAll rm@(REmatch _ before entire after lastbracket) s =
>         ( g before, g entire, g after, g lastbracket, matches rm s )
>    where
>         g = getFromBounds s
>
> getFromBounds s (beg,end) = unpackPS (substrPS s beg (end-1))