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.7 2002/04/24 16:31:47 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 <sys/types.h>
  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   r <- withCString pattern $ \cstr ->
  53          withForeignPtr regex_fptr $ \p ->
  54            c_regcomp p cstr (fromIntegral flags)
  55   if (r == 0)
  56      then return (Regex regex_fptr)
  57      else error "Text.Regex.Posix.regcomp: error in pattern" -- ToDo
  58
  59 regfree :: Ptr CRegex -> IO ()
  60 regfree p_regex = do
  61   c_regfree p_regex
  62   free p_regex
  63
  64 -- -----------------------------------------------------------------------------
  65 -- regexec
  66
  67 regexec :: Regex                        -- pattern
  68         -> String                       -- string to match
  69         -> IO (Maybe (String,           -- everything before match
  70                       String,           -- matched portion
  71                       String,           -- everything after match
  72                       [String]))        -- subexpression matches
  73
  74 regexec (Regex regex_fptr) str = do
  75   withCString str $ \cstr -> do
  76     withForeignPtr regex_fptr $ \regex_ptr -> do
  77       nsub <- (#peek regex_t, re_nsub) regex_ptr
  78       let nsub_int = fromIntegral (nsub :: CSize)
  79       allocaBytes ((1 + nsub_int) * (#const sizeof(regmatch_t))) $ \p_match -> do
  80                 -- add one because index zero covers the whole match
  81         r <- c_regexec regex_ptr cstr (1 + nsub) p_match 0{-no flags for now-}
  82
  83         if (r /= 0) then return Nothing else do
  84
  85         (before,match,after) <- matched_parts str p_match
  86
  87         sub_strs <-
  88           mapM (unpack str) $ take nsub_int $ tail $
  89              iterate (`plusPtr` (#const sizeof(regmatch_t))) p_match
  90
  91         return (Just (before, match, after, sub_strs))
  92
  93 matched_parts :: String -> Ptr CRegMatch -> IO (String, String, String)
  94 matched_parts string p_match = do
  95   start <- (#peek regmatch_t, rm_so) p_match :: IO CInt
  96   end   <- (#peek regmatch_t, rm_eo) p_match :: IO CInt
  97   let s = fromIntegral start; e = fromIntegral end
  98   return ( take (s-1) string,
  99            take (e-s) (drop s string),
 100            drop e string )
 101
 102 unpack :: String -> Ptr CRegMatch -> IO (String)
 103 unpack string p_match = do
 104   start <- (#peek regmatch_t, rm_so) p_match :: IO CInt
 105   end   <- (#peek regmatch_t, rm_eo) p_match :: IO CInt
 106   -- the subexpression may not have matched at all, perhaps because it
 107   -- was optional.  In this case, the offsets are set to -1.
 108   if (start == -1) then return "" else do
 109   return (take (fromIntegral (end-start)) (drop (fromIntegral start) string))
 110
 111 -- -----------------------------------------------------------------------------
 112 -- The POSIX regex C interface
 113
 114 -- Flags for regexec
 115 #enum Int,, \
 116         REG_NOTBOL, \
 117         REG_NOTEOL \
 118
 119 -- Return values from regexec
 120 #enum Int,, \
 121         REG_NOMATCH
 122 --      REG_ESPACE
 123
 124 -- Flags for regcomp
 125 #enum Int,, \
 126         REG_EXTENDED, \
 127         regIgnoreCase = REG_ICASE, \
 128         REG_NOSUB, \
 129         REG_NEWLINE
 130
 131 -- Error codes from regcomp
 132 #enum Int,, \
 133         REG_BADBR, \
 134         REG_BADPAT, \
 135         REG_BADRPT, \
 136         REG_ECOLLATE, \
 137         REG_ECTYPE, \
 138         REG_EESCAPE, \
 139         REG_ESUBREG, \
 140         REG_EBRACK, \
 141         REG_EPAREN, \
 142         REG_EBRACE, \
 143         REG_ERANGE, \
 144         REG_ESPACE
 145
 146 type CRegex    = ()
 147 type CRegMatch = ()
 148
 149 foreign import ccall unsafe "regcomp"
 150   c_regcomp :: Ptr CRegex -> CString -> CInt -> IO CInt
 151
 152 foreign import ccall  unsafe "regfree"
 153   c_regfree :: Ptr CRegex -> IO ()
 154
 155 foreign import ccall unsafe "regexec"
 156   c_regexec :: Ptr CRegex -> CString -> CSize
 157             -> Ptr CRegMatch -> CInt -> IO CInt