[project @ 2002-04-26 13:34:05 by simonmar]
[packages/old-locale.git] / 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