content: 
  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
  