]> Git — Sourcephile - doclang.git/blob - Hdoc/DTC/Write/HTML5/Ident.hs
Improve checking.
[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 qualified Hdoc.DTC.Index as Index
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 (name,
55 (if TL.null acc then acc else acc <> ".") <>
56 (if name == nameParent
57 then unIdent $ identify $ show rank
58 else identifyString (show name)<>"."<>identifyString (show rank))
59 )
60 )
61 ("",mempty)
62 where identifyString = escapeIdentTail . TL.pack
63 instance Identify XML.Pos where
64 identify = identify . XML.pos_ancestors
65 instance Identify Int where
66 identify = fromString . show
67 instance Identify Nat where
68 identify (Nat a) = identify a
69 instance Identify Nat1 where
70 identify (Nat1 a) = identify a
71 instance Identify Anchor where
72 identify Anchor{..} = identify anchor_section <> "." <> identify anchor_count
73
74 refIdent :: Ident -> H.AttributeValue
75 refIdent i = "#"<>attrify i
76
77 escapeIdent :: TL.Text -> Ident
78 escapeIdent = Ident . escapeIdentHead . escapeIdentTail
79 escapeIdentHead :: TL.Text -> TL.Text
80 escapeIdentHead = Cat.id
81 escapeIdentTail :: TL.Text -> TL.Text
82 escapeIdentTail =
83 TL.foldr
84 (\c accum -> (<> accum) $ case c of
85 ' ' -> "+"
86 _ | Char.isAlphaNum c
87 || c == '-'
88 -> TL.singleton c
89 _ -> "_"<>bytes
90 where
91 enc = TL.encodeUtf8 $ TL.singleton c
92 bytes = BS.foldr (\b acc -> escape b<>acc) "" enc
93 escape = TL.Builder.toLazyText . TL.Builder.hexadecimal
94 ) ""
95
96 identifyIref :: Words -> Ident
97 identifyIref term =
98 "iref"
99 <> "." <> identify (Index.plainifyWords term)
100 identifyIrefCount :: Words -> Nat1 -> Ident
101 identifyIrefCount term count =
102 "iref"
103 <> "." <> identify (Index.plainifyWords term)
104 <> "." <> identify count
105
106 identifyTag :: Ident -> Loqualization (Plain.L10n Plain.Plain) -> Plain -> Maybe Nat1 -> Ident
107 identifyTag suffix state_l10n to count =
108 "tag" <> suffix
109 <> "." <> identifyPlain state_l10n to
110 <> maybe "" (("."<>) . identify) count
111
112 identifyReference :: Ident -> Ident -> Maybe Nat1 -> Ident
113 identifyReference suffix to count =
114 "reference" <> suffix
115 <> "." <> to
116 <> maybe "" (("."<>) . identify) count
117
118 cleanPlain :: Plain -> Plain
119 cleanPlain ps =
120 ps >>= \case
121 Tree PlainIref{} ls -> cleanPlain ls
122 Tree PlainNote{} _ -> mempty
123 Tree n ts -> return $ Tree n $ cleanPlain ts
124
125 identifyPlain :: Loqualization (Plain.L10n Plain.Plain) -> Plain -> Ident
126 identifyPlain state_l10n =
127 escapeIdent .
128 Plain.text def{Plain.state_l10n}
129
130 identifyTitle :: Loqualization (Plain.L10n Plain.Plain) -> Title -> Ident
131 identifyTitle state_l10n = identifyPlain state_l10n . unTitle