librarify langfilter too

langfilter/lib/Spans.hs

@@ -0,0 +1,92 @@
+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
+
+
+spans :: Vars => Inline -> Inline
+spans = \case
+  Code attrs txt
+    | 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
+    | Just txt'         <- enclosed "{"  "}"  txt -> lang txt'
+    | Just txt'         <- enclosed "!"  "!"  txt -> abbr txt'
+    | Just txt'         <- enclosed "*"  "*"  txt -> mark txt'
+    | Just txt'         <- enclosed "@"  "@"  txt -> dfn txt'
+  i -> i
+
+ipaA, ipaB, ipaN, abbr, mark :: Text -> Inline
+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
+mark txt = RawInline "html" $ "<mark>" <> txt <> "</mark>"
+dfn txt = RawInline "html" $ "<dfn>" <> txt <> "</dfn>"
+
+surround :: Text -> Text -> Text
+surround s txt = s <> txt <> s
+
+text' :: Text -> [Inline]
+text' = toList . text
+
+lang :: Vars => Text -> Inline
+lang = Span (cls ["lang"]) . lang'
+
+lang' :: Vars => Text -> [Inline]
+lang' txt₀ = case ?lang of
+  Just Lántas
+    | Just li@(Item {..}) <- splitItem txt₀,
+      let label = Span (cls ["text"]) $ underlines title ->
+        if showText then [makeItem li, label] else [makeItem li]
+  _ -> 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, [])
+
+
+enclosed :: Text -> Text -> Text -> Maybe Text
+enclosed o c txt
+  | 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]