module Worksheets.Writing.Rosetta where

import Data.ByteString.Builder (Builder)
import Data.Char qualified as Char
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Short qualified as ShortText
import System.FilePath.Posix ((</>))
import System.FilePath.Posix qualified as File
import Text.Blaze
import Text.Blaze.Html5 qualified as H
import Text.Blaze.Html5.Attributes qualified as HA
import Text.Blaze.Renderer.Utf8 qualified as Blaze
import Prelude (error)

import Language.Chinese (ChineseDict (..), ChineseDictEntries (..))
import Language.Chinese qualified
import Paths_worksheets qualified as Self
import Utils.Blaze
import Worksheets.Prelude

data Langue
  = LangueFrançais
  | LangueAnglais
  | LangueMandarin
  | LangueMandarinPinyin
  | LanguePhonetic
  deriving (Eq, Ord, Show)

data RosettaPart = RosettaPart
  { rosettaPartPicture :: File.FilePath
  , rosettaPartDescription :: ShortText
  , rosettaPartText :: ShortText
  , rosettaPartLangue :: Langue
  }
  deriving (Eq, Ord, Show, Generic)

data Rosetta = Rosetta
  { rosettaParts :: [RosettaPart]
  , rosettaClasses :: [String]
  }
  deriving (Eq, Ord, Show, Generic)
  deriving (Semigroup, Monoid) via (Generically Rosetta)

lookupPinyins :: ChineseDict -> ShortText -> [ShortText]
lookupPinyins (ChineseDict dict) word =
  word
    & (`Map.lookup` dict)
    & fromMaybe (error $ "lookupPinyins: no entry for: " <> wordString)
    & chinesePinyins
    & (\ps -> if null ps then error $ "lookupPinyins: empty entry for: " <> wordString else ps)
    & Set.elemAt 0 -- FIXME: how to choose?
  where
    wordString = word & ShortText.unpack

rosetta :: ChineseDict -> Text -> Rosetta -> IO Builder
rosetta chineseDict title Rosetta{..} = do
  -- FIXME: this absolute path is not portable out of my system
  dataPath <- Self.getDataDir <&> File.normalise
  return $ Blaze.renderMarkupBuilder do
    H.docTypeHtml do
      H.head do
        H.title $ title & H.toHtml
        H.link
          ! HA.rel "stylesheet"
          ! HA.type_ "text/css"
          ! HA.href (toValue $ dataPath </> "styles/rosetta.css")
      H.body ! classes rosettaClasses $ do
        "\n"
        H.div ! classes ["rosetta"] $ do
          forM_ rosettaParts \RosettaPart{..} -> do
            -- pTraceShowM (rosettaPicture, RosettaEntry{..})
            "\n"
            H.div ! classes ["rosetta-row", "rosetta-row-" <> show rosettaPartLangue] $ do
              H.div ! classes ["rosetta-cell", "rosetta-cell-picture"] $ do
                unless (ShortText.null rosettaPartDescription) do
                  H.span ! classes ["rosetta-cell-picture-description"] $ do
                    rosettaPartDescription & H.toHtml
                H.img ! HA.src ("file://" <> dataPath </> "images" </> rosettaPartPicture & toValue)
              H.div ! classes ["rosetta-cell", "rosetta-cell-words"] $ do
                let cellSpace = \case
                      ' ' -> "writing-words-cell-space"
                      _ -> ""
                H.div ! classes ["writing-words"] $ do
                  forM_ (rosettaPartText & ShortText.split (== ' ')) \writingWord -> do
                    let wordLength = writingWord & ShortText.length
                    let needsDict w = w & ShortText.unpack & any \c -> not (Char.isPunctuation c)
                    let charWidth = case rosettaPartLangue of
                          LangueMandarin -> "1.5cm"
                          _
                            | wordLength > (if List.elem "landscape" rosettaClasses then 14 else 17) -> "0.75cm"
                            | otherwise -> "1cm"
                    H.div
                      ! classes
                        [ "writing-words-word"
                        ]
                      $ do
                        when (rosettaPartLangue == LangueMandarin) do
                          H.div
                            ! classes
                              [ "writing-words-row"
                              , "writing-words-" <> show LangueMandarinPinyin
                              ]
                            ! HA.style ("grid-template-columns: repeat(" <> show wordLength <> ", " <> charWidth <> ");" & toValue)
                            $ do
                              let
                                pinyins :: [ShortText]
                                pinyins
                                  | writingWord & ShortText.unpack & all Char.isNumber =
                                      [ writingChar & ShortText.singleton & lookupPinyins chineseDict
                                      | writingChar <- writingWord & ShortText.unpack
                                      ]
                                        & mconcat
                                  | needsDict writingWord = writingWord & lookupPinyins chineseDict
                                  | otherwise = List.repeat " "
                              forM_
                                (List.zip (writingWord & ShortText.unpack) pinyins)
                                \(writingChar, writingPinyin) -> do
                                  H.div ! classes ["writing-words-cell", cellSpace writingChar] $ do
                                    writingPinyin
                                      & Language.Chinese.numberedPinyinToDiacriticPiniyn
                                      & ShortText.toText
                                      & Text.toLower
                                      & H.toHtml
                        H.div
                          ! classes
                            [ "writing-words-row"
                            , "writing-words-" <> show rosettaPartLangue
                            , "writing-words-row-model"
                            ]
                          ! HA.style ("grid-template-columns: repeat(" <> show wordLength <> ", " <> charWidth <> ");" & toValue)
                          $ do
                            forM_ (writingWord & ShortText.unpack) \writingChar -> do
                              H.div ! classes ["writing-words-cell", cellSpace writingChar] $ do
                                fromString [writingChar]
                        "\n"
                        H.div
                          ! classes
                            [ "writing-words-row"
                            , "writing-words-" <> show rosettaPartLangue
                            , "writing-words-row-input"
                            ]
                          ! HA.style ("grid-template-columns: repeat(" <> show wordLength <> ", " <> charWidth <> ");" & toValue)
                          $ do
                            forM_ (writingWord & ShortText.unpack) \writingChar -> do
                              H.div ! classes ["writing-words-cell", cellSpace writingChar] $ do
                                case rosettaPartLangue of
                                  LangueMandarin -> fromString [writingChar]
                                  _ -> " "
                        "\n"
                  "\n"