1 2module Main(main) where 3 4import System.Console.CmdArgs.Test.All 5import qualified System.Console.CmdArgs.Test.Implicit.Diffy as D 6import qualified System.Console.CmdArgs.Test.Implicit.HLint as H 7import qualified System.Console.CmdArgs.Test.Implicit.Maker as M 8import System.Console.CmdArgs.Implicit(CmdArgs(..)) 9import System.Console.CmdArgs.Explicit 10import System.Console.CmdArgs.Text 11import System.Console.CmdArgs.Default 12 13import Control.Monad 14import Data.List 15import Data.Maybe 16import System.IO 17 18 19data Args = Test 20 | Generate 21 | Help HelpFormat TextFormat 22 | Version 23 | Demo Demo 24 25args = (modes "cmdargs" (Help def def) "CmdArgs demo program" ms){modeGroupFlags = toGroup flags} 26 where 27 flags = [flagHelpFormat $ \a b _ -> Help a b 28 ,flagVersion $ const Version 29 ,flagNone ["test","t"] (const Test) "Run the tests" 30 ,flagNone ["generate","g"] (const Generate) "Generate the manual"] 31 32 ms = map (remap Demo (\(Demo x) -> (x,Demo))) demo 33 34 35main = do 36 x <- processArgs args 37 let ver = "CmdArgs demo program, (C) Neil Mitchell" 38 case x of 39 Version -> putStrLn ver 40 Help hlp txt -> do 41 let xs = showText txt $ helpText [ver] hlp args 42 putStrLn xs 43 when (hlp == HelpFormatBash) $ do 44 writeFileBinary "cmdargs.bash_comp" xs 45 putStrLn "# Output written to cmdargs.bash_comp" 46 Test -> test 47 Generate -> generateManual 48 Demo x -> runDemo x 49 50 51writeFileBinary :: FilePath -> String -> IO () 52writeFileBinary file x = do 53 h <- openBinaryFile file WriteMode 54 hPutStr h x 55 hClose h 56 57 58--------------------------------------------------------------------- 59-- GENERATE MANUAL 60 61generateManual :: IO () 62generateManual = do 63 src <- readFile "cmdargs.htm" 64 () <- length src `seq` return () 65 res <- fmap unlines $ f $ lines src 66 () <- length res `seq` return () 67 h <- openBinaryFile "cmdargs.htm" WriteMode 68 hPutStr h res 69 hClose h 70 where 71 f (x:xs) | "<!-- BEGIN " `isPrefixOf` x = do 72 ys <- generateChunk $ init $ drop 2 $ words x 73 zs <- f $ tail $ dropWhile (not . isPrefixOf "<!-- END") xs 74 return $ x : ys ++ ["<!-- END -->"] ++ zs 75 f [] = return [] 76 f (x:xs) = fmap (x:) $ f xs 77 78generateChunk :: [String] -> IO [String] 79generateChunk ["help",x] = return $ case x of 80 "hlint" -> f H.mode 81 "diffy" -> f D.mode 82 "maker" -> f M.mode 83 where f = lines . fromJust . cmdArgsHelp . flip processValue ["--help=html"] 84 85generateChunk ["code",x] = do 86 src <- readFile $ "System/Console/CmdArgs/Test/Implicit/" ++ x ++ ".hs" 87 return $ ["<pre>"] ++ recode (lines src) ++ ["</pre>"] 88 89 90recode :: [String] -> [String] 91recode = concatMap f . blanks . takeWhile (/= "-- STOP MANUAL") 92 where 93 blanks ("":"":xs) = blanks ("":xs) 94 blanks [""] = [] 95 blanks [] = [] 96 blanks (x:xs) = x : blanks xs 97 98 f x | x == "import System.Console.CmdArgs.Test.Implicit.Util" = [] 99 | "{-# OPTIONS_GHC " `isPrefixOf` x = [] 100 | "{-# LANGUAGE " `isPrefixOf` x = ["{-# LANGUAGE DeriveDataTypeable #-}"] 101 | "module System.Console.CmdArgs.Test.Implicit." `isPrefixOf` x = ["module " ++ drop 44 x] 102 f x = [x] 103