{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
module Golden where

import Control.Arrow (left)
import Control.Monad (Monad(..))
import Data.Either (Either(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Locale
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import System.FilePath (FilePath)
import System.IO (IO)
import Text.Show (Show(..))
import qualified Data.ByteString.Lazy as BSL
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import qualified Data.Text.Lazy          as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.TreeSeq.Strict as TreeSeq
import qualified Text.Blaze.Html.Renderer.Utf8 as Blaze
import qualified Text.Megaparsec as P

import Test.Tasty
import Test.Tasty.Golden

-- TCT imports
import qualified Language.TCT             as TCT
import qualified Language.TCT.Debug       as TCT
import qualified Language.TCT.Write.HTML5 as TCT.Write.HTML5
import qualified Language.TCT.Write.Plain as TCT.Write.Plain
import qualified Language.TCT.Write.XML   as TCT.Write.XML

-- DTC imports
import qualified Language.DTC.Document    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.DTC.Read.TCT    as DTC
import qualified Language.DTC.Sym         as DTC
import qualified Language.RNC.Write       as RNC
import qualified Text.Blaze.DTC           as Blaze.DTC
import qualified Text.Blaze.Utils         as Blaze

-- * Golden testing utilities
testGolden :: TestName -> TestName -> IO (Either String BSL.ByteString) -> TestTree
testGolden inputFile expectedExt =
	goldenVsStringDiff inputFile diffGolden (inputFile <> expectedExt)
	 . (>>= unLeft)

diffGolden :: FilePath -> FilePath -> [String]
diffGolden ref new = ["diff", "-u", ref, new]

unLeft :: Either String BSL.ByteString -> IO BSL.ByteString
unLeft = \case
 Left err -> return $ TL.encodeUtf8 $ TL.pack err
 Right a  -> return a

-- * All golden tests
goldensIO :: IO TestTree
goldensIO = do
	inputFiles <- List.sort <$> findByExtension [".tct"] "test/Golden"
	return $
		testGroup "Hdoc"
		 [ goldensTCT inputFiles
		 , goldensDTC inputFiles
		 ]

-- * 'TCT' tests
readTCT :: FilePath -> IO (Either String TCT.Roots)
readTCT inputFile =
	left show <$>
	TCT.readTCT inputFile

goldensTCT :: [FilePath] -> TestTree
goldensTCT inputFiles =
	testGroup "TCT"
	 [ testGroup "AST"
		 [ testGolden inputFile ".ast" $
			readTCT inputFile >>= \ast ->
				return $
					TL.encodeUtf8
					 . TL.pack
					 . TCT.runPretty 0
					 <$> ast
		 | inputFile <- inputFiles
		 ]
	 , testGroup "Plain"
		 [ testGolden inputFile ".plain" $
			readTCT inputFile >>= \ast ->
				return $
					TL.encodeUtf8
					 . (<> TL.singleton '\n')
					 . TCT.Write.Plain.document
					 <$> ast
		 | inputFile <- inputFiles
		 ]
	 , testGroup "HTML5"
		 [ testGolden inputFile ".html5" $
			readTCT inputFile >>= \ast ->
				return $
					Blaze.renderHtml
					 . TCT.Write.HTML5.document
					 <$> ast
		 | inputFile <- inputFiles
		 ]
	 , testGroup "XML"
		 [ testGolden inputFile ".xml" $
			readTCT inputFile >>= \ast ->
				return $
					TL.encodeUtf8
					 . TL.pack
					 . TreeSeq.prettyTrees
					 . TCT.Write.XML.document
					 <$> ast
		 | inputFile <- inputFiles
		 ]
	 ]

-- * 'DTC' tests
type Langs = '[FR, EN]
readDTC :: FilePath -> IO (Either String DTC.Document)
readDTC inputFile = do
	readTCT inputFile >>= \case
	 Left err -> return $ Left err
	 Right tct ->
		let xml = TCT.Write.XML.document tct in
		case DTC.readDTC xml of
		 Left err -> return $ Left $ P.parseErrorPretty err
		 Right dtc -> return $ Right dtc

goldensDTC :: [FilePath] -> TestTree
goldensDTC inputFiles =
	let locale = LocaleIn @Langs en_US in
	let lang = Text.unpack $ textLocales Map.! locale in
	testGroup "DTC"
	 [ testGroup "RNC"
		 [ testGolden "schema/dtc.rnc" "" $ do
			return $
				Right $
				TL.encodeUtf8 $
				TL.unlines $
				TL.fromStrict
				 . RNC.renderWriter
				 <$> DTC.schema
		 ]
	 , testGroup "XML"
		 [ testGolden inputFile (".dtc"<>"."<>lang<>".xml") $
			readDTC inputFile >>= \dtc ->
				return $
					Blaze.prettyMarkup Blaze.DTC.isInlinedElement
					 . DTC.Write.XML.document locale
					 <$> dtc
		 | inputFile <- inputFiles
		 ]
	 , testGroup "HTML5"
		 [ testGolden inputFile (".dtc"<>"."<>lang<>".html5") $
			readDTC inputFile >>= \dtc ->
				return $
					Blaze.prettyMarkup Blaze.DTC.isInlinedElement
					 . DTC.Write.HTML5.document locale
					 <$> dtc
		 | inputFile <- inputFiles
		 ]
	 ]