]> Git — Sourcephile - doclang.git/blob - Hdoc/DTC/Write/HTML5/Ident.hs
XML: use symantic-xml
[doclang.git] / Hdoc / DTC / Write / HTML5 / Ident.hs
1 {-# LANGUAGE FlexibleInstances #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 module Hdoc.DTC.Write.HTML5.Ident where
4
5 import Control.Category as Cat
6 import Control.Monad (Monad(..))
7 import Data.Bool
8 import Data.Char (Char)
9 import Data.Default.Class (Default(..))
10 import Data.Eq (Eq(..))
11 import Data.Foldable (Foldable(..))
12 import Data.Function (($))
13 import Data.Int (Int)
14 import Data.Locale (Loqualization)
15 import Data.Maybe (Maybe(..), maybe)
16 import Data.Monoid (Monoid(..))
17 import Data.Semigroup (Semigroup(..))
18 import Data.String (String, IsString(..))
19 import Data.TreeSeq.Strict (Tree(..))
20 import Data.Tuple (snd)
21 import Text.Show (Show(..))
22 import qualified Data.ByteString.Lazy as BS
23 import qualified Data.Char as Char
24 import qualified Data.Text.Lazy as TL
25 import qualified Data.Text.Lazy.Builder as TL.Builder
26 import qualified Data.Text.Lazy.Builder.Int as TL.Builder
27 import qualified Data.Text.Lazy.Encoding as TL
28 import qualified Text.Blaze.Html5 as H
29
30 import Text.Blaze.Utils
31
32 import Hdoc.Utils ()
33 import Hdoc.DTC.Document as DTC
34 import Hdoc.DTC.Analyze.Index (plainifyWords)
35 import qualified Hdoc.DTC.Write.Plain as Plain
36 import qualified Hdoc.XML as XML
37
38 -- * Class 'Identify'
39 class Identify a where
40 identify :: a -> Ident
41 instance Identify Char where
42 identify = Ident . TL.singleton
43 instance Identify String where
44 identify = Ident . TL.pack
45 instance Identify TL.Text where
46 identify = Ident
47 instance Identify Ident where
48 identify (Ident p) = identify p
49 instance Identify XML.Ancestors where
50 identify =
51 Ident .
52 escapeIdentHead .
53 snd . foldl' (\(nameParent,acc) (name,rank) ->
54 (Just name,
55 (if TL.null acc then acc else acc <> ".") <>
56 (if Just name == nameParent
57 then unIdent $ identify $ show rank
58 else identifyString (show name)<>"."<>identifyString (show rank))
59 )
60 )
61 (Nothing, mempty)
62 where identifyString = escapeIdentTail . TL.pack
63 {-
64 instance Plainify XML.Ancestors where -- TODO: no need to be in Plainify, better in Ident
65 plainify =
66 plainify .
67 snd . foldl' (\(nParent,acc) (n,c) ->
68 (n,
69 (if TL.null acc then acc else acc <> ".") <>
70 (if n == nParent
71 then TL.pack (show c)
72 else TL.pack (show n)<>TL.pack (show c))
73 )
74 )
75 ("","")
76 -}
77 instance Identify XML.Pos where
78 identify = identify . XML.pos_ancestors
79 instance Identify Int where
80 identify = fromString . show
81 instance Identify Nat where
82 identify (Nat a) = identify a
83 instance Identify Nat1 where
84 identify (Nat1 a) = identify a
85 instance Identify Anchor where
86 identify Anchor{..} = identify anchor_section <> "." <> identify anchor_count
87
88 refIdent :: Ident -> H.AttributeValue
89 refIdent i = "#"<>attrify i
90
91 escapeIdent :: TL.Text -> Ident
92 escapeIdent = Ident . escapeIdentHead . escapeIdentTail
93 escapeIdentHead :: TL.Text -> TL.Text
94 escapeIdentHead = Cat.id
95 escapeIdentTail :: TL.Text -> TL.Text
96 escapeIdentTail =
97 TL.foldr
98 (\c accum -> (<> accum) $ case c of
99 ' ' -> "+"
100 _ | Char.isAlphaNum c
101 || c == '-'
102 -> TL.singleton c
103 _ -> "_"<>bytes
104 where
105 enc = TL.encodeUtf8 $ TL.singleton c
106 bytes = BS.foldr (\b acc -> escape b<>acc) "" enc
107 escape = TL.Builder.toLazyText . TL.Builder.hexadecimal
108 ) ""
109
110 identifyIref :: Words -> Maybe Nat1 -> Ident
111 identifyIref term count =
112 "iref"
113 <> "." <> identify (escapeIdent $ plainifyWords term)
114 <> maybe "" (("."<>) . identify) count
115
116 identifyTag :: Ident -> Ident -> Maybe Nat1 -> Ident
117 identifyTag suffix tag count =
118 (if suffix == Ident ""
119 then ""
120 else "tag" <> suffix <> ".")
121 <> escapeIdent (unIdent tag)
122 <> maybe "" (("."<>) . identify) count
123
124 identifyAt :: Ident -> Ident -> Maybe Nat1 -> Ident
125 identifyAt suffix ref count =
126 (if suffix == Ident ""
127 then ""
128 else "at" <> suffix <> ".")
129 <> escapeIdent (unIdent ref)
130 <> maybe "" (("."<>) . identify) count
131
132 identifyReference :: Ident -> Ident -> Maybe Nat1 -> Ident
133 identifyReference suffix to count =
134 "reference" <> suffix
135 <> "." <> to
136 <> maybe "" (("."<>) . identify) count
137
138 cleanPlain :: Plain -> Plain
139 cleanPlain ps =
140 ps >>= \case
141 Tree PlainIref{} ls -> cleanPlain ls
142 Tree PlainNote{} _ -> mempty
143 Tree n ts -> return $ Tree n $ cleanPlain ts
144
145 identifyPlain :: Loqualization (Plain.L10n Plain.Plain) -> Plain -> Ident
146 identifyPlain reader_l10n =
147 escapeIdent .
148 Plain.text def{Plain.reader_l10n}
149
150 identifyTitle :: Loqualization (Plain.L10n Plain.Plain) -> Title -> Ident
151 identifyTitle state_l10n = identifyPlain state_l10n . unTitle