[project @ 2002-04-24 16:31:37 by simonmar]
[packages/base.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 -- $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