1 2module Main(main) where 3 4import System.Environment 5import TagSoup.Sample 6import TagSoup.Test 7import TagSoup.Benchmark 8import Data.Char(toLower) 9 10 11helpMsg :: IO () 12helpMsg = putStr $ unlines $ 13 ["TagSoup, (C) Neil Mitchell 2006-2009" 14 ,"" 15 ," tagsoup arguments" 16 ,"" 17 ,"<url> may either be a local file, or a http[s]:// page" 18 ,"" 19 ] ++ map f res 20 where 21 width = maximum $ map (length . fst) res 22 res = map g actions 23 24 g (nam,msg,Left _) = (nam,msg) 25 g (nam,msg,Right _) = (nam ++ " <url>",msg) 26 27 f (lhs,rhs) = " " ++ lhs ++ replicate (4 + width - length lhs) ' ' ++ rhs 28 29 30actions :: [(String, String, Either (IO ()) (String -> IO ()))] 31actions = [("test","Run the test suite",Left test) 32 ,("grab","Grab a web page",Right grab) 33 ,("parse","Parse a web page",Right parse) 34 ,("bench","Benchmark the parsing",Left time) 35 ,("benchfile","Benchmark the parsing of a file",Right timefile) 36 ,("validate","Validate a page",Right validate) 37 ,("lastmodifieddate","Get the wiki.haskell.org last modified date",Left haskellLastModifiedDateTime) 38 ,("spj","Simon Peyton Jones' papers",Left spjPapers) 39 ,("ndm","Neil Mitchell's papers",Left ndmPapers) 40 ,("time","Current time",Left currentTime) 41 ,("google","Google Tech News",Left googleTechNews) 42 ,("sequence","Creators on sequence.complete.org",Left rssCreators) 43 ,("table","Parse a table",Left $ print parseTable) 44 ,("help","This help message",Left helpMsg) 45 ] 46 47main :: IO () 48main = do 49 args <- getArgs 50 case (args, lookup (map toLower $ head args) $ map (\(a,_,c) -> (a,c)) actions) of 51 ([],_) -> do 52 putStrLn "No arguments specifying, defaulting to test" 53 helpMsg 54 putStrLn $ replicate 70 '-' 55 test 56 (x:_,Nothing) -> putStrLn ("Error: unknown command " ++ x) >> helpMsg 57 ([_],Just (Left a)) -> a 58 (x:xs,Just (Left a)) -> do 59 putStrLn $ "Warning: expected no arguments to " ++ x ++ " but got: " ++ unwords xs 60 a 61 ([_,y],Just (Right a)) -> a y 62 (x:xs,Just (Right _)) -> do 63 putStrLn $ "Error: expected exactly one argument to " ++ x ++ " but got: " ++ unwords xs 64 helpMsg 65