ee220880ae4d93559517eedb6ec16edf81098469
[packages/old-time.git] / 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 #ifndef __NHC__
17 #include "ghcconfig.h"
18 #else
19 #define HAVE_REGEX_H 1
20 #define HAVE_REGCOMP 1
21 #endif
22
23 module Text.Regex.Posix (
24         -- * The @Regex@ type
25         Regex,          -- abstract
26
27         -- * Compiling a regular expression
28         regcomp,        -- :: String -> Int -> IO Regex
29
30         -- ** Flags for regcomp
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
35         -- * Matching a regular expression
36         regexec,        -- :: Regex                  -- pattern
37                         -- -> String                 -- string to match
38                         -- -> IO (Maybe (String,     -- everything before match
39                         --               String,     -- matched portion
40                         --               String,     -- everything after match
41                         --               [String]))  -- subexpression matches
42
43   ) where
44
45 #include <sys/types.h>
46
47 #if HAVE_REGEX_H && HAVE_REGCOMP
48 #include "regex.h"
49 #else
50 #include "regex/regex.h"
51
52 -- CFILES stuff is Hugs only
53 {-# CFILES cbits/regex/reallocf.c #-}
54 {-# CFILES cbits/regex/regcomp.c #-}
55 {-# CFILES cbits/regex/regerror.c #-}
56 {-# CFILES cbits/regex/regexec.c #-}
57 {-# CFILES cbits/regex/regfree.c #-}
58 #endif
59
60 import Prelude
61
62 import Foreign
63 import Foreign.C
64
65 type CRegex    = ()
66
67 -- | A compiled regular expression
68 newtype Regex = Regex (ForeignPtr CRegex)
69
70 -- -----------------------------------------------------------------------------
71 -- regcomp
72
73 -- | Compiles a regular expression
74 regcomp
75   :: String     -- ^ The regular expression to compile
76   -> Int        -- ^ Flags (summed together)
77   -> IO Regex   -- ^ Returns: the compiled regular expression
78 regcomp pattern flags = do
79   regex_fptr <- mallocForeignPtrBytes (#const sizeof(regex_t))
80   r <- withCString pattern $ \cstr ->
81          withForeignPtr regex_fptr $ \p ->
82            c_regcomp p cstr (fromIntegral flags)
83   if (r == 0)
84      then do addForeignPtrFinalizer ptr_regfree regex_fptr
85              return (Regex regex_fptr)
86      else error "Text.Regex.Posix.regcomp: error in pattern" -- ToDo
87
88 -- -----------------------------------------------------------------------------
89 -- regexec
90
91 -- | Matches a regular expression against a string
92 regexec :: Regex                        -- ^ Compiled regular expression
93         -> String                       -- ^ String to match against
94         -> IO (Maybe (String, String, String, [String]))
95                 -- ^ Returns: 'Nothing' if the regex did not match the
96                 -- string, or:
97                 --
98                 -- @
99                 --   'Just' (everything before match,
100                 --         matched portion,
101                 --         everything after match,
102                 --         subexpression matches)
103                 -- @
104
105 regexec (Regex regex_fptr) str = do
106   withCString str $ \cstr -> do
107     withForeignPtr regex_fptr $ \regex_ptr -> do
108       nsub <- (#peek regex_t, re_nsub) regex_ptr
109       let nsub_int = fromIntegral (nsub :: CSize)
110       allocaBytes ((1 + nsub_int) * (#const sizeof(regmatch_t))) $ \p_match -> do
111                 -- add one because index zero covers the whole match
112         r <- c_regexec regex_ptr cstr (1 + nsub) p_match 0{-no flags for now-}
113
114         if (r /= 0) then return Nothing else do 
115
116           (before,match,after) <- matched_parts str p_match
117
118           sub_strs <- 
119             mapM (unpack str) $ take nsub_int $ tail $
120                iterate (`plusPtr` (#const sizeof(regmatch_t))) p_match
121
122           return (Just (before, match, after, sub_strs))
123
124 matched_parts :: String -> Ptr CRegMatch -> IO (String, String, String)
125 matched_parts string p_match = do
126   start <- (#peek regmatch_t, rm_so) p_match :: IO (#type regoff_t)
127   end   <- (#peek regmatch_t, rm_eo) p_match :: IO (#type regoff_t)
128   let s = fromIntegral start; e = fromIntegral end
129   return ( take s string, 
130            take (e-s) (drop s string),
131            drop e string )  
132
133 unpack :: String -> Ptr CRegMatch -> IO (String)
134 unpack string p_match = do
135   start <- (#peek regmatch_t, rm_so) p_match :: IO (#type regoff_t)
136   end   <- (#peek regmatch_t, rm_eo) p_match :: IO (#type regoff_t)
137   -- the subexpression may not have matched at all, perhaps because it
138   -- was optional.  In this case, the offsets are set to -1.
139   if (start == -1) then return "" else do
140     return (take (fromIntegral (end-start)) (drop (fromIntegral start) string))
141
142 -- -----------------------------------------------------------------------------
143 -- The POSIX regex C interface
144
145 -- Flags for regexec
146 #enum Int,, \
147         REG_NOTBOL, \
148         REG_NOTEOL
149
150 -- Return values from regexec
151 #enum Int,, \
152         REG_NOMATCH
153 --      REG_ESPACE
154
155 -- Flags for regcomp
156 #enum Int,, \
157         REG_EXTENDED, \
158         regIgnoreCase = REG_ICASE, \
159         REG_NOSUB, \
160         REG_NEWLINE
161
162 -- Error codes from regcomp
163 #enum Int,, \
164         REG_BADBR, \
165         REG_BADPAT, \
166         REG_BADRPT, \
167         REG_ECOLLATE, \
168         REG_ECTYPE, \
169         REG_EESCAPE, \
170         REG_ESUBREG, \
171         REG_EBRACK, \
172         REG_EPAREN, \
173         REG_EBRACE, \
174         REG_ERANGE, \
175         REG_ESPACE
176
177 type CRegMatch = ()
178
179 #ifdef __GLASGOW_HASKELL__
180 foreign import ccall unsafe "regcomp"
181   c_regcomp :: Ptr CRegex -> CString -> CInt -> IO CInt
182
183 foreign import ccall  unsafe "&regfree"
184   ptr_regfree :: FunPtr (Ptr CRegex -> IO ())
185
186 foreign import ccall unsafe "regexec"
187   c_regexec :: Ptr CRegex -> CString -> CSize
188             -> Ptr CRegMatch -> CInt -> IO CInt
189 #else
190 -- For NHC and (we think) Hugs, we have to hackily put
191 -- the regex.h include in the name of the C function to
192 -- import.  (GHC does this by interpreting the
193 -- "-#include regex.h" OPTIONS pragma that hsc2hs generates.
194 -- The trouble with the hacky solution is that sometimes
195 -- we want regex.h and sometimes regex/regex.h.  I'm not
196 -- sure if the hack will work for NHC and Hugs on all 
197 -- platforms
198
199 foreign import ccall unsafe "regex.h regcomp"
200   c_regcomp :: Ptr CRegex -> CString -> CInt -> IO CInt
201
202 foreign import ccall  unsafe "regex.h &regfree"
203   ptr_regfree :: FunPtr (Ptr CRegex -> IO ())
204
205 foreign import ccall unsafe "regex.h regexec"
206   c_regexec :: Ptr CRegex -> CString -> CSize
207             -> Ptr CRegMatch -> CInt -> IO CInt
208 #endif