{-# 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) -> (Just name, (if TL.null acc then acc else acc <> ".") <> (if Just name == nameParent then unIdent $ identify $ show rank else identifyString (show name)<>"."<>identifyString (show rank)) ) ) (Nothing, mempty) where identifyString = escapeIdentTail . TL.pack {- instance Plainify XML.Ancestors where -- TODO: no need to be in Plainify, better in Ident 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 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 identifyAt :: Ident -> Ident -> Maybe Nat1 -> Ident identifyAt suffix ref count = (if suffix == Ident "" then "" else "at" <> suffix <> ".") <> escapeIdent (unIdent ref) <> 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