{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hdoc.DTC.Write.Plain where

import Control.Applicative (Applicative(..), liftA2)
import Control.Category
import Control.Monad
import Data.Default.Class (Default(..))
import Data.Foldable (Foldable(..), concat)
import Data.Function (($))
import Data.Int (Int)
import Data.Maybe (Maybe(..), maybe)
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Data.TreeSeq.Strict (Tree(..))
import Data.String (String, IsString(..))
import Prelude (mod)
import Text.Show (Show(..))
import qualified Control.Monad.Trans.Reader as R
import qualified Data.List as List
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified Language.Symantic.XML as XML

import Data.Locale hiding (Index)

import Hdoc.DTC.Write.XML ()
import Hdoc.DTC.Document as DTC hiding (Plain)
import qualified Hdoc.DTC.Document as DTC

-- * Type 'Plain'
type Plain = R.Reader Reader TLB.Builder

runPlain :: Plain -> Reader -> TL.Text
runPlain p ro = TLB.toLazyText $ R.runReader p ro

text :: Plainify a => Reader -> a -> TL.Text
text ro a = runPlain (plainify a) ro

instance IsString Plain where
	fromString = return . fromString
instance Semigroup Plain where
	(<>) = liftA2 (<>)
instance Monoid Plain where
	mempty  = return ""
	mappend = (<>)

-- ** Type 'Reader'
data Reader = Reader -- TODO: could be a Reader
 { reader_l10n   :: Loqualization (L10n Plain)
 , reader_quote  :: Nat
 }
instance Default Reader where
	def = Reader
	 { reader_l10n   = Loqualization EN_US
	 , reader_quote  = Nat 0
	 }

-- * Class 'Plainify'
class Plainify a where
	plainify :: a -> Plain
instance Plainify String where
	plainify = return . TLB.fromString
instance Plainify Text where
	plainify = return . TLB.fromText
instance Plainify TL.Text where
	plainify = return . TLB.fromLazyText
{-
instance Plainify Para where
	plainify = \case
	 ParaItem{..}  -> plainify item
	 ParaItems{..} -> plainify items
-}
instance Plainify DTC.Plain where
	plainify = foldMap plainify
instance Plainify (Tree PlainNode) where
	plainify (Tree n ls) =
		case n of
		 PlainBreak    -> "\n"
		 PlainText txt -> plainify txt
		 PlainGroup    -> plainify ls
		 PlainB        -> "*"<>plainify ls<>"*"
		 PlainCode     -> "`"<>plainify ls<>"`"
		 PlainDel      -> "-"<>plainify ls<>"-"
		 PlainI        -> "/"<>plainify ls<>"/"
		 PlainNote{..} -> "" -- TODO: to be coded, with a switch on/off in Reader
		 PlainQ        -> do
			Reader{reader_l10n=Loqualization loc} <- R.ask
			l10n_Quote (plainify ls) loc
		 PlainSC       -> plainify ls
		 PlainSpan{..} -> plainify ls
		 PlainSub      -> plainify ls
		 PlainSup      -> plainify ls
		 PlainU        -> "_"<>plainify ls<>"_"
		 PlainEref{..} -> plainify ls
		 PlainIref{..} -> plainify ls
		 PlainAt{..}   -> (if at_back  then "~" else mempty)<>"@"<>plainify ls<>"@"
		 PlainTag{..}  -> (if tag_back then "~" else mempty)<>"#"<>plainify ls<>"#"
		 PlainRef{..} ->
			(if null ls then mempty else "("<>plainify ls<> ")") <>
			"["<>plainify (unIdent ref_ident)<>"]"
		 PlainPageRef{..} ->
			(if null ls then mempty else "("<>plainify ls<> ")") <>
			maybe "@" (\at -> "@"<>plainify (unIdent at)<>"@") pageRef_at <>
			"["<>plainify pageRef_path<>"]"
instance Plainify Title where
	plainify (Title t) = plainify t
instance Plainify XML.QName where
	plainify = plainify . show
instance Plainify Int where
	plainify = plainify . show
instance Plainify Nat where
	plainify (Nat n) = plainify n
instance Plainify Nat1 where
	plainify (Nat1 n) = plainify n

-- * Type 'L10n'
class L10n msg lang where
	l10n_Colon             ::         FullLocale lang -> msg
	l10n_Table_of_Contents ::         FullLocale lang -> msg
	l10n_Quote             :: msg  -> FullLocale lang -> msg
	l10n_Date              :: Date -> FullLocale lang -> msg

instance L10n TL.Text FR where
	l10n_Colon _loc = " : "
	l10n_Table_of_Contents _loc = "Sommaire"
	l10n_Quote msg _loc = "« "<>msg<>" »"
	l10n_Date Date{..} _loc =
		TL.pack $
		mconcat $
		List.intersperse " " $
		concat
		 [ maybe [] (pure . show) date_day
		 , case date_month of
			 Nothing -> []
			 Just (Nat1 m) ->
				case m of
				 1  -> pure "janvier"
				 2  -> pure "février"
				 3  -> pure "mars"
				 4  -> pure "avril"
				 5  -> pure "mai"
				 6  -> pure "juin"
				 7  -> pure "juillet"
				 8  -> pure "août"
				 9  -> pure "septembre"
				 10 -> pure "octobre"
				 11 -> pure "novembre"
				 12 -> pure "décembre"
				 _  -> []
		 , [show date_year]
		 ]
instance L10n TL.Text EN where
	l10n_Colon _loc = ": "
	l10n_Table_of_Contents _loc = "Table of Contents"
	l10n_Quote msg _loc = "“"<>msg<>"”"
	l10n_Date Date{..} _loc =
		TL.pack $
		mconcat $
		List.intersperse " " $
		concat
		 [ maybe [] (pure . show) date_day
		 , case date_month of
			 Nothing -> []
			 Just (Nat1 m) ->
				case m of
				 1  -> pure "January"
				 2  -> pure "February"
				 3  -> pure "March"
				 4  -> pure "April"
				 5  -> pure "May"
				 6  -> pure "June"
				 7  -> pure "July"
				 8  -> pure "August"
				 9  -> pure "September"
				 10 -> pure "October"
				 11 -> pure "November"
				 12 -> pure "December"
				 _  -> []
		 , [show date_year]
		 ]

instance L10n Plain FR where
	l10n_Colon loc = plainify (l10n_Colon loc::TL.Text)
	l10n_Table_of_Contents loc = plainify (l10n_Table_of_Contents loc::TL.Text)
	l10n_Quote msg _loc = do
		depth <- R.asks reader_quote
		let (o,c) =
			case unNat depth `mod` 3 of
			 0 -> ("« "," »")
			 1 -> ("“","”")
			 _ -> ("‟","„")
		m <- R.local (\ro -> ro{reader_quote=succNat depth}) msg
		return $ o <> m <> c
	l10n_Date date loc = plainify (l10n_Date date loc::TL.Text)
instance L10n Plain EN where
	l10n_Colon loc = plainify (l10n_Colon loc::TL.Text)
	l10n_Table_of_Contents loc = plainify (l10n_Table_of_Contents loc::TL.Text)
	l10n_Quote msg _loc = do
		depth <- R.asks reader_quote
		let (o,c) =
			case unNat depth `mod` 3 of
			 0 -> ("“","”")
			 1 -> ("« "," »")
			 _ -> ("‟","„")
		m <- R.local (\s -> s{reader_quote=succNat depth}) msg
		return $ o <> m <> c
	l10n_Date date loc = plainify (l10n_Date date loc::TL.Text)

{-
-- ** Type 'L10nPlain'
-- | Useful newtype to just use 'plainify', instead of 'state_l10n'.
newtype L10nPlain = L10nPlain (forall l. L10n l Plain => FullLocale l -> Plain)
instance Plainify L10nPlain where
	plainify (L10nPlain l10n) = do
		State{state_l10n} <- S.get
		l10n state_l10n
-}