can underline bits of .lang

This commit is contained in:
Rhiannon Morris 2021-04-28 12:31:31 +02:00
parent 292c5d5920
commit e73d442365
2 changed files with 15 additions and 5 deletions

View file

@ -1,4 +1,3 @@
{-# OPTIONS_GHC -fdefer-typed-holes #-}
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.JSON import Text.Pandoc.JSON
import Text.Pandoc.Builder import Text.Pandoc.Builder
@ -9,11 +8,10 @@ import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
main :: IO () main :: IO ()
main = toJSONFilter filter where main = toJSONFilter (filter :: Pandoc -> Pandoc) where
filter :: Pandoc -> Pandoc
filter = filter =
walk spans .
walk (concatMap makeFigures) . walk (concatMap makeFigures) .
walk spans .
walk (concatMap glosses) walk (concatMap glosses)
spans :: Inline -> Inline spans :: Inline -> Inline
@ -29,12 +27,20 @@ spans = \case
ipaB, ipaN, lang, abbr :: Text -> Inline ipaB, ipaN, lang, abbr :: Text -> Inline
ipaB = Span (cls ["ipa", "ipa-broad"]) . text' ipaB = Span (cls ["ipa", "ipa-broad"]) . text'
ipaN = Span (cls ["ipa", "ipa-narrow"]) . text' ipaN = Span (cls ["ipa", "ipa-narrow"]) . text'
lang = Span (cls ["lang"]) . text' lang = Span (cls ["lang"]) . lang'
abbr = Span (cls ["abbr"]) . text' . endash abbr = Span (cls ["abbr"]) . text' . endash
text' :: Text -> [Inline] text' :: Text -> [Inline]
text' = toList . text text' = toList . text
lang' :: Text -> [Inline]
lang' txt = case Text.uncons txt of
Nothing -> []
Just ('{', txt') -> RawInline "html" "<u>" : lang' txt'
Just ('}', txt') -> RawInline "html" "</u>" : lang' txt'
_ -> Str a : lang' b
where (a, b) = Text.span (\c -> c /= '{' && c /= '}') txt
cls :: [Text] -> Attr cls :: [Text] -> Attr
cls cs = ("", cs, []) cls cs = ("", cs, [])

View file

@ -180,6 +180,10 @@ dd {
break-before: avoid; break-before: avoid;
} }
u u {
text-decoration: double underline;
}
.twocol { .twocol {
columns: 2; columns: 2;
} }