2021-05-20 22:15:24 +02:00
|
|
|
|
module Spans (spans, ipaB, ipaN, abbr, abbrs, underlines) where
|
2021-04-29 11:52:44 +02:00
|
|
|
|
|
|
|
|
|
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
|
2021-04-29 11:52:44 +02:00
|
|
|
|
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
|
2021-04-29 11:52:44 +02:00
|
|
|
|
|
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 "⫽"
|
2021-04-29 11:52:44 +02:00
|
|
|
|
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-04-29 11:52:44 +02:00
|
|
|
|
|
2021-06-04 05:38:15 +02:00
|
|
|
|
surround :: Text -> Text -> Text
|
|
|
|
|
surround s txt = s <> txt <> s
|
|
|
|
|
|
2021-04-29 11:52:44 +02:00
|
|
|
|
text' :: Text -> [Inline]
|
|
|
|
|
text' = toList . text
|
|
|
|
|
|
2024-11-28 01:32:27 +01:00
|
|
|
|
lang :: Vars => Text -> Inline
|
|
|
|
|
lang = Span (cls ["lang"]) . lang'
|
2021-04-29 11:52:44 +02:00
|
|
|
|
|
2024-11-28 01:32:27 +01:00
|
|
|
|
lang' :: Vars => Text -> [Inline]
|
2021-04-29 11:52:44 +02:00
|
|
|
|
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₀
|
2021-04-29 11:52:44 +02:00
|
|
|
|
|
|
|
|
|
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
|
2021-04-29 11:52:44 +02:00
|
|
|
|
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
|
2021-04-29 11:52:44 +02:00
|
|
|
|
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
|
2024-11-28 00:19:10 +01:00
|
|
|
|
abbr' txt = if Text.any (not . isDigit) txt then abbr txt else Str txt
|
2021-04-29 11:52:44 +02:00
|
|
|
|
isAbbr c = isUpper c || isDigit c || c `elem` (",.;\\[]" :: String)
|
|
|
|
|
abbrs i = [i]
|