module Spans (spans, ipaB, ipaN, abbr, abbrs) 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 _            <- enclosed '/' '/' txt -> pure $ ipaB txt
    | Just _            <- enclosed '[' ']' txt -> pure $ ipaN txt
    | Just txt'         <- enclosed '{' '}' txt -> lang txt'
    | Just txt'         <- enclosed '!' '!' txt -> pure $ abbr txt'
  i -> pure i

ipaB, ipaN, abbr :: Text -> Inline
ipaB = Span (cls ["ipa", "ipa-broad"])  . text'
ipaN = Span (cls ["ipa", "ipa-narrow"]) . text'
abbr = Span (cls ["abbr"])              . text' . endash

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" "<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 :: Char -> Char -> Text -> Maybe Text
enclosed o c txt
  | Text.length txt >= 2,
    Text.head txt == o,
    Text.last txt == c
  = Just $ Text.init $ Text.tail txt
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]