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
|
module Main(main) where
import System.Environment
import TagSoup.Sample
import TagSoup.Test
import TagSoup.Benchmark
import Data.Char(toLower)
helpMsg :: IO ()
helpMsg = putStr $ unlines $
["TagSoup, (C) Neil Mitchell 2006-2009"
,""
," tagsoup arguments"
,""
,"<url> may either be a local file, or a http[s]:// page"
,""
] ++ map f res
where
width = maximum $ map (length . fst) res
res = map g actions
g (nam,msg,Left _) = (nam,msg)
g (nam,msg,Right _) = (nam ++ " <url>",msg)
f (lhs,rhs) = " " ++ lhs ++ replicate (4 + width - length lhs) ' ' ++ rhs
actions :: [(String, String, Either (IO ()) (String -> IO ()))]
actions = [("test","Run the test suite",Left test)
,("grab","Grab a web page",Right grab)
,("parse","Parse a web page",Right parse)
,("bench","Benchmark the parsing",Left time)
,("benchfile","Benchmark the parsing of a file",Right timefile)
,("validate","Validate a page",Right validate)
,("lastmodifieddate","Get the wiki.haskell.org last modified date",Left haskellLastModifiedDateTime)
,("spj","Simon Peyton Jones' papers",Left spjPapers)
,("ndm","Neil Mitchell's papers",Left ndmPapers)
,("time","Current time",Left currentTime)
,("google","Google Tech News",Left googleTechNews)
,("sequence","Creators on sequence.complete.org",Left rssCreators)
,("table","Parse a table",Left $ print parseTable)
,("help","This help message",Left helpMsg)
]
main :: IO ()
main = do
args <- getArgs
case (args, lookup (map toLower $ head args) $ map (\(a,_,c) -> (a,c)) actions) of
([],_) -> do
putStrLn "No arguments specifying, defaulting to test"
helpMsg
putStrLn $ replicate 70 '-'
test
(x:_,Nothing) -> putStrLn ("Error: unknown command " ++ x) >> helpMsg
([_],Just (Left a)) -> a
(x:xs,Just (Left a)) -> do
putStrLn $ "Warning: expected no arguments to " ++ x ++ " but got: " ++ unwords xs
a
([_,y],Just (Right a)) -> a y
(x:xs,Just (Right _)) -> do
putStrLn $ "Error: expected exactly one argument to " ++ x ++ " but got: " ++ unwords xs
helpMsg
|
