{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main where

import Control.Monad (forM_)
import Data.Bool
import Data.Eq (Eq(..))
import Data.Either (Either(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Maybe (fromMaybe)
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Options.Applicative as Opt
import Prelude (error)
import System.IO (IO, FilePath, hPrint, hPutStrLn, stderr, stdout)
import qualified Data.ByteString as BS
import qualified Data.Char as Char
import qualified Data.Text.IO as Text
import qualified Data.Text as Text
import qualified Data.List as List
import qualified Text.Blaze.Renderer.Utf8 as Blaze
import qualified Text.Blaze.Utils as Blaze
import qualified Data.Map.Strict as Map
import qualified System.Environment as Env

import Data.Locale

import qualified Data.TreeSeq.Strict as Tree
import qualified Language.DTC.Read.TCT as DTC.Read.TCT
import qualified Language.DTC.Sym as DTC
import qualified Language.DTC.Write.HTML5 as DTC.Write.HTML5
import qualified Language.DTC.Write.XML   as DTC.Write.XML
import qualified Language.RNC.Write as RNC
import qualified Language.TCT as TCT
import qualified Language.TCT.Write.HTML5 as TCT.Write.HTML5
import qualified Language.TCT.Write.XML   as TCT.Write.XML
import qualified Text.Blaze.DTC   as Blaze.DTC
import qualified Text.Blaze.HTML5 as Blaze.HTML5
import qualified Text.Megaparsec  as P

import Read

type Langs = '[FR, EN]
type Lang = LocaleIn Langs

main :: IO ()
main = do
	lang <-
		(\v -> Map.findWithDefault
		 (LocaleIn @Langs en_US)
		 (Text.pack $ List.takeWhile (\c -> Char.isAlphaNum c || c == '_') v)
		 (locales @Langs)) .
		fromMaybe ""
		 <$> Env.lookupEnv "LANG"
	cmd <- execParser $ p_Argv lang
	mainWithCommand cmd
	where
	p_Argv lang =
		info (p_Command lang <**> helper) $ mconcat $
		 [ fullDesc
		 , progDesc "document tool"
		 , header "hdoc - TCT and DTC command line tool"
		 ]

mainWithCommand :: Command -> IO ()
mainWithCommand (CommandTCT ArgsTCT{..}) =
	readFile input $ \_fp txt ->
		case TCT.readTCTs input txt of
		 Left err -> error $ P.parseErrorPretty err
		 Right tct -> do
			hPrint stderr $ Tree.Pretty tct
			case format of
			 TctFormatHTML5 ->
				Blaze.renderMarkupToByteStringIO BS.putStr $
				TCT.Write.HTML5.html5Document tct
mainWithCommand (CommandDTC ArgsDTC{..}) =
	readFile input $ \_fp txt ->
		case TCT.readTCTs input txt of
		 Left err -> error $ P.parseErrorPretty err
		 Right tct -> do
			hPutStrLn stderr "### TCT ###"
			hPrint stderr $ Tree.Pretty tct
			let xml = TCT.Write.XML.xmlDocument tct
			hPutStrLn stderr "### XML ###"
			hPrint stderr $ Tree.Pretty xml
			case DTC.Read.TCT.readDTC xml of
			 Left err -> error $ P.parseErrorPretty err
			 Right dtc -> do
				hPutStrLn stderr "### DTC ###"
				hPrint stderr dtc
				case format of
				 DtcFormatXML ->
					Blaze.prettyMarkupIO Blaze.DTC.indentTag BS.putStr $
					DTC.Write.XML.xmlDocument locale dtc
				 DtcFormatHTML5 ->
					Blaze.prettyMarkupIO Blaze.HTML5.indentTag BS.putStr $
					DTC.Write.HTML5.html5Document locale dtc
mainWithCommand (CommandRNC ArgsRNC{}) =
	forM_ DTC.dtcRNC $ \w ->
		Text.hPutStrLn stdout $ RNC.renderWriter w

-- * Type 'Command'
data Command
 =   CommandTCT ArgsTCT
 |   CommandDTC ArgsDTC
 |   CommandRNC ArgsRNC

p_Command :: Lang -> Parser Command
p_Command lang =
	subparser (
		command "tct" $
			info (CommandTCT <$> p_ArgsTCT <**> helper) $
				progDesc "TCT (Texte Convivial Technique) rendition.") <|>
	subparser (
		command "dtc" $
			info (CommandDTC <$> p_ArgsDTC lang <**> helper) $
				progDesc "DTC (Document Technique Convivial) rendition.") <|>
	subparser (
		command "rnc" $
			info (CommandRNC <$> p_ArgsRNC <**> helper) $
				progDesc "RNC (RelaxNG Compact) schema.")

-- ** Type 'ArgsTCT'
data ArgsTCT
 =   ArgsTCT
 {   input  :: FilePath
 ,   format :: TctFormat
 }

p_ArgsTCT :: Parser ArgsTCT
p_ArgsTCT =
	ArgsTCT
	 <$> argument str (metavar "FILE")
	 <*> p_TctFormat

-- *** Type 'TctFormat'
data TctFormat
 =   TctFormatHTML5

p_TctFormat :: Parser TctFormat
p_TctFormat =
	flag TctFormatHTML5 TctFormatHTML5
	 (long "html5" <> help "Render as HTML5.")

-- ** Type 'ArgsDTC'
data ArgsDTC
 =   ArgsDTC
 {   input  :: FilePath
 ,   format :: DtcFormat
 ,   locale :: Lang
 -- ,   argsDTC_locale :: LocaleIn Langs
 }
p_ArgsDTC :: Lang -> Parser ArgsDTC
p_ArgsDTC lang =
	ArgsDTC
	 <$> argument str (metavar "FILE")
	 <*> p_DtcFormat
	 <*> p_Locale lang

p_Locale :: Lang -> Parser (LocaleIn Langs)
p_Locale lang =
	option
	 (maybeReader $ \s -> Map.lookup (Text.pack s) $ locales @Langs)
	 ( long "lang"
	 <> help "Language."
	 <> showDefault
	 <> value lang
	 <> metavar "LOCALE")

-- *** Type 'DtcFormat'
data DtcFormat
 =   DtcFormatHTML5
 |   DtcFormatXML

p_DtcFormat :: Parser DtcFormat
p_DtcFormat =
	flag DtcFormatHTML5 DtcFormatHTML5
	 (long "html5" <> help "Render as HTML5.") <|>
	flag DtcFormatHTML5 DtcFormatXML
	 (long "xml"   <> help "Render as XML.")

-- ** Type 'ArgsRNC'
data ArgsRNC
 =   ArgsRNC

p_ArgsRNC :: Parser ArgsRNC
p_ArgsRNC = pure ArgsRNC


{-
	Args
	 <$> strOption (  long "hello"
	               <> metavar "TARGET"
	               <> help "Target for the greeting")
	 <*> switch (  long "quiet"
	            <> short 'q'
	            <> help "Whether to be quiet")
	 <*> option auto ( long "enthusiasm"
	                 <> help "How enthusiastically to greet"
	                 <> showDefault
	                 <> value 1
	                 <> metavar "INT")
-}