{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# 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.String (String)
import Data.Text (Text)
import Data.TreeSeq.Strict (Tree(..))
import Data.Tuple (fst, snd)
import Data.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 (localize, Index)

import Language.DTC.Write.XML ()
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    :: DTC.Nat
 }
instance Default State where
	def = State
	 { state_localize = plainify . show
	 , state_italic   = False
	 , state_quote    = DTC.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 DTC.Para where
	plainify = foldMap plainify
instance Plainify DTC.Lines where
	plainify = \case
	 Tree0 v ->
		case v of
		 DTC.BR -> "\n"
		 DTC.Plain p -> plainify p
	 TreeN k ls ->
		case k of
		 DTC.B        -> "*"<>plainify ls<>"*"
		 DTC.Code     -> "`"<>plainify ls<>"`"
		 DTC.Del      -> "-"<>plainify ls<>"-"
		 DTC.I        -> "/"<>plainify ls<>"/"
		 DTC.Note     -> ""
		 DTC.Q        ->
			let depth = DTC.Nat 0 in
			plainify (L10n_QuoteOpen{..}) <>
			plainify ls <>
			plainify (L10n_QuoteClose{..})
		 DTC.SC       -> plainify ls
		 DTC.Sub      -> plainify ls
		 DTC.Sup      -> plainify ls
		 DTC.U        -> "_"<>plainify ls<>"_"
		 DTC.Eref{..} -> plainify ls
		 DTC.Iref{..} -> plainify ls
		 DTC.Ref{..}  -> plainify ls
		 DTC.Rref{..} -> plainify ls
instance Plainify DTC.Title where
	plainify (DTC.Title t) = plainify t
instance Plainify DTC.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 DTC.XmlName where
	plainify = plainify . show
instance Plainify Int where
	plainify = plainify . show
instance Plainify DTC.Nat where
	plainify (DTC.Nat n) = plainify n
instance Plainify DTC.Nat1 where
	plainify (DTC.Nat1 n) = plainify n

-- * Type 'L10n'
data L10n
 =   L10n_Table_of_Contents
 |   L10n_Colon
 |   L10n_QuoteOpen  {depth :: DTC.Nat}
 |   L10n_QuoteClose {depth :: DTC.Nat}
 |   L10n_Date DTC.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 DTC.unNat depth `mod` 3 of
		 0 -> "« "
		 1 -> "“"
		 _ -> "‟"
	 L10n_QuoteClose{..} ->
		case DTC.unNat depth `mod` 3 of
		 0 -> " »"
		 1 -> "”"
		 _ -> "„"
	 L10n_Date DTC.Date{..} ->
		mconcat $
		List.intersperse " " $
		concat
		 [ maybe [] (pure . plainify) day
		 , case month of
			 Nothing -> []
			 Just (DTC.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 DTC.unNat depth `mod` 3 of
		 0 -> "“"
		 1 -> "« "
		 _ -> "‟"
	 L10n_QuoteClose{..} ->
		case DTC.unNat depth `mod` 3 of
		 0 -> "”"
		 1 -> " »"
		 _ -> "„"
	 L10n_Date DTC.Date{..} ->
		mconcat $
		List.intersperse " " $
		concat
		 [ maybe [] (pure . plainify) day
		 , case month of
			 Nothing -> []
			 Just (DTC.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]
		 ]