{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
module Textphile.CLI.Compile where

import Control.Applicative (Applicative(..), Alternative(..))
import Control.Monad (Monad(..), forM_, unless, when)
import Control.Monad.Trans.Except (runExcept)
import Control.Monad.Trans.Maybe (MaybeT(..))
import Control.Monad.Trans.State.Strict (runState)
import Data.Bool
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Foldable as Foldable (Foldable(..))
import Data.Function (($), (.), id, flip)
import Data.Functor ((<$>))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Ord (Ord(..))
import Data.Proxy (Proxy(..))
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Prelude (error)
import Symantic.CLI as CLI
import System.FilePath ((-<.>))
import System.IO (IO, FilePath)
import Text.Show (Show(..))
import qualified Data.ByteString as BS
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TL
import qualified Data.TreeSeq.Strict as Tree
import qualified Paths_textphile as Textphile
import qualified Symantic.Document as Doc
import qualified System.Directory as IO
import qualified System.Environment as Env
import qualified System.FilePath as FP
import qualified System.FilePath as FilePath
import qualified System.IO as IO
import qualified Text.Blaze.DTC as Blaze.DTC
import qualified Text.Blaze.HTML5 as Blaze.HTML5
import qualified Text.Blaze.Renderer.Utf8 as Blaze
import qualified Text.Blaze.Utils         as Blaze
import qualified Text.Megaparsec as P
import qualified Textphile.DTC.Read.TCT    as DTC
import qualified Textphile.DTC.Sym         as DTC
import qualified Textphile.DTC.Write.HTML5 as DTC
import qualified Textphile.DTC.Write.XML   as DTC
import qualified Textphile.TCT             as TCT
import qualified Textphile.TCT.Write.HTML5 as TCT
import qualified Textphile.TCT.Write.Plain as TCT
import qualified Textphile.TCT.Write.XML   as TCT
import qualified Textphile.Utils           as FS

import Textphile.CLI.Lang
import Textphile.CLI.Utils

data Cfg_Compile = Cfg_Compile
 {   cfg_compile_dump_tct  :: Bool
 ,   cfg_compile_dump_xml  :: Bool
 ,   cfg_compile_dump_deps :: Bool
 } deriving (Show)

data Cfg_Compile_HTML5
 =   Cfg_Compile_HTML5
 {   cfg_compile_html5_output_css :: Maybe FP.FilePath
 ,   cfg_compile_html5_output_js  :: Maybe FP.FilePath
 ,   cfg_compile_html5_dump_dtc   :: Bool
 }

api_command_compile =
	helps l10n_help_command_compile $
	command "compile" $
		(Cfg_Compile
		 <$> api_dump_tct
		 <*> api_dump_xml
		 <*> api_dump_deps
		)
		<?> api_format
		-- <!> api_help False
	where
	api_dump_tct =
		flag "dump-tct"
	api_dump_xml =
		flag "dump-xml"
	api_dump_deps =
		flag "dump-deps"
	api_format =
		api_format_html5 <!>
		api_format_xml
	api_output_css =
		helps l10n_help_opt_output_css $
		optionalTag "output-css" $
			var "FILE"
	api_output_js =
		helps l10n_help_opt_output_js $
		optionalTag "output-js" $
			var "FILE"
	api_dump_dtc =
		flag "dump-dtc"
	api_format_html5 =
		command "html5" $
			(Cfg_Compile_HTML5
			 <$> api_output_css
			 <*> api_output_js
			 <*> api_dump_dtc
			)
			<?> api_input
			<.> response @()
	api_format_xml =
		command "xml" $
			api_input
			<.> response @()
	api_input =
		helps l10n_help_opt_input $
		var @FP.FilePath "INPUT"

run_command_compile
 cfg_global@Cfg_Global{..}
 cfg_compile@Cfg_Compile{..} =
	run_compile_html5 :!:
	run_compile_xml
	where
	run_compile_dtc cfg_compile_input cfg_compile_output = do
		outputInfo cfg_global $ "compiling... " <> Doc.from cfg_compile_input
		TCT.readTCT cfg_compile_input >>= \case
		 Left err -> error $ show err
		 Right tct -> do
			when cfg_compile_dump_tct $ do
				FS.writeFile (cfg_compile_output-<.>"tct.dump") $
					TL.pack $ Tree.prettyTrees tct
			let xml = TCT.writeXML tct
			when cfg_compile_dump_xml $ do
				FS.writeFile (cfg_compile_output-<.>"xml.dump") $
					TL.pack $ Tree.prettyTrees xml
			case DTC.readDTC xml of
			 Left err -> do
				FS.removeFile $ cfg_compile_output-<.>"deps"
				error $ List.unlines $ Foldable.toList $ P.parseErrorPretty <$> P.bundleErrors err
			 Right dtc -> do
				when cfg_compile_dump_deps $ do
					writeDependencies cfg_compile cfg_compile_input tct
				when cfg_compile_dump_xml $ do
					FS.writeFile (cfg_compile_output-<.>"dtc.dump") $
						TL.pack $ show dtc
				return dtc
	run_compile_html5 Cfg_Compile_HTML5{..} cfg_compile_input = do
		let cfg_compile_output = cfg_compile_input-<.>"html5"
		dtc <- run_compile_dtc cfg_compile_input cfg_compile_output
		config_css <- installFile cfg_compile_html5_output_css $ "style" FilePath.</>"dtc-html5.css"
		config_js  <- installFile cfg_compile_html5_output_js  $ "style" FilePath.</>"dtc-html5.js"
		let conf = DTC.Config
			 { DTC.config_css
			 , DTC.config_js
			 , DTC.config_locale    = cfg_global_lang
			 , DTC.config_generator = TL.fromStrict version
			 }
		FS.withFile cfg_compile_output IO.WriteMode $ \h -> do
			html <- DTC.writeHTML5 conf dtc
			Blaze.prettyMarkupIO
			 Blaze.HTML5.isInlinedElement
			 (BS.hPutStr h)
			 html
		where
		installFile out name = do
			dataDir <- Textphile.getDataDir
			let src = dataDir FilePath.</>name
			case out of
			 Nothing -> Right <$> FS.readFile src
			 Just "" -> return $ Left ""
			 Just dst -> do
				IO.createDirectoryIfMissing True $ FilePath.takeDirectory dst
				IO.copyFile src dst
				return $ Left dst
	run_compile_xml cfg_compile_input = do
		let cfg_compile_output = cfg_compile_input-<.>"xml"
		dtc <- run_compile_dtc cfg_compile_input cfg_compile_output
		FS.withFile cfg_compile_output IO.WriteMode $ \h ->
			Blaze.prettyMarkupIO Blaze.DTC.isInlinedElement (BS.hPutStr h) $
			DTC.writeXML cfg_global_lang dtc

writeDependencies :: Cfg_Compile -> FilePath -> TCT.Roots -> IO ()
writeDependencies Cfg_Compile{..} cfg_compile_input tct =
	let dir = FilePath.takeDirectory cfg_compile_input in
	FS.writeFile (cfg_compile_input-<.>"deps") $
		foldMap (TL.pack . (("\n" <>) . FilePath.normalise))
		 ((dir FilePath.</>) <$> TCT.dependencies tct) <>
		"\n"