Text/Regex/Posix.hsc

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Module      :  Text.Regex.Posix
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/core/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable (only on platforms that provide POSIX regexps)
  10 --
  11 -- $Id: Posix.hsc,v 1.2 2001/08/17 12:50:35 simonmar Exp $
  12 --
  13 -- Interface to the POSIX regular expression library.
  14 -- ToDo: detect regex library with configure.
  15 -- ToDo: should have an interface using PackedStrings.
  16 --
  17 -----------------------------------------------------------------------------
  18
  19 module Text.Regex.Posix (
  20         Regex,          -- abstract
  21
  22         regcomp,        -- :: String -> Int -> IO Regex
  23
  24         regexec,        -- :: Regex                  -- pattern
  25                         -- -> String                 -- string to match
  26                         -- -> IO (Maybe (String,     -- everything before match
  27                         --               String,     -- matched portion
  28                         --               String,     -- everything after match
  29                         --               [String]))  -- subexpression matches
  30
  31         regExtended,    -- (flag to regcomp) use extended regex syntax
  32         regIgnoreCase,  -- (flag to regcomp) ignore case when matching
  33         regNewline      -- (flag to regcomp) '.' doesn't match newline
  34   ) where
  35
  36 #include "regex.h"
  37
  38 import Prelude
  39
  40 import Foreign
  41 import Foreign.C
  42
  43 newtype Regex = Regex (ForeignPtr CRegex)
  44
  45 -- -----------------------------------------------------------------------------
  46 -- regcomp
  47
  48 regcomp :: String -> Int -> IO Regex
  49 regcomp pattern flags = do
  50   regex_ptr <- mallocBytes (#const sizeof(regex_t))
  51   regex_fptr <- newForeignPtr regex_ptr (regfree regex_ptr)
  52   withCString pattern $ \cstr -> do
  53     r <- c_regcomp regex_fptr cstr (fromIntegral flags)
  54     if (r == 0)
  55        then return (Regex regex_fptr)
  56        else error "Text.Regex.Posix.regcomp: error in pattern" -- ToDo
  57
  58 regfree :: Ptr CRegex -> IO ()
  59 regfree p_regex = do
  60   c_regfree p_regex
  61   free p_regex
  62
  63 -- -----------------------------------------------------------------------------
  64 -- regexec
  65
  66 regexec :: Regex                        -- pattern
  67         -> String                       -- string to match
  68         -> IO (Maybe (String,           -- everything before match
  69                       String,           -- matched portion
  70                       String,           -- everything after match
  71                       [String]))        -- subexpression matches
  72
  73 regexec (Regex regex_fptr) str = do
  74   withCString str $ \cstr -> do
  75     nsub <- withForeignPtr regex_fptr $ \p -> (#peek regex_t, re_nsub) p
  76     let nsub_int = fromIntegral (nsub :: CSize)
  77     allocaBytes ((1 + nsub_int) * (#const sizeof(regmatch_t))) $ \p_match -> do
  78                 -- add one because index zero covers the whole match
  79       r <- c_regexec regex_fptr cstr (1 + nsub) p_match 0{-no flags for now-}
  80
  81       if (r /= 0) then return Nothing else do
  82
  83       (before,match,after) <- matched_parts str p_match
  84
  85       sub_strs <-
  86           mapM (unpack str) $ take nsub_int $ tail $
  87              iterate (`plusPtr` (#const sizeof(regmatch_t))) p_match
  88
  89       return (Just (before, match, after, sub_strs))
  90
  91 matched_parts :: String -> Ptr CRegMatch -> IO (String, String, String)
  92 matched_parts string p_match = do
  93   start <- (#peek regmatch_t, rm_so) p_match :: IO CInt
  94   end   <- (#peek regmatch_t, rm_eo) p_match :: IO CInt
  95   let s = fromIntegral start; e = fromIntegral end
  96   return ( take (s-1) string,
  97            take (e-s) (drop s string),
  98            drop e string )
  99
 100 unpack :: String -> Ptr CRegMatch -> IO (String)
 101 unpack string p_match = do
 102   start <- (#peek regmatch_t, rm_so) p_match :: IO CInt
 103   end   <- (#peek regmatch_t, rm_eo) p_match :: IO CInt
 104   -- the subexpression may not have matched at all, perhaps because it
 105   -- was optional.  In this case, the offsets are set to -1.
 106   if (start == -1) then return "" else do
 107   return (take (fromIntegral (end-start)) (drop (fromIntegral start) string))
 108
 109 -- -----------------------------------------------------------------------------
 110 -- The POSIX regex C interface
 111
 112 -- Flags for regexec
 113 #enum Int,, \
 114         REG_NOTBOL, \
 115         REG_NOTEOL \
 116
 117 -- Return values from regexec
 118 #enum Int,, \
 119         REG_NOMATCH
 120 --      REG_ESPACE
 121
 122 -- Flags for regcomp
 123 #enum Int,, \
 124         REG_EXTENDED, \
 125         regIgnoreCase = REG_ICASE, \
 126         REG_NOSUB, \
 127         REG_NEWLINE
 128
 129 -- Error codes from regcomp
 130 #enum Int,, \
 131         REG_BADBR, \
 132         REG_BADPAT, \
 133         REG_BADRPT, \
 134         REG_ECOLLATE, \
 135         REG_ECTYPE, \
 136         REG_EESCAPE, \
 137         REG_ESUBREG, \
 138         REG_EBRACK, \
 139         REG_EPAREN, \
 140         REG_EBRACE, \
 141         REG_ERANGE, \
 142         REG_ESPACE
 143
 144 type CRegex    = ()
 145 type CRegMatch = ()
 146
 147 foreign import "regcomp" unsafe
 148   c_regcomp :: ForeignPtr CRegex -> CString -> CInt -> IO CInt
 149
 150 foreign import "regfree" unsafe
 151   c_regfree :: Ptr CRegex -> IO ()
 152
 153 foreign import "regexec" unsafe
 154   c_regexec :: ForeignPtr CRegex -> CString -> CSize
 155             -> Ptr CRegMatch -> CInt -> IO CInt