{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Hdoc.DTC.Write.HTML5.Ident where

import Control.Category as Cat
import Control.Monad (Monad(..))
import Data.Bool
import Data.Char (Char)
import Data.Default.Class (Default(..))
import Data.Eq (Eq(..))
import Data.Foldable (Foldable(..))
import Data.Function (($))
import Data.Int (Int)
import Data.Locale (Loqualization)
import Data.Maybe (Maybe(..), maybe)
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String, IsString(..))
import Data.TreeSeq.Strict (Tree(..))
import Data.Tuple (snd)
import Text.Show (Show(..))
import qualified Data.ByteString.Lazy as BS
import qualified Data.Char as Char
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TL.Builder
import qualified Data.Text.Lazy.Builder.Int as TL.Builder
import qualified Data.Text.Lazy.Encoding as TL
import qualified Text.Blaze.Html5 as H

import Text.Blaze.Utils

import Hdoc.Utils ()
import Hdoc.DTC.Document as DTC
import Hdoc.DTC.Analyze.Index (plainifyWords)
import qualified Hdoc.DTC.Write.Plain as Plain
import qualified Hdoc.XML as XML

-- * Class 'Identify'
class Identify a where
	identify :: a -> Ident
instance Identify Char where
	identify = Ident . TL.singleton
instance Identify String where
	identify = Ident . TL.pack
instance Identify TL.Text where
	identify = Ident
instance Identify Ident where
	identify (Ident p) = identify p
instance Identify XML.Ancestors where
	identify =
		Ident .
		escapeIdentHead .
		snd . foldl' (\(nameParent,acc) (name,rank) ->
			(name,
				(if TL.null acc then acc else acc <> ".") <>
				(if name == nameParent
					then unIdent $ identify $ show rank
					else identifyString (show name)<>"."<>identifyString (show rank))
			)
		 )
		 ("",mempty)
		where identifyString = escapeIdentTail . TL.pack
instance Identify XML.Pos where
	identify = identify . XML.pos_ancestors
instance Identify Int where
	identify = fromString . show
instance Identify Nat where
	identify (Nat a) = identify a
instance Identify Nat1 where
	identify (Nat1 a) = identify a
instance Identify Anchor where
	identify Anchor{..} = identify anchor_section <> "." <> identify anchor_count

refIdent :: Ident -> H.AttributeValue
refIdent i = "#"<>attrify i

escapeIdent :: TL.Text -> Ident
escapeIdent = Ident . escapeIdentHead . escapeIdentTail
escapeIdentHead :: TL.Text -> TL.Text
escapeIdentHead = Cat.id
escapeIdentTail :: TL.Text -> TL.Text
escapeIdentTail =
	TL.foldr
	 (\c accum -> (<> accum) $ case c of
		 ' ' -> "+"
		 _ | Char.isAlphaNum c
		   || c == '-'
		   -> TL.singleton c
		 _ -> "_"<>bytes
			where
			enc    = TL.encodeUtf8 $ TL.singleton c
			bytes  = BS.foldr (\b acc -> escape b<>acc) "" enc
			escape = TL.Builder.toLazyText . TL.Builder.hexadecimal
	 ) ""

identifyIref :: Words -> Maybe Nat1 -> Ident
identifyIref term count =
	"iref"
	 <> "." <> identify (escapeIdent $ plainifyWords term)
	 <> maybe "" (("."<>) . identify) count

identifyTag :: Ident -> Ident -> Maybe Nat1 -> Ident
identifyTag suffix tag count =
	(if suffix == Ident ""
		then ""
		else "tag" <> suffix <> ".")
	 <> escapeIdent (unIdent tag)
	 <> maybe "" (("."<>) . identify) count

identifyReference :: Ident -> Ident -> Maybe Nat1 -> Ident
identifyReference suffix to count =
	"reference" <> suffix
	 <> "." <> to
	 <> maybe "" (("."<>) . identify) count

cleanPlain :: Plain -> Plain
cleanPlain ps =
	ps >>= \case
	 Tree PlainIref{} ls -> cleanPlain ls
	 Tree PlainNote{} _  -> mempty
	 Tree n ts -> return $ Tree n $ cleanPlain ts

identifyPlain :: Loqualization (Plain.L10n Plain.Plain) -> Plain -> Ident
identifyPlain reader_l10n =
	escapeIdent .
	Plain.text def{Plain.reader_l10n}

identifyTitle :: Loqualization (Plain.L10n Plain.Plain) -> Title -> Ident
identifyTitle state_l10n = identifyPlain state_l10n . unTitle