lang/langfilter/lib/Spans.hs

93 lines
2.9 KiB
Haskell
Raw Normal View History

2021-05-20 22:15:24 +02:00
module Spans (spans, ipaB, ipaN, abbr, abbrs, underlines) where
import LaantasImage hiding (text)
import Lang
import Text.Pandoc.Definition hiding (Image)
import Text.Pandoc.Builder hiding (Image)
import Data.Char (isUpper, isDigit)
import Data.Text (Text)
import qualified Data.Text as Text
2024-11-28 01:32:27 +01:00
spans :: Vars => Inline -> Inline
spans = \case
Code attrs txt
2024-11-28 01:32:27 +01:00
| Just ('\\', txt') <- Text.uncons txt -> Code attrs txt'
| Just txt' <- enclosed "" "" txt -> ipaA txt'
| Just txt' <- enclosed "//" "//" txt -> ipaA txt'
| Just _ <- enclosed "/" "/" txt -> ipaB txt
| Just _ <- enclosed "[" "]" txt -> ipaN txt
2021-06-04 05:38:15 +02:00
| Just txt' <- enclosed "{" "}" txt -> lang txt'
2024-11-28 01:32:27 +01:00
| Just txt' <- enclosed "!" "!" txt -> abbr txt'
| Just txt' <- enclosed "*" "*" txt -> mark txt'
| Just txt' <- enclosed "@" "@" txt -> dfn txt'
i -> i
2023-10-30 09:43:05 +01:00
ipaA, ipaB, ipaN, abbr, mark :: Text -> Inline
2021-06-04 05:35:17 +02:00
ipaA = Span (cls ["ipa", "ipa-arch"]) . text' . surround ""
ipaB = Span (cls ["ipa", "ipa-broad"]) . text'
ipaN = Span (cls ["ipa", "ipa-narrow"]) . text'
abbr = Span (cls ["abbr"]) . text' . endash
2023-10-30 09:43:05 +01:00
mark txt = RawInline "html" $ "<mark>" <> txt <> "</mark>"
2024-09-26 01:39:24 +02:00
dfn txt = RawInline "html" $ "<dfn>" <> txt <> "</dfn>"
2021-06-04 05:38:15 +02:00
surround :: Text -> Text -> Text
surround s txt = s <> txt <> s
text' :: Text -> [Inline]
text' = toList . text
2024-11-28 01:32:27 +01:00
lang :: Vars => Text -> Inline
lang = Span (cls ["lang"]) . lang'
2024-11-28 01:32:27 +01:00
lang' :: Vars => Text -> [Inline]
lang' txt = case ?lang of
Just Lántas
2024-11-28 01:32:27 +01:00
| Just li@(Item {..}) <- splitItem txt,
let label = Span (cls ["text"]) $ underlines title ->
2024-11-28 17:44:41 +01:00
if showText then [makeItem li, Str " ", label] else [makeItem li]
2024-11-28 01:32:27 +01:00
_ -> underlines txt
notBrace :: Char -> Bool
notBrace c = c /= '{' && c /= '}'
underlines :: Text -> [Inline]
underlines txt = case Text.uncons txt of
Nothing -> []
Just ('{', txt') -> RawInline "html" "<u>" : underlines txt'
Just ('}', txt') -> RawInline "html" "</u>" : underlines txt'
_ -> Str a : underlines b
where (a, b) = Text.span notBrace txt
cls :: [Text] -> Attr
cls cs = ("", cs, [])
2021-06-04 05:38:15 +02:00
enclosed :: Text -> Text -> Text -> Maybe Text
enclosed o c txt
2021-06-04 05:38:15 +02:00
| Text.length txt >= o + c,
Text.take o txt == o,
Text.takeEnd c txt == c
= Just $ Text.drop o $ Text.dropEnd c txt
where o = Text.length o; c = Text.length c
enclosed _ _ _ = Nothing
endash :: Text -> Text
endash = Text.map \case '-' -> ''; '_' -> ' '; c -> c
abbrs :: Inline -> [Inline]
abbrs (Str txt) = go $ endash txt where
go "" = []
go txt
| (l, r) <- Text.span isAbbr txt,
not $ Text.null l
= abbr' l : go r
| (l, r) <- Text.break isAbbr txt
= Str l : go r
abbr' txt = if Text.any (not . isDigit) txt then abbr txt else Str txt
isAbbr c = isUpper c || isDigit c || c `elem` (",.;\\[]" :: String)
abbrs i = [i]