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

import Control.Applicative (Applicative(..), liftA2)
import Control.Category
import Control.Monad
import Data.Bool
import Data.Default.Class (Default(..))
import Data.Eq (Eq(..))
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.Tuple (fst, snd)
import Data.String (String, IsString(..))
import Prelude (mod)
import Text.Show (Show(..))
import qualified Control.Monad.Trans.State as S
import qualified Data.List as List
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB

import Data.Locale hiding (Index)

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

-- * Type 'Plain'
type Plain = S.State State TLB.Builder

runPlain :: Plain -> State -> (TL.Text, State)
runPlain p s =
	let (b,s') = S.runState p s in
	(TLB.toLazyText b, s')

text :: Plainify a => State -> a -> TL.Text
text st a = fst $ runPlain (plainify a) st

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

-- ** Type 'State'
data State
 =   State
 {   state_localize :: L10n -> Plain
 ,   state_italic   :: Bool
 ,   state_quote    :: Nat
 }
instance Default State where
	def = State
	 { state_localize = plainify . show
	 , state_italic   = False
	 , state_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
		 PlainBR       -> "\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 State
		 PlainQ        ->
			let depth = Nat 0 in
			plainify L10n_QuoteOpen{..} <>
			plainify ls <>
			plainify L10n_QuoteClose{..}
		 PlainSC       -> plainify ls
		 PlainSub      -> plainify ls
		 PlainSup      -> plainify ls
		 PlainU        -> "_"<>plainify ls<>"_"
		 PlainEref{..} -> plainify ls
		 PlainIref{..} -> plainify ls
		 PlainRef{..}  -> plainify ls
		 PlainRref{..} -> plainify ls
instance Plainify Title where
	plainify (Title t) = plainify t
instance Plainify PosPath where
	plainify =
		plainify .
		snd . foldl' (\(nParent,acc) (n,c) ->
			(n,
				(if TL.null acc then acc else acc <> ".") <>
				(if n == nParent
					then TL.pack (show c)
					else TL.pack (show n)<>TL.pack (show c))
			)
		 )
		 ("","")
instance Plainify XmlName 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'
data L10n
 =   L10n_Table_of_Contents
 |   L10n_Colon
 |   L10n_QuoteOpen  {depth :: Nat}
 |   L10n_QuoteClose {depth :: Nat}
 |   L10n_Date Date
 deriving (Show)
instance Plainify L10n where
	plainify msg = do
		loc <- S.gets state_localize
		loc msg
instance LocalizeIn FR Plain L10n where
	localizeIn _ = \case
	 L10n_Table_of_Contents -> "Sommaire"
	 L10n_Colon -> " : "
	 L10n_QuoteOpen{..} ->
		case unNat depth `mod` 3 of
		 0 -> "« "
		 1 -> "“"
		 _ -> "‟"
	 L10n_QuoteClose{..} ->
		case unNat depth `mod` 3 of
		 0 -> " »"
		 1 -> "”"
		 _ -> "„"
	 L10n_Date Date{..} ->
		mconcat $
		List.intersperse " " $
		concat
		 [ maybe [] (pure . plainify) day
		 , case 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"
				 _  -> []
		 , [plainify year]
		 ]
instance LocalizeIn EN Plain L10n where
	localizeIn _ = \case
	 L10n_Table_of_Contents -> "Summary"
	 L10n_Colon -> ": "
	 L10n_QuoteOpen{..} ->
		case unNat depth `mod` 3 of
		 0 -> "“"
		 1 -> "« "
		 _ -> "‟"
	 L10n_QuoteClose{..} ->
		case unNat depth `mod` 3 of
		 0 -> "”"
		 1 -> " »"
		 _ -> "„"
	 L10n_Date Date{..} ->
		mconcat $
		List.intersperse " " $
		concat
		 [ maybe [] (pure . plainify) day
		 , case 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"
				 _  -> []
		 , [plainify year]
		 ]