File: Parse.hs

package info (click to toggle)
haskell-pcre-light 0.3.1.1-3
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 220 kB
  • ctags: 2
  • sloc: haskell: 3,650; makefile: 10; sh: 5
file content (75 lines) | stat: -rw-r--r-- 2,117 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
--
-- A script to translate the pcre.c testsuite into Haskell
--

import System.Environment
import System.IO
import Data.Char
import Data.List
import Text.PrettyPrint.HughesPJ

data Test = Test String [String] [Maybe [String]]
       deriving (Eq,Show,Read)

main = do
    [f,g] <- getArgs
    inf   <- readFile f
    outf  <- readFile g

    let in_str  = lines inf
        out_str = lines outf

    let loop [] []     = []
        loop i_xs o_xs = Test r subj results   : loop (dropWhile (=="") i_ys)
                                                      (dropWhile (=="") o_ys)
           where
             ((r:subj),    i_ys) = break (== "") i_xs

             ((_:results'),o_ys) = break (== "") o_xs
             results= [ if s == "No match"
                           then Nothing
                           else Just [s]
                      | s <- filter (not . all isSpace . take 2) results'
                      ]

    print . vcat . intersperse (char ',') . map ppr . loop in_str $ out_str

breakReg ('/':rest) = 
  let s = reverse . dropWhile (/= '/') . reverse $ rest

      t = case head (reverse rest) of
               'i' -> ["caseless"]
               '/' -> []
               _   -> ["ERROR"]

  in if s == "" then ("ERROR", [])
                else (init s, t)


breakReg ('"':rest) =
  let s = reverse . dropWhile (/= '"') . reverse $ rest

      t = case head (reverse rest) of
               'i' -> ["caseless"]
               '/' -> []
               _   -> ["ERROR"]

  in if s == "" then ("ERROR", [])
                else (init s, t)

breakReg s          = ("ERROR", [])

ppr :: Test -> Doc
ppr (Test r subjs res) =
    hang (empty <+> text "testRegex" <+> text
       (show (fst $ breakReg r)) <+> 
               bracket (case snd (breakReg r) of
                                    [] -> empty
                                    [x] -> text x
                       ))
         4 $
         (bracket $ vcat $ punctuate (char ',') (map (text.show) subjs))
            $+$
         (bracket $ vcat $ punctuate (char ',') (map (text.show) res))

bracket x = char '[' <> x <> char ']'