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

import Control.Category as Cat
import Data.Bool
import Data.Char (Char)
import Data.Eq (Eq(..))
import Data.Foldable (Foldable(..))
import Data.Function (($))
import Data.Int (Int)
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.Write.XML ()
import qualified Hdoc.DTC.Index as Index

-- * 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 (Tree PlainNode) where
	identify (Tree n ls) =
		case n of
		 PlainBreak  -> identify '\n'
		 PlainText t -> identify t
		 PlainGroup  -> identify ls
		 PlainB      -> identify ls
		 PlainCode   -> identify ls
		 PlainDel    -> identify ls
		 PlainI      -> identify ls
		 PlainSpan{} -> identify ls
		 PlainSub    -> identify ls
		 PlainSup    -> identify ls
		 PlainSC     -> identify ls
		 PlainU      -> identify ls
		 PlainNote{} -> ""
		 PlainQ      -> identify ls
		 PlainEref{} -> identify ls
		 PlainIref{} -> identify ls
		 PlainRef{}  -> identify ls
		 PlainRref{..} -> identify to
instance Identify Ident where
	identify (Ident p) = identify p
instance Identify Plain where
	identify = foldMap identify
instance Identify Title where
	identify (Title p) = identify p
instance Identify PosPath where
	identify =
		escapeIdentHead .
		snd . foldl' (\(nameParent,acc) (name,rank) ->
			(name,
				(if TL.null $ unIdent acc then acc else acc <> ".") <>
				(if name == nameParent
					then identify (show rank)
					else escapeIdentTail $ identify (show name)<>identify (show rank))
			)
		 )
		 ("",mempty)
instance Identify Pos where
	identify = identify . pos_Ancestors
instance Identify Path where
	identify (Path a) = identify a
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 section <> "." <> identify count

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

escapeIdent :: Ident -> Ident
escapeIdent = escapeIdentHead . escapeIdentTail
escapeIdentHead :: Ident -> Ident
escapeIdentHead (Ident i) = Ident i
escapeIdentTail :: Ident -> Ident
escapeIdentTail (Ident i) =
	Ident $
	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
	 ) "" i

identifyIref :: Words -> Ident
identifyIref term =
	"iref" <> "." <> identify (Index.plainifyWords term)
identifyIrefCount :: Words -> Nat1 -> Ident
identifyIrefCount term count =
	"iref"
	 <> "." <> identify (Index.plainifyWords term)
	 <> "." <> identify count