-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathglob.hs
85 lines (66 loc) · 2.33 KB
/
glob.hs
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
76
77
78
79
80
81
82
83
84
85
import System.IO
import System.Exit
import System.Environment
import Text.ParserCombinators.Parsec
main = do args <- getArgs
case args of
[pat] -> do putStr "expand : "; print $ expand pat
putStr "expand2 : "; print $ expandPattern pat
putStr "expand2 : "; print $ expandPattern2 pat
_ -> usage
usage = do p <- getProgName
die ("Usage: " ++ p ++ " <pattern>")
die msg = do hPutStrLn stderr msg
exitWith (ExitFailure 1)
expand :: String -> [String]
expand pattern = case parse estring "" pattern of
Right x -> expandConcat x
Left err -> ["parse error (expand)"]
expandPattern :: String -> [String]
expandPattern pattern = expandCharClass pattern >>= expandAltWords
expandPattern2 :: String -> [String]
expandPattern2 pattern =
return pattern >>= expandCharClass >>= expandAltWords
expandCharClass :: String -> [String]
expandCharClass pattern = case parse cstring "" pattern of
Right x -> expandConcat x
Left err -> ["parse error (char class)"]
expandAltWords :: String -> [String]
expandAltWords pattern = case parse astring "" pattern of
Right x -> expandConcat x
Left err -> [show err]
expandConcat :: [[String]] -> [String]
expandConcat [] = []
expandConcat [ws] = ws
expandConcat (ws:ss) = do w <- ws
s <- expandConcat ss
return (w ++ s)
estring = many ecomponent
ecomponent = do w <- many1 (noneOf "[{")
return [w]
<|> charclass
<|> altwords
cstring = many ccomponent
ccomponent = do w <- many1 (noneOf "[")
return [w]
<|> charclass
charclass = do char '['
cs <- many1 (noneOf "]")
char ']'
return $ map (\c -> [c]) cs
astring = do ws <- many acomponent
eof
return ws
acomponent = do w <- many1 (noneOf "{")
return [w]
<|> altwords
altwords = do char '{'
ws <- content
char '}'
return ws
where
content = chainr1 word comma
word = do w <- many (noneOf ",}")
return [w]
comma = do char ','
return (++)