{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Language.Symantic.CLI.Test where

-- import Data.Monoid (Monoid(..))
-- import Data.Ord (Ord(..))
-- import Text.Show (Show(..))
import Control.Monad (Monad(..))
import Data.Bool
import Data.Either (Either(..))
import Data.Function (($))
import Data.Functor ((<$>))
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (Maybe(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Data.Void (Void)
import Text.Show (Show(..))
import qualified Data.Set as Set
import qualified Data.Text.Lazy.IO as TL
import qualified Language.Symantic.Document.Term as Doc
import qualified Language.Symantic.Document.Term.IO as DocIO
import qualified System.IO as IO
import qualified Text.Megaparsec as P

import Language.Symantic.CLI.Sym
import qualified Language.Symantic.CLI.Plain as Plain
import qualified Language.Symantic.CLI.Help as Help
import qualified Language.Symantic.CLI.Read as Read

data Command
 =   Command_Source
   { command_source_output   :: [String]
   , command_source_format   :: String
   , command_source_dump_tct :: Bool
   }
 |   Command_Compile
   { command_compile_output   :: [String]
   , command_compile_lang     :: String
   , command_compile_dump_tct :: Bool
   , command_compile_dump_dtc :: Bool
   }
 |   Command_Schema
   { command_schema_output :: [String]
   }
 deriving (Show)

-- * Type 'Exit'
data Exit d
 =   Exit_Help d
 |   Exit_Version
 deriving Show

doc ::
 Plain.Doc d =>
 Plain.Plain d (Exit d) t a -> d
doc = Plain.textPlain

{-
help_usage :: Plain.Doc d => Help.Help d (Exit d) t a -> d
help_usage = Help.help "USAGE" "COMMAND" "OPTION" Help.defReader
 { Help.reader_command_indent = 4 }
-}

help_usage :: Plain.Doc d => Help.Help d (Exit d) t a -> d
help_usage = Help.textHelp Help.defReader

-- * Class 'Hdoc'
class
 ( Sym_Fun repr
 , Sym_App repr
 , Sym_Alt repr
 , Sym_Help d repr
 , Sym_Rule repr
 , Sym_Permutation repr
 , Sym_Command repr
 , Sym_Option repr
 , Sym_Exit repr
 , Sym_AltApp repr
 , Plain.Doc d
 ) => Hdoc d repr where
	hdoc :: repr (Exit d) ArgCommand Command
	hdoc =
		help_words "technical document compiler\n(disclaimer: expect hdoc's documentation to be quite… technical :)" $
		main "hdoc" $ opts **> cmds
		where
		opts =
			runPermutation $
			(\_ -> ())
			 <<$? option_help (help_usage hdoc)
			 <<|?>> ((), long "version" $ exit Exit_Version)
		cmds =
			command_source  <||>
			command_compile <||>
			command_schema
	
	help_words :: String -> repr (Exit d) t a -> repr (Exit d) t a
	help_words d = help @d (Plain.words d)
	
	option_help :: d -> ((), repr (Exit d) ArgOption ())
	option_help d = ((), opt (OptionName 'h' "help") $ exit $ Exit_Help d)
	
	command_source :: repr (Exit d) ArgCommand Command
	command_source =
		help_words "Format a TCT source file." $
		command "source" $
		runPermutation $
		Command_Source
		 <<$?   option_help (help_usage command_source)
		 <<|*>> rule_output
		 <<|>>  option_format
		 <<|?>> option_dump_tct
	command_compile :: repr (Exit d) ArgCommand Command
	command_compile =
		help_words "Compile a TCT source file." $
		command "compile" $
		(\cmd os -> case cmd of
		 Command_Compile{..} -> Command_Compile{command_compile_output=command_compile_output<>os, ..}
		 _ -> cmd)
		 <$$> opts
		 <**  end_options
		 <**> inps
		where
		opts =
			runPermutation $
			Command_Compile
			 <<$?   option_help (help_usage command_compile)
			 <<|*>> rule_output
			 <<|?>> option_lang
			 <<|?>> option_dump_tct
			 <<|?>> option_dump_dtc
		inps = many $ string "file"
	command_schema  :: repr (Exit d) ArgCommand Command
	command_schema =
		help_words "Show the schema for DTC documents." $
		command "schema" $
		runPermutation $
		Command_Schema
		 <<$?   option_help (help_usage command_schema)
		 <<|*>> option_output
	
	end_options :: repr (Exit d) ArgOption ()
	end_options =
		help_words "Force the end of options.\nUseful if <file> has the same name as an option." $
		endOpt
	
	option_lang :: (String, repr (Exit d) ArgOption String)
	option_lang =
		let def = "en_US" in
		(def,) $
		help_words ("Use language <lang>.\nDefault <lang> is: "<>def) $
		long "lang" $
		string "lang"
	rule_output :: repr (Exit d) ArgOption String
	rule_output =
		rule "output" $
		option_output
	option_output :: repr (Exit d) ArgOption String
	option_output =
		help_words "Output into <file>.\nDefault <file> is: input <file> whose extension is replaced by <format> here and then." $
		opt (OptionName 'o' "output") $
		string "file"
	option_dump_tct :: (Bool, repr (Exit d) ArgOption Bool)
	option_dump_tct =
		(False,) $
		help_words "Dump TCT." $
		long  "dump-tct" $
		value True
	option_dump_dtc :: (Bool, repr (Exit d) ArgOption Bool)
	option_dump_dtc =
		(False,) $
		help_words "Dump DTC." $
		long  "dump-dtc" $
		value True
	option_format :: repr (Exit d) ArgOption String
	option_format =
		help_words "Output format." $
		opt (OptionName 'f' "format") $
		"plain" <$$ tag "plain" <||>
		"html5" <$$ tag "html5"
instance Plain.Doc d => Hdoc d (Plain.Plain d)
instance Plain.Doc d => Hdoc d Read.Parser
-- instance Plain.Doc d => Hdoc d (Help.Help d)
instance Plain.Doc d => Hdoc d (Help.Help d)

parse ::
 Plain.Doc d =>
 [String] -> IO.IO (Maybe (Either (Exit d) Command))
parse as =
	case Read.readArgs hdoc $ Read.Args $ Read.Arg <$> as of
	 Right a -> return $ Just $ Right a
	 Left errs ->
		case P.bundleErrors errs of
		 P.TrivialError o us es :| _ -> do
			IO.putStr $ P.parseErrorPretty @Read.Args @Void $
				P.TrivialError o us es
			return Nothing
		 P.FancyError _o es :| _ ->
			case Set.toList es of
			 [P.ErrorCustom (Read.ErrorRead e)] ->
				return $ Just $ Left e
			 _ -> return Nothing

parseIO :: [String] -> IO.IO ()
parseIO as = do
	ret <- parse as
	case ret of
	 Nothing -> return ()
	 Just (Right cmd) ->
		IO.print $ show cmd
	 Just (Left err) -> do
		case err of
		 Exit_Help d ->
			DocIO.runTermIO IO.stdout $
			Doc.withBreakable (Just 80) d <>
			Doc.newline
		 Exit_Version ->
			TL.putStrLn "version"