{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Textphile.CLI.Lang where

import Control.Applicative (Applicative(..), (<*), liftA2, liftA3)
import Control.Monad.Trans.Reader (Reader, runReader, ReaderT, runReaderT, ask)
import Data.Bool
import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.Functor (Functor(..), (<$>))
import Data.Locale
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String, IsString(..))
import Data.Text (Text)
import Symantic.CLI (Outputable(..), OnHandle(..), IOType)
import System.IO (IO, FilePath)
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import qualified Data.Text.Lazy.Builder as TLB
import qualified Symantic.CLI as CLI
import qualified Symantic.Document as Doc
import qualified System.Environment as Env

type Doc = Reader Loq (Doc.Plain TLB.Builder)

instance (Semigroup d, Applicative m) => Semigroup (ReaderT r m (Doc.Plain d)) where
	(<>) = liftA2 (<>)
instance (Monoid d, Applicative m) => Monoid (ReaderT r m (Doc.Plain d)) where
	mempty = pure mempty
	mappend = liftA2 mappend
instance
 ( Doc.From (Doc.Word String) d
 , Applicative m
 , Doc.Spaceable d
 ) => IsString (ReaderT r m (Doc.Plain d)) where
	fromString = pure . fromString
instance
 ( Applicative m
 , Doc.Spaceable d
 ) => Doc.Spaceable (ReaderT r m (Doc.Plain d)) where
	newline = pure Doc.newline
	space = pure Doc.space
instance
 ( Functor m
 , Semigroup d
 , Doc.From [Doc.SGR] d
 ) => Doc.Colorable16 (ReaderT r m (Doc.Plain d)) where
	reverse     = fmap Doc.reverse
	black       = fmap Doc.black
	red         = fmap Doc.red
	green       = fmap Doc.green
	yellow      = fmap Doc.yellow
	blue        = fmap Doc.blue
	magenta     = fmap Doc.magenta
	cyan        = fmap Doc.cyan
	white       = fmap Doc.white
	blacker     = fmap Doc.blacker
	redder      = fmap Doc.redder
	greener     = fmap Doc.greener
	yellower    = fmap Doc.yellower
	bluer       = fmap Doc.bluer
	magentaer   = fmap Doc.magentaer
	cyaner      = fmap Doc.cyaner
	whiter      = fmap Doc.whiter
	onBlack     = fmap Doc.onBlack
	onRed       = fmap Doc.onRed
	onGreen     = fmap Doc.onGreen
	onYellow    = fmap Doc.onYellow
	onBlue      = fmap Doc.onBlue
	onMagenta   = fmap Doc.onMagenta
	onCyan      = fmap Doc.onCyan
	onWhite     = fmap Doc.onWhite
	onBlacker   = fmap Doc.onBlacker
	onRedder    = fmap Doc.onRedder
	onGreener   = fmap Doc.onGreener
	onYellower  = fmap Doc.onYellower
	onBluer     = fmap Doc.onBluer
	onMagentaer = fmap Doc.onMagentaer
	onCyaner    = fmap Doc.onCyaner
	onWhiter    = fmap Doc.onWhiter
instance
 ( Applicative m
 , Semigroup d
 , Doc.From [Doc.SGR] d
 ) => Doc.Decorable (ReaderT r m (Doc.Plain d)) where
	bold      = fmap Doc.bold
	underline = fmap Doc.underline
	italic    = fmap Doc.italic
instance
 ( Applicative m
 , Semigroup d
 , Doc.Spaceable d
 ) => Doc.Wrappable (ReaderT r m (Doc.Plain d)) where
	setWidth w = fmap (Doc.setWidth w)
	breakpoint = pure Doc.breakpoint
	breakspace = pure Doc.breakspace
	breakalt   = liftA2 Doc.breakalt
	endline    = pure Doc.endline
instance
 ( Applicative m
 , Semigroup d
 , Doc.Spaceable d
 ) => Doc.Justifiable (ReaderT r m (Doc.Plain d)) where
	justify = fmap Doc.justify
instance
 ( Applicative m
 , Semigroup d
 , Doc.Spaceable d
 ) => Doc.Indentable (ReaderT r m (Doc.Plain d)) where
	align = fmap Doc.align
	setIndent d i x = Doc.setIndent <$> d <*> pure i <*> x
	incrIndent d i x = Doc.incrIndent <$> d <*> pure i <*> x
	fill i = fmap (Doc.fill i)
	fillOrBreak i = fmap (Doc.fillOrBreak i)
instance
 ( Applicative m
 , Semigroup d
 , Doc.Lengthable s
 , Doc.From (Doc.Word s) d
 ) => Doc.From (Doc.Word s) (ReaderT r m (Doc.Plain d)) where
	from = pure . Doc.from
instance Doc.From String Doc where
	from = pure . Doc.from
instance Doc.From Text Doc where
	from = pure . Doc.from

instance IOType Doc
instance Outputable Doc where
	output d = do
		lang <- getLang
		output $ runReader d $ loqualize lang
instance Outputable (OnHandle Doc) where
	output (OnHandle h d) = do
		lang <- getLang
		output $ OnHandle h $ runReader d $ loqualize lang

getLang :: IO Lang
getLang =
	(\v -> Map.findWithDefault
	 (LocaleIn @Langs en_US)
	 (Text.pack $ List.takeWhile (\c -> Char.isAlphaNum c || c == '_') v)
	 (locales @Langs)) .
	fromMaybe ""
	 <$> Env.lookupEnv "LANG"

type Name = Text

-- * Type 'Lang'
-- | Supported locales
type Langs = '[FR, EN]
type Lang  = LocaleIn Langs

l10n_var v = "<"<>Doc.from v<>">"
ref = Doc.underline
con = Doc.between "\"" "\""
fileRef = ref

-- ** Class 'L10n'
type Loq = Loqualization L10n

helps ::
 CLI.CLI_Help repr =>
 CLI.HelpConstraint repr Doc =>
 (forall lang. L10n lang => FullLocale lang -> Doc.Plain TLB.Builder) ->
 repr f k -> repr f k
helps f = CLI.help @_ @Doc (Doc.justify ((\(Loqualization fl) -> f fl) <$> ask))
infixr 0 `helps`

-- | Localization
class L10n_Var lang => L10n lang where
	l10n_cli                   :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_license               :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_version          :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_license          :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_command_source   :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_command_compile  :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_command_schema   :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_opt_lang         :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_opt_output       :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_opt_output_css   :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_opt_output_js    :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_opt_dump_tct     :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_opt_dump_xml     :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_opt_dump_deps    :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_opt_dump_dtc     :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_format           :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_format_plain     :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_format_html5     :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_format_xml       :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_opt_input        :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_opt_help_full    :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_opt_help_compact :: FullLocale lang -> Doc.Plain TLB.Builder
	l10n_help_opt_verbosity    :: FullLocale lang -> Doc.Plain TLB.Builder

instance L10n EN where
	l10n_cli _ = "Compiler of Convivial Technical Document (DTC)."
	l10n_license _ =
		fromString $
		List.intercalate "\n"
		 [ "License: GNU GPLv3+"
		 , "Copyright: Julien Moutinho <julm+textphile@sourcephile.fr>"
		 , ""
		 , "hdoc is free software: you can redistribute it and/or modify it"
		 , "under the terms of the GNU General Public License (GPL)"
		 , "as published by the Free Software Foundation;"
		 , "either in version 3, or (at your option) any later version."
		 , ""
		 , "hdoc is distributed in the hope that it will be useful,"
		 , "but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY"
		 , "or FITNESS FOR A PARTICULAR PURPOSE."
		 , ""
		 , "See the GNU GPL for more details."
		 , "You should have received a copy of the GNU GPL along with hdoc."
		 , "If not, see: http://www.gnu.org/licenses/"
		 ]
	l10n_help_version         _ = "Show the version of this program."
	l10n_help_license         _ = "Inform about the license of this program."
	l10n_help_command_source  _ = "Format the source code of a TCT document."
	l10n_help_command_compile _ = "Compile a TCT document into a format optimized for reading."
	l10n_help_command_schema  _ = "Show in RNC (RelaxNG Compact) format the XML schema of the DTC format."
	l10n_help_opt_lang l = mconcat
	 [ "Use the language given by "
	 , l10n_var $ l10n_var_locale l
	 , "."
	 ]
	l10n_help_opt_output l = mconcat
	 [ "Output document into "
	 , l10n_var $ l10n_var_file l
	 ]
	l10n_help_opt_output_css  l = mconcat
	 [ "Output CSS stylesheet into "
	 , l10n_var $ l10n_var_file l
	 , " (if any), instead of incorporating it into the HTML."
	 ]
	l10n_help_opt_output_js l = mconcat
	 [ "Output JavaScript script into "
	 , l10n_var $ l10n_var_file l
	 , " (if any), instead of incorporating it into the HTML."
	 ]
	l10n_help_opt_dump_tct l = mconcat
	 [ "Dump internal TCT representation of "
	 , l10n_var $ l10n_var_file l,".tct file,"
	 , " in a"
	 , l10n_var $ l10n_var_file l,".tct.dump file."
	 ]
	l10n_help_opt_dump_xml l = mconcat
	 [ "Dump internal XML representation of "
	 , l10n_var $ l10n_var_file l,".tct file,"
	 , " in a"
	 , l10n_var $ l10n_var_file l,".xml.dump file."
	 ]
	l10n_help_opt_dump_deps l = mconcat
	 [ "Dump dependencies of ", l10n_var $ l10n_var_file l,".tct file"
	 , " in ", l10n_var $ l10n_var_file l,".deps file,"
	 , " separated by newlines."
	 ]
	l10n_help_opt_dump_dtc      _ = "Dump internal representation of DTC."
	l10n_help_opt_help_full     _ = "Print a commented grammar tree to help using this program."
	l10n_help_opt_help_compact  _ = "Print an uncommented grammar tree to help using this program."
	l10n_help_format            _ = "Output format."
	l10n_help_format_plain      _ = "Output as plain text."
	l10n_help_format_html5      _ = "Output as HTML5."
	l10n_help_format_xml        _ = "Output as XML."
	l10n_help_opt_input l = mconcat
	 [ "Read input from ", l10n_var $ l10n_var_file l, "." ]
	l10n_help_opt_verbosity _ =
		"Verbosity level.\
		\\n(default: "<>con "info"<>")"
instance L10n FR where
	l10n_cli _ = "Compilateur de Document Technique Convivial (DTC)."
	l10n_license _ =
		fromString $
		List.intercalate "\n"
		 [ "Licence : GPLv3+ GNU"
		 , "Auteur : Julien Moutinho <julm+textphile@sourcephile.fr>"
		 , ""
		 , "textphile est un logiciel libre : vous pouvez le redistribuer et/ou le modifier"
		 , "selon les termes de la Licence Publique Générale (GPL) GNU"
		 , "telle que publiée par la Free Software Foundation ;"
		 , "en version 3, ou (à votre choix) n’importe quelle version ultérieure."
		 , ""
		 , "textphile est distribué dans l’espoir qu’il sera utile,"
		 , "mais SANS AUCUNE GARANTIE ; sans même la garantie implicite de COMMERCIALISATION"
		 , "ou de CONVENANCE À UN BUT PARTICULIER."
		 , ""
		 , "Voyez la GPL pour davantage de détails."
		 , "Vous devriez avoir reçu une copie de la GPL avec textphile."
		 , "Si non, voyez : http://www.gnu.org/licenses/"
		 ]
	l10n_help_version         _ = "Affiche la version de ce logiciel."
	l10n_help_license         _ = "Informe sur la licence de ce logiciel."
	l10n_help_command_source  _ = "Lit un document TCT et écrit un rendu préservant sa syntaxe."
	l10n_help_command_compile _ = "Compile un document TCT vers un format optimisé pour la lecture."
	l10n_help_command_schema  _ = "Affiche au format RNC (RelaxNG Compact) le schéma XML du format DTC."
	l10n_help_opt_lang l = mconcat
	 [ "Utilise le langage indiqué par "
	 , l10n_var $ l10n_var_locale l, "." ]
	l10n_help_opt_output l = mconcat
	 [ "Écrit dans ", l10n_var $ l10n_var_file l, "." ]
	l10n_help_opt_output_css l = mconcat
	 [ "Écrit la feuille de style CSS dans "
	 , l10n_var $ l10n_var_file l
	 , ", au lieu de l’incorporer dans le HTML."
	 ]
	l10n_help_opt_output_js l = mconcat
	 [ "Écrit le script JavaScript dans "
	 , l10n_var $ l10n_var_file l
	 , ", au lieu de l’incorporer dans le HTML."
	 ]
	l10n_help_opt_dump_tct l = mconcat
	 [ "Écrit la représentation TCT interne de "
	 , l10n_var $ l10n_var_file l,".tct,"
	 , " dans "
	 , l10n_var $ l10n_var_file l,".tct.dump."
	 ]
	l10n_help_opt_dump_xml l = mconcat
	 [ "Écrit la représentation XML interne de "
	 , l10n_var $ l10n_var_file l,".tct,"
	 , " dans "
	 , l10n_var $ l10n_var_file l,".xml.dump."
	 ]
	l10n_help_opt_dump_deps l = mconcat
	 [ "Écrit les dépendences de ", l10n_var $ l10n_var_file l,".tct"
	 , " dans ", l10n_var $ l10n_var_file l,".deps,"
	 , " séparées par des retours à la ligne."
	 ]
	l10n_help_opt_dump_dtc     _ = "Écrit la représentation interne du DTC."
	l10n_help_opt_help_full    _ = "Affiche un arbre grammatical avec commentaires pour aider à utiliser ce programme."
	l10n_help_opt_help_compact _ = "Affiche un arbre grammatical sans commentaires pour aider à utiliser ce programme."
	l10n_help_format           _ = "Format de sortie."
	l10n_help_format_plain     _ = "Produit du texte brut."
	l10n_help_format_html5     _ = "Produit du HTML5."
	l10n_help_format_xml       _ = "Produit du XML."
	l10n_help_opt_input l = mconcat
	 [ "Lit depuis ", l10n_var $ l10n_var_file l, "." ]
	l10n_help_opt_verbosity _ =
		"Niveau de verbosité.\
		\\n(défault : "<>con "info"<>")"

-- ** Class 'L10n_Var'
class L10n_Var lang where
	l10n_var_file   :: FullLocale lang -> Name
	l10n_var_locale :: FullLocale lang -> Name
instance L10n_Var EN where
	l10n_var_file   _ = "file"
	l10n_var_locale _ = "locale"
instance L10n_Var FR where
	l10n_var_file   _ = "fichier"
	l10n_var_locale _ = "locale"