lang/langfilter/lib/LangFilter.hs

81 lines
2.4 KiB
Haskell
Raw Normal View History

2024-11-28 02:04:06 +01:00
module LangFilter where
2023-05-04 02:31:21 +02:00
import Lang
import Ebnf
import Spans
import Glosses
import Text.Pandoc.Definition
import Text.Pandoc.Walk
import Data.Maybe
import qualified Data.Map as Map
import Data.Text (Text)
2023-05-04 02:31:21 +02:00
import qualified Data.Text as Text
import Control.Applicative
import Control.Monad
2024-12-03 18:52:36 +01:00
langFilter :: Text -> Pandoc -> IO Pandoc
langFilter col p@(Pandoc (Meta m) _) = do
2024-11-28 02:04:06 +01:00
lang <- toLang $ Map.lookup "conlang" m
let ?lang = lang
2024-12-03 18:52:36 +01:00
let ?defColor = col
2024-11-28 02:04:06 +01:00
let f = map (walk spans . fixFigureClass . makeEbnf .
makeQuotes . letterList) .
concatMap (makeBlocks <=< glosses)
pure $ walk f p
2023-05-04 02:31:21 +02:00
pluck :: Eq a => a -> [a] -> Maybe [a]
pluck _ [] = Nothing
pluck x (y:ys) | x == y = Just ys
| otherwise = (x :) <$> pluck x ys
pluck1 :: Eq a => [a] -> [a] -> Maybe (a, [a])
pluck1 [] _ = Nothing
pluck1 (x:xs) ys = (x,) <$> pluck x ys <|> pluck1 xs ys
fixFigureClass :: Block -> Block
2024-12-03 23:56:44 +01:00
fixFigureClass (Figure (i1, c1, a1) cap [Plain [Image (i2, c2, a2) alt path]]) =
Figure (iF, c1 ++ c2, a1 ++ a2) cap [Plain [Image (iI, [], []) alt path]]
where iF = if Text.null i1 then i2 else i1
iI = if Text.null i1 then "" else i2
fixFigureClass b = b
2022-03-16 18:30:46 +01:00
makeBlocks :: Block -> [Block]
2023-05-04 02:31:21 +02:00
makeBlocks (Div ("", clss, []) blks)
| Just (cls, rest) <- pluck1 ["figure", "aside"] clss =
let html = RawBlock $ Format "html"
open = if null rest then
html $ "<" <> cls <> ">"
else
html $ "<" <> cls <> " class='" <> Text.unwords rest <> "'>"
2023-05-04 02:31:21 +02:00
close = html $ "</" <> cls <> ">"
in
[open] ++ blks ++ [close]
2022-03-16 18:30:46 +01:00
makeBlocks b = [b]
makeQuotes :: Block -> Block
makeQuotes para@(Para b) = fromMaybe para $ do
inner <- split b
return (BlockQuote [Para inner])
where
2024-11-28 01:55:55 +01:00
isDelim str = Text.length str == 3 && Text.all isQuote str
isQuote c = c == '"' || c == '“' || c == '”'
split (Str begin:SoftBreak:rest) = guard (isDelim begin) *> checkEnd rest
split _ = empty
checkEnd [SoftBreak, Str end] = [] <$ guard (isDelim end)
checkEnd (start:rest) = (start :) <$> checkEnd rest
checkEnd _ = empty
makeQuotes other = other
2024-11-28 01:54:36 +01:00
letterList :: Block -> Block
letterList (Div a@(_, cs, _) blks)
| "letter-list" `elem` cs = Div a (walk go blks)
where
go (Para xs) = Plain xs
go b = b
2024-11-28 01:54:36 +01:00
letterList b = b