test.icl 1.19 KB
Newer Older
Camil Staps's avatar
Camil Staps committed
1 2 3 4 5 6 7 8 9 10
module test

import StdEnv
import Data.Error
from Data.Func import $
import Regex

Start :: *World -> *World
Start w
# (io,w) = stdio w
Camil Staps's avatar
Camil Staps committed
11
# (io,e) = loop (Error "waiting for regex") io stderr
Camil Staps's avatar
Camil Staps committed
12
# (ok,w) = fclose io w
Camil Staps's avatar
Camil Staps committed
13
# (ok,w) = fclose e w
Camil Staps's avatar
Camil Staps committed
14 15
= w

Camil Staps's avatar
Camil Staps committed
16 17
loop :: !(MaybeErrorString Regex) !*File !*File -> *(!*File, !*File)
loop r f err
Camil Staps's avatar
Camil Staps committed
18 19 20
# (ln,f)        = freadline f
# f             = f <<< ln
| ln % (0,12) == "# End of test"
Camil Staps's avatar
Camil Staps committed
21
	= (f,err)
Camil Staps's avatar
Camil Staps committed
22
| isMember ln.[0] ['#\\']
Camil Staps's avatar
Camil Staps committed
23
	= loop r f err
Camil Staps's avatar
Camil Staps committed
24
| ln.[0] == '/' && ln.[size ln-2] == '/' // modifiers not supported
Camil Staps's avatar
Camil Staps committed
25
	= loop (compile $ ln % (1,size ln-3)) f err
Camil Staps's avatar
Camil Staps committed
26
| ln.[0] == '/'
Camil Staps's avatar
Camil Staps committed
27
	= loop (Error "skipped modifiers") f err
Camil Staps's avatar
Camil Staps committed
28
| ln % (0,3) == "    "
Camil Staps's avatar
Camil Staps committed
29 30
	| isError r = loop r f (err <<< fromError r <<< "\n")
	= loop r (print_match (fromOk r) (fromString $ ln % (4,size ln-2)) f) err
Camil Staps's avatar
Camil Staps committed
31
| otherwise
Camil Staps's avatar
Camil Staps committed
32
	= loop r f err
Camil Staps's avatar
Camil Staps committed
33 34 35 36 37 38 39 40 41 42 43 44

print_match :: !Regex ![Char] *File -> *File
print_match r s f
| isEmpty matches = f <<< "No match\n"
# f = f <<< " 0: " <<< toString m <<< '\n'
# f = f <<< foldl (+++) "" (map (\(NotNamed i,s) -> if (i < 9) " " "" +++ toString (i+1) +++ ": " +++ toString s +++ "\n") $ sort grps)
= f
where
	(_,m,grps) = hd matches
	matches = match r s

instance < GroupId where (<) (NotNamed a) (NotNamed b) = a < b