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 -- Interface to the POSIX regular expression library.
  12 -- ToDo: should have an interface using PackedStrings.
  13 --
  14 -----------------------------------------------------------------------------
  15
  16 module Text.Regex.Posix (
  17         Regex,          -- abstract
  18
  19         regcomp,        -- :: String -> Int -> IO Regex
  20
  21         regexec,        -- :: Regex                  -- pattern
  22                         -- -> String                 -- string to match
  23                         -- -> IO (Maybe (String,     -- everything before match
  24                         --               String,     -- matched portion
  25                         --               String,     -- everything after match
  26                         --               [String]))  -- subexpression matches
  27
  28         regExtended,    -- (flag to regcomp) use extended regex syntax
  29         regIgnoreCase,  -- (flag to regcomp) ignore case when matching
  30         regNewline      -- (flag to regcomp) '.' doesn't match newline
  31   ) where
  32
  33 #include <sys/types.h>
  34 #include "regex.h"
  35
  36 import Prelude
  37
  38 import Foreign
  39 import Foreign.C
  40
  41 newtype Regex = Regex (ForeignPtr CRegex)
  42
  43 -- -----------------------------------------------------------------------------
  44 -- regcomp
  45
  46 regcomp :: String -> Int -> IO Regex
  47 regcomp pattern flags = do
  48   regex_ptr <- mallocBytes (#const sizeof(regex_t))
  49   regex_fptr <- newForeignPtr regex_ptr (regfree regex_ptr)
  50   r <- withCString pattern $ \cstr ->
  51          withForeignPtr regex_fptr $ \p ->
  52            c_regcomp p cstr (fromIntegral flags)
  53   if (r == 0)
  54      then return (Regex regex_fptr)
  55      else error "Text.Regex.Posix.regcomp: error in pattern" -- ToDo
  56
  57 regfree :: Ptr CRegex -> IO ()
  58 regfree p_regex = do
  59   c_regfree p_regex
  60   free p_regex
  61
  62 -- -----------------------------------------------------------------------------
  63 -- regexec
  64
  65 regexec :: Regex                        -- pattern
  66         -> String                       -- string to match
  67         -> IO (Maybe (String,           -- everything before match
  68                       String,           -- matched portion
  69                       String,           -- everything after match
  70                       [String]))        -- subexpression matches
  71
  72 regexec (Regex regex_fptr) str = do
  73   withCString str $ \cstr -> do
  74     withForeignPtr regex_fptr $ \regex_ptr -> do
  75       nsub <- (#peek regex_t, re_nsub) regex_ptr
  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_ptr 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 ccall unsafe "regcomp"
 148   c_regcomp :: Ptr CRegex -> CString -> CInt -> IO CInt
 149
 150 foreign import ccall  unsafe "regfree"
 151   c_regfree :: Ptr CRegex -> IO ()
 152
 153 foreign import ccall unsafe "regexec"
 154   c_regexec :: Ptr CRegex -> CString -> CSize
 155             -> Ptr CRegMatch -> CInt -> IO CInt