Ticket #8: regexmatch.8.hs

File regexmatch.8.hs, 1.6 KB (added by xoltar, 13 years ago)
Line 
1import System (getArgs)
2import RegexString
3import Exception (throw)
4import IOExts (unsafePerformIO, trace)
5
6main =
7  do
8    [~n] <- getArgs
9    let num = read n
10    sequence_ $ map (\x->if trace (show x) (x == num) then do return (match); return ()
11                                 else (putStrLn . unlines) $ build) [1..num]
12    where
13         phones = lines (unsafePerformIO (getContents))
14         match = foldl (\x y -> regex y) Nothing phones
15         build = snd $ foldr (foldMatch) (0, []) phones
16         foldMatch line (count, matchlines) = case trace line (regex line) of
17                                                      Nothing -> trace "Failed match" (count, matchlines)
18                                                      Just matches -> trace "Matched!" (next, (format next matches) : matchlines)
19                                                  where next = count + 1
20         format count (g1:g2:g3:g4:gs) = (show count) ++ ": (" ++ if length g1 > 0 then g1 else g2 ++ ") " ++ g3 ++ "-" ++ g4
21         format _ lst = throw $ userError ("ERROR - " ++ show lst)
22         regex = matchRegex $ mkRegexWithOpts (
23          -- Regex and comments courtesy of the Perl example.
24                                "(?: ^ |[^\\d\\(])" ++  -- must be preceeded by non-digit
25                                "( \\( )?" ++           -- match 1: possible initial left paren
26                                "(\\d\\d\\d)" ++                -- match 2: area code is 3 digits
27                                "(?(1) \\) )" ++        -- if match1 then match right paren
28                                "[ ]" ++                -- area code followed by one space
29                                "(\\d\\d\\d)" ++           -- match 3: prefix of 3 digits
30                                "[ -]" ++               -- separator is either space or dash
31                                "(\\d\\d\\d\\d)" ++             -- match 4: last 4 digits
32                                "\\D"                   -- must be followed by a non-digit
33                                ) True False
34
35