Text/Regex/Posix.hsc

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