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