module Main where import System.Console.CmdArgs.Test.All import qualified System.Console.CmdArgs.Test.Implicit.Diffy as D import qualified System.Console.CmdArgs.Test.Implicit.HLint as H import qualified System.Console.CmdArgs.Test.Implicit.Maker as M import System.Console.CmdArgs.Implicit(CmdArgs(..)) import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Text import System.Console.CmdArgs.Default import Data.List import Data.Maybe import System.IO data Args = Test | Generate | Help HelpFormat TextFormat | Version | Demo Demo args = (modes "cmdargs" (Help def def) "CmdArgs demo program" ms){modeGroupFlags = toGroup flags} where flags = [flagHelpFormat $ \a b _ -> Help a b ,flagVersion $ const Version ,flagNone ["t","test"] (const Test) "Run the tests" ,flagNone ["g","generate"] (const Generate) "Generate the manual"] ms = map (remap Demo (\(Demo x) -> (x,Demo))) demo main = do x <- processArgs args let ver = "CmdArgs demo program, (C) Neil Mitchell" case x of Version -> putStrLn ver Help hlp txt -> putStrLn $ showText txt $ Line ver : Line "" : helpText hlp args Test -> test Generate -> generateManual Demo x -> runDemo x --------------------------------------------------------------------- -- GENERATE MANUAL generateManual :: IO () generateManual = do src <- readFile "cmdargs.htm" () <- length src `seq` return () res <- fmap unlines $ f $ lines src () <- length res `seq` return () h <- openBinaryFile "cmdargs.htm" WriteMode hPutStr h res hClose h where f (x:xs) | ""] ++ zs f [] = return [] f (x:xs) = fmap (x:) $ f xs generateChunk :: [String] -> IO [String] generateChunk ["help",x] = return $ case x of "hlint" -> f H.mode "diffy" -> f D.mode "maker" -> f M.mode where f = lines . fromJust . cmdArgsHelp . flip processValue ["--help=html"] generateChunk ["code",x] = do src <- readFile $ "System/Console/CmdArgs/Test/Implicit/" ++ x ++ ".hs" return $ ["
"] ++ recode (lines src) ++ ["
"] recode :: [String] -> [String] recode = concatMap f . blanks . takeWhile (not . isPrefixOf "test") where blanks ("":"":xs) = blanks ("":xs) blanks [""] = [] blanks [] = [] blanks (x:xs) = x : blanks xs f x | x == "import System.Console.CmdArgs.Test.Implicit.Util" = [] | "{-# LANGUAGE " `isPrefixOf` x = ["{-# LANGUAGE DeriveDataTypeable #-}"] | "module System.Console.CmdArgs.Test.Implicit." `isPrefixOf` x = ["module " ++ drop 44 x] f x = [x]