Add <ref> and <rref> DTC writing.

diff --git a/Language/TCT/Write/DTC.hs b/Language/TCT/Write/DTC.hs
index bf61bf4f2dcf210ca662db8cef39520ef3c83ff9..482678133e1075ac2f52e60f395ed8ac097a151a 100644 (file)
--- a/Language/TCT/Write/DTC.hs
+++ b/Language/TCT/Write/DTC.hs
@@ -312,6 +312,11 @@ d_Tokens tok = goTokens tok
        go (TokenTag t)    = D.ref mempty ! DA.to (attrValue t)
        go (TokenEscape c) = B.toMarkup c
        go (TokenLink lnk) = D.eref (B.toMarkup lnk) ! DA.to (attrValue lnk)
+       go (TokenPair PairBracket ts)
+        | to <- Write.t_Tokens ts
+        , TL.all (\c -> Char.isAlphaNum c || Char.isSymbol c) to =
+               D.rref ! DA.to (attrValue $ TL.toStrict to) $ mempty
+       go (TokenPair PairStar ts)        = D.b $ goTokens ts
        go (TokenPair PairSlash ts)       = D.i $ goTokens ts
        go (TokenPair PairBackquote ts)   = D.code $ goTokens ts
        go (TokenPair PairFrenchquote toks@(Tokens ts)) =
@@ -344,7 +349,16 @@ d_Tokens tok = goTokens tok
                goTokens ts
                B.toMarkup c
        goTokens :: Tokens -> DTC
-       goTokens (Tokens ts) = foldMap go ts
+       goTokens (Tokens toks) =
+               case Seq.viewl toks of
+                TokenPair PairParen b :< (Seq.viewl -> TokenPair PairBracket p :< ts) -> do
+                       case p of
+                        Tokens (toList -> [TokenLink lnk]) ->
+                               D.eref ! DA.to (attrValue lnk) $ goTokens b
+                        _ -> D.rref ! DA.to (attrValue $ TL.toStrict $ Write.t_Tokens p) $ goTokens b
+                       goTokens (Tokens ts)
+                t :< ts -> go t <> goTokens (Tokens ts)
+                Seq.EmptyL -> mempty
 
 d_Attrs :: Attrs -> DTC -> DTC
 d_Attrs = flip $ foldl' d_Attr