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 -> IO Inline spans = \case Code attrs txt | Just ('\\', txt') <- Text.uncons txt -> pure $ Code attrs txt' | Just txt' <- enclosed "⫽" "⫽" txt -> pure $ ipaA txt' | Just txt' <- enclosed "//" "//" txt -> pure $ ipaA txt' | Just _ <- enclosed "/" "/" txt -> pure $ ipaB txt | Just _ <- enclosed "[" "]" txt -> pure $ ipaN txt | Just txt' <- enclosed "{" "}" txt -> lang txt' | Just txt' <- enclosed "!" "!" txt -> pure $ abbr txt' | Just txt' <- enclosed "*" "*" txt -> pure $ mark txt' | Just txt' <- enclosed "@" "@" txt -> pure $ dfn txt' i -> pure 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" $ "" <> txt <> "" dfn txt = RawInline "html" $ "" <> txt <> "" surround :: Text -> Text -> Text surround s txt = s <> txt <> s text' :: Text -> [Inline] text' = toList . text lang :: Vars => Text -> IO Inline lang = fmap (Span (cls ["lang"])) . lang' lang' :: Vars => Text -> IO [Inline] lang' txt₀ = case ?lang of Just Lántas | Just li@(Image {..}) <- splitImage txt₀ -> if showText then do img <- makeImage li pure $ [img, Span (cls ["text"]) $ underlines title] else pure <$> makeImage li _ -> pure $ underlines txt₀ notBrace :: Char -> Bool notBrace c = c /= '{' && c /= '}' underlines :: Text -> [Inline] underlines txt = case Text.uncons txt of Nothing -> [] Just ('{', txt') -> RawInline "html" "" : underlines txt' Just ('}', txt') -> RawInline "html" "" : 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.length txt == 1 then Str txt else abbr txt isAbbr c = isUpper c || isDigit c || c `elem` (",.;\\[]" :: String) abbrs i = [i]