module Glosses (glosses) where

import Lang
import LaantasImage
import Spans

import Text.Pandoc.Definition
import Text.Pandoc.Builder
import Text.Pandoc.Walk
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as Text


glosses :: Vars => Block -> IO [Block]
glosses = \case
  Div (i, cs, _) blocks | "glosses" `elem` cs -> do
    tables <- traverse glossTable blocks
    pure $
      [RawBlock (Format "html") $ "<figure" <> id <> classes <> ">"] ++
      catMaybes tables ++
      [RawBlock (Format "html") "</figure>"]
    where
      id = if i == "" then "" else " id=\"" <> i <> "\""
      classes = " class=\"" <> Text.unwords cs <> "\""
  b -> pure [b]

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]]

glossTable :: Vars => Block -> IO (Maybe Block)
glossTable = \case
  Gloss  l   s g t -> Just <$> make l Nothing  s g t
  PGloss l p s g t -> Just <$> make l (Just p) s g t
  HorizontalRule   -> pure Nothing
  b                -> error $ "found " ++ show b ++ " in gloss section"
 where
  make l p s g t = do
    let n = length $ splitInlines s
    let colspecs = replicate n (AlignDefault, ColWidthDefault)
    let l' = cell1 n l; p' = cell1 n <$> p
    let ss = cells s; gs = cells g; t' = cell1 n t
    img <- case ?lang of
      Just Lántas ->
        [Just $ cell1 n [img] | img <- makeImage $ splitImage' $ stripInlines l]
      Nothing     -> pure Nothing
    pure $ Table ("", ["gloss"], []) (Caption Nothing []) colspecs
      (TableHead mempty [])
      [TableBody mempty (RowHeadColumns 0) [] $ concat
        [[row ["gloss-scr", "scr"] [i] | Just i <- [img]],
         [row ["gloss-lang", "lang"] [l']],
         [row ["gloss-pron", "ipa"] [p] | Just p <- [p']],
         [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]
  cell1 n is = Cell mempty AlignDefault (RowSpan 1) (ColSpan n) [Plain is]
  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')