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