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 Control.Monad
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 ["test","t"] (const Test) "Run the tests"
                ,flagNone ["generate","g"] (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 -> do
            let xs = showText txt $ helpText [ver] hlp args
            putStrLn xs
            when (hlp == HelpFormatBash) $ do
                writeFileBinary "cmdargs.bash_comp" xs
                putStrLn "# Output written to cmdargs.bash_comp"
        Test -> test
        Generate -> generateManual
        Demo x -> runDemo x


writeFileBinary :: FilePath -> String -> IO ()
writeFileBinary file x = do
    h <- openBinaryFile file WriteMode
    hPutStr h x
    hClose h


---------------------------------------------------------------------
-- 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) | "<!-- BEGIN " `isPrefixOf` x = do
            ys <- generateChunk $ init $ drop 2 $ words x
            zs <- f $ tail $ dropWhile (not . isPrefixOf "<!-- END") xs
            return $ x : ys ++ ["<!-- END -->"] ++ 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 $ ["<pre>"] ++ recode (lines src) ++ ["</pre>"]


recode :: [String] -> [String]
recode = concatMap f . blanks . takeWhile (/= "-- STOP MANUAL")
    where
        blanks ("":"":xs) = blanks ("":xs)
        blanks [""] = []
        blanks [] = []
        blanks (x:xs) = x : blanks xs

        f x | x == "import System.Console.CmdArgs.Test.Implicit.Util" = []
            | "{-# OPTIONS_GHC " `isPrefixOf` x = []
            | "{-# LANGUAGE " `isPrefixOf` x = ["{-# LANGUAGE DeriveDataTypeable #-}"]
            | "module System.Console.CmdArgs.Test.Implicit." `isPrefixOf` x = ["module " ++ drop 44 x]
        f x = [x]