2021-04-29 11:52:44 +02:00
|
|
|
|
module Glosses (glosses) where
|
|
|
|
|
|
|
|
|
|
import Lang
|
|
|
|
|
import LaantasImage
|
2021-05-20 22:15:24 +02:00
|
|
|
|
import Spans (abbrs)
|
|
|
|
|
import qualified Spans
|
2021-04-29 11:52:44 +02:00
|
|
|
|
|
|
|
|
|
import Text.Pandoc.Definition
|
|
|
|
|
import Text.Pandoc.Builder
|
|
|
|
|
import Text.Pandoc.Walk
|
|
|
|
|
import Data.Maybe
|
|
|
|
|
import Data.Text (Text)
|
2021-04-29 19:02:20 +02:00
|
|
|
|
import qualified Data.Text as Text
|
2024-11-28 00:18:50 +01:00
|
|
|
|
import Data.Data (toConstr)
|
2021-04-29 11:52:44 +02:00
|
|
|
|
|
|
|
|
|
|
2024-11-28 01:32:27 +01:00
|
|
|
|
glosses :: Vars => Block -> [Block]
|
2021-04-29 11:52:44 +02:00
|
|
|
|
glosses = \case
|
2024-11-28 01:32:27 +01:00
|
|
|
|
Div (i, cs, _) blocks | "glosses" `elem` cs ->
|
|
|
|
|
let tables = map glossTable blocks in
|
|
|
|
|
[RawBlock (Format "html") $ "<figure" <> id <> classes <> ">"] ++
|
|
|
|
|
catMaybes tables ++
|
|
|
|
|
[RawBlock (Format "html") "</figure>"]
|
2021-04-29 19:02:20 +02:00
|
|
|
|
where
|
|
|
|
|
id = if i == "" then "" else " id=\"" <> i <> "\""
|
|
|
|
|
classes = " class=\"" <> Text.unwords cs <> "\""
|
2024-11-28 01:32:27 +01:00
|
|
|
|
b -> [b]
|
2021-04-29 11:52:44 +02:00
|
|
|
|
|
|
|
|
|
pattern Gloss l g w t = BulletList [[Plain l], [Plain g], [Plain w], [Plain t]]
|
|
|
|
|
pattern PGloss l p g w t =
|
|
|
|
|
BulletList [[Plain l], [Plain p], [Plain g], [Plain w], [Plain t]]
|
2021-06-04 05:33:22 +02:00
|
|
|
|
pattern PNGloss l b n g w t =
|
|
|
|
|
BulletList [[Plain l], [Plain b], [Plain n], [Plain g], [Plain w], [Plain t]]
|
2021-04-29 11:52:44 +02:00
|
|
|
|
|
2024-11-28 01:32:27 +01:00
|
|
|
|
glossTable :: Vars => Block -> Maybe Block
|
2021-04-29 11:52:44 +02:00
|
|
|
|
glossTable = \case
|
2024-11-28 01:32:27 +01:00
|
|
|
|
Gloss l s g t -> Just $ make l Nothing Nothing s g t
|
|
|
|
|
PGloss l p s g t -> Just $ make l (Just p) Nothing s g t
|
|
|
|
|
PNGloss l b n s g t -> Just $ make l (Just b) (Just n) s g t
|
|
|
|
|
HorizontalRule -> Nothing
|
2024-11-28 00:18:50 +01:00
|
|
|
|
BulletList xs | let ℓ = length xs, ℓ < 4 || ℓ > 6 ->
|
|
|
|
|
fail $ "found list of length " ++ show ℓ ++
|
|
|
|
|
" in gloss section (missing `---`?)"
|
|
|
|
|
b -> fail $ "found unexpected " ++ show (toConstr b) ++ " in gloss section"
|
2021-04-29 11:52:44 +02:00
|
|
|
|
where
|
2024-11-28 01:32:27 +01:00
|
|
|
|
make l b n s g t =
|
2021-06-04 05:33:22 +02:00
|
|
|
|
let ℓ = length $ splitInlines s
|
2024-11-28 01:32:27 +01:00
|
|
|
|
colspecs = replicate ℓ (AlignDefault, ColWidthDefault)
|
|
|
|
|
l' = cell1 ℓ $ underlines $ noHash l
|
2024-11-26 06:08:10 +01:00
|
|
|
|
b' = cell1 ℓ <$> b; n' = cell1 ℓ <$> n
|
2024-11-28 01:32:27 +01:00
|
|
|
|
ss = cells s; gs = cells g; t' = cell1 ℓ t
|
|
|
|
|
img = case ?lang of
|
|
|
|
|
Just Lántas -> Just $ cell1 ℓ [makeItem $ splitItem' $ stripInlines l]
|
|
|
|
|
Nothing -> Nothing
|
|
|
|
|
in
|
|
|
|
|
Table ("", ["gloss"], []) (Caption Nothing []) colspecs
|
2021-04-29 11:52:44 +02:00
|
|
|
|
(TableHead mempty [])
|
|
|
|
|
[TableBody mempty (RowHeadColumns 0) [] $ concat
|
|
|
|
|
[[row ["gloss-scr", "scr"] [i] | Just i <- [img]],
|
|
|
|
|
[row ["gloss-lang", "lang"] [l']],
|
2021-06-04 05:33:22 +02:00
|
|
|
|
[row ["gloss-pron", "ipa"] [b] | Just b <- [b']],
|
|
|
|
|
[row ["gloss-pron", "ipa"] [n] | Just n <- [n']],
|
2021-04-29 11:52:44 +02:00
|
|
|
|
[row ["gloss-split", "lang"] ss],
|
|
|
|
|
[row ["gloss-gloss"] gs],
|
|
|
|
|
[row ["gloss-trans"] [t']]]]
|
|
|
|
|
(TableFoot mempty [])
|
|
|
|
|
cell is = Cell mempty AlignDefault (RowSpan 1) (ColSpan 1) [Plain is]
|
2021-06-04 05:33:22 +02:00
|
|
|
|
cell1 ℓ is = Cell mempty AlignDefault (RowSpan 1) (ColSpan ℓ) [Plain is]
|
2021-04-29 11:52:44 +02:00
|
|
|
|
cells = map (cell . concatMap abbrs) . splitInlines
|
|
|
|
|
row c = Row ("", c, [])
|
|
|
|
|
|
|
|
|
|
stripInlines :: [Inline] -> Text
|
|
|
|
|
stripInlines = query \case
|
|
|
|
|
Str s -> s
|
|
|
|
|
Space -> " "
|
|
|
|
|
SoftBreak -> " "
|
|
|
|
|
LineBreak -> " "
|
|
|
|
|
_ -> ""
|
|
|
|
|
|
|
|
|
|
splitInlines :: [Inline] -> [Inlines]
|
|
|
|
|
splitInlines is = filter (not . null) $ go is where
|
|
|
|
|
go [] = []
|
|
|
|
|
go is =
|
|
|
|
|
let (is1, is') = break (== Space) is in
|
|
|
|
|
fromList is1 : splitInlines (dropWhile (== Space) is')
|
2021-05-20 22:15:24 +02:00
|
|
|
|
|
|
|
|
|
underlines :: [Inline] -> [Inline]
|
2024-06-03 04:07:09 +02:00
|
|
|
|
underlines = concatMap underlineStr . takeWhile (/= Str "|") where
|
|
|
|
|
underlineStr = \case
|
|
|
|
|
Str txt -> Spans.underlines txt
|
|
|
|
|
i -> [i]
|
2024-11-26 06:08:10 +01:00
|
|
|
|
|
|
|
|
|
noHash :: [Inline] -> [Inline]
|
|
|
|
|
noHash = walk \case
|
|
|
|
|
Str str -> Str $ Text.filter (/= '#') str
|
|
|
|
|
i -> i
|