{-# LANGUAGE OverloadedLists #-}

module Book.Writing where

-- import Data.Char qualified as Char
-- import Data.Set qualified as Set
-- import Control.Monad.Trans.State qualified as MT
-- import Control.Monad.Trans.Class qualified as MT
import Dataa.ByteString.Builder (Builder)
import Data.List qualified as List
import Data.Map.Strict qualified as Map
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 HTML
import Text.Blaze.Html5.Attributes qualified as HA
import Text.Blaze.Renderer.Utf8 qualified as Blaze
import Prelude (error)

import Language
import Language.Chinese (ChineseDict (..), ChineseDictEntries (..))
import Language.Chinese qualified as Chinese
import Language.English qualified as English
import Language.French qualified as French
import Language.Pronunciation as Pron
import Paths_worksheets qualified as Self
import Rosetta.Reading qualified as Reading
import Worksheets.Utils.Char as Char
import Worksheets.Utils.HTML (className, classes, fr, styles)
import Worksheets.Utils.HTML qualified as HTML
import Worksheets.Utils.Paper
import Worksheets.Utils.Prelude

type Difficulties = Map UnicodeBlock Difficulty
data Difficulty = Difficulty
  { difficultyReading :: Reading.Difficulty
  , difficultyModel :: Bool
  , difficultyHiddenPatterns :: Bool
  }
  deriving (Eq, Show, Generic)
instance HasTypeDefault Difficulty where
  typeDefault =
    Difficulty
      { difficultyReading = typeDefault
      , difficultyModel = True
      , difficultyHiddenPatterns = False
      }

data Part = Part
  { partPicture :: File.FilePath
  , partPictureCSS :: HTML.CSSBlock
  , partDescription :: ShortText
  , partText :: [Either Lexeme Text]
  , partLangue :: Langue
  }
  deriving (Eq, Show, Generic)
  deriving (HasTypeDefault) via (Generically Part)

data Page = Page
  { pageParts :: [Part]
  , pageColumnPictureWidth :: HTML.Length
  , pageColumnTextWidth :: HTML.Length
  , pageSize :: PageSize
  , pageOrientation :: PageOrientation
  , pageDifficulties :: Difficulties
  }
  deriving (Eq, Show, Generic)

instance HasTypeDefault Page where
  typeDefault =
    Page
      { pageParts = []
      , pageColumnPictureWidth = 1 & fr
      , pageColumnTextWidth = 1 & fr
      , pageSize = typeDefault
      , pageOrientation = typeDefault
      , pageDifficulties = Char.unicodeBlocks & Map.fromSet (const typeDefault)
      }

pagePortrait m =
  m
    { pageOrientation = PageOrientationPortrait
    , pageColumnPictureWidth = 3 & fr
    , pageColumnTextWidth = 4 & fr
    }
pageLandscape m =
  m
    { pageOrientation = PageOrientationLandscape
    , pageColumnPictureWidth = 1 & fr
    , pageColumnTextWidth = 2 & fr
    }

pageHTML :: ChineseDict -> Text -> Page -> IO Builder
pageHTML chineseDict title Page{..} = do
  -- FIXME: this absolute path is not portable out of my system
  dataPath <- Self.getDataDir <&> File.normalise
  return $ Blaze.renderMarkupBuilder do
    HTML.docTypeHtml do
      HTML.head do
        HTML.title $ title & HTML.toHtml
        forM_
          ( [ "styles/Paper.css"
            , "styles/Rosetta/Common.css"
            , "styles/Rosetta/Writing.css"
            ]
              & list
          )
          \cssFile ->
            HTML.link
              ! HA.rel "stylesheet"
              ! HA.type_ "text/css"
              ! HA.href (dataPath </> cssFile & toValue)
        HTML.styleCSS $ HTML.cssPrintPage pageOrientation pageSize
        HTML.styleCSS $ pageDifficulties <&> difficultyReading & Reading.difficultyCSS
      HTML.body
        ! classes
          [ "A4"
          , case pageOrientation of
              PageOrientationPortrait -> "portrait"
              PageOrientationLandscape -> "landscape"
          ]
        $ do
          "\n"
          let numOfParts = pageParts & List.length
          HTML.section
            ! classes
              [ "rosetta-writing"
              , "sheet"
              ]
            ! styles
              [ "grid-template-columns" := [pageColumnPictureWidth, pageColumnTextWidth] <&> HTML.toCSS & List.unwords
              , "grid-template-rows" := "1fr" & List.replicate numOfParts & List.unwords
              ]
            $ do
              forM_ pageParts \Part{..} -> do
                "\n"
                HTML.div
                  ! classes
                    [ "rosetta-writing-part"
                    , "rosetta-writing-part-picture"
                    , if partDescription & ShortText.null then "" else "with-description"
                    ]
                  $ do
                    HTML.img
                      ! styles partPictureCSS
                      ! HA.src ("file://" <> dataPath </> "images" </> partPicture & toValue)
                    unless (partDescription & ShortText.null) do
                      HTML.span ! classes ["description"] $ do
                        partDescription & HTML.toHtml
                HTML.div ! classes ["rosetta-writing-part", "sentence"] $ do
                  -- traceShowM ("partText"::Text, partText)
                  -- forM_ (partText & rosettaTokenizer & groupByHoriz) \writingHoriz -> do
                  --   "\n"
                  --   traceShowM ("writingHoriz"::Text, writingHoriz)
                  -- HTML.div ! classes ["sentence-horiz"] $ do
                  -- forM_ (writingHoriz & splitWords) \writingWord -> do
                  -- let writingWord :: Text = "choux hibou genoux caillou glace"
                  -- traceShowM ("writingWord"::String, writingWord)
                  let textToSoundsGroup =
                        partText
                          & case partLangue of
                            LangueMandarin -> Chinese.pronunciation chineseDict
                            LangueFrançais -> French.pronunciation
                            LangueAnglais -> English.pronunciation
                            _ -> error $ "partLangue unsupported: " <> show partLangue
                  let addIndexes (idx :: Int) = \case
                        [] -> []
                        lexs : t -> List.reverse lexs' : addIndexes idx' t
                          where
                            (idx', lexs') =
                              List.foldl'
                                ( \(i, is) kv@(_key, lex) ->
                                    case lex & lexemePronunciation of
                                      PronunciationSilent -> (i, (i, kv) : is)
                                      PronunciationIPABroad{} -> (i + 1, (i + 1, kv) : is)
                                )
                                (idx, [])
                                lexs
                  let isBreak c =
                        c
                          == Pron.borderLeftChar
                          || c
                          == Pron.borderRightChar
                  forM_ (textToSoundsGroup & addIndexes 0) \textToSounds -> do
                    HTML.div ! classes ["sentence-horiz"] $ do
                      let addWordIndexes (idx :: Int) = \case
                            [] -> []
                            (textIndex, (textChunk, textLexeme)) : t ->
                              (idx, (textIndex, (textChunk, textLexeme))) : addWordIndexes idx' t
                              where
                                idx'
                                  | textChunk == Text.singleton Pron.borderLeftChar = idx
                                  | textChunk == Text.singleton Pron.borderRightChar = idx
                                  | otherwise = idx + 1
                      forM_ (textToSounds & addWordIndexes 0) \(wordIndex, (textIndex, (textChunk, LexemePron{..}))) -> do
                        let addCharIndexes (idx :: Int) = \case
                              [] -> []
                              c : cs -> (idx', c) : addCharIndexes idx' cs
                                where
                                  idx' =
                                    case c & charMetaUnicodeCategory of
                                      Char.Space -> idx
                                      _
                                        | isBreak (charMetaChar c) -> idx
                                        | otherwise -> idx + 1
                        let charsMeta = textChunk & metanizer & addCharIndexes 0
                        HTML.div
                          ! classes
                            [ "sentence-word"
                            , "word-index-" <> show wordIndex
                            , "lang-" <> className partLangue
                            ]
                          ! styles
                            [ "grid-template-columns" :=
                                "repeat("
                                  <> (charsMeta & List.length & show)
                                  <> ",auto)"
                            ]
                          $ do
                            HTML.div
                              ! classes
                                [ "sentence-cell"
                                , "pronunciation"
                                , -- , "cell-index-"<>show textIndex
                                  "cell-" <> case lexemePronunciation of
                                    PronunciationSilent -> "silent"
                                    PronunciationIPABroad{} -> if even textIndex then "even" else "odd"
                                ]
                              ! styles
                                [ "grid-column-end" := "span " <> show (textChunk & Text.length)
                                -- , "display" := if partLangue == LangueAnglais then "none" else ""
                                ]
                              $ do
                                HTML.toHtml $ case lexemePronunciation of
                                  PronunciationSilent -> ""
                                  PronunciationIPABroad txt _examples -> txt
                            forM_ charsMeta \(_charIndex, charMeta) -> do
                              let uniScript = charMeta & charMetaUnicodeBlock & fromMaybe (UnicodeBlockLatin UnicodeBlockLatin_Basic)
                              HTML.span
                                ! classes
                                  [ "sentence-cell"
                                  , "model"
                                  , "script-" <> className uniScript
                                  , if pageDifficulties
                                      & lookupOrTypeDefault uniScript
                                      & difficultyModel
                                      then mempty
                                      else "hidden"
                                  , if isBreak $ charMetaChar charMeta
                                      then "break"
                                      else "non-break"
                                  ]
                                $ do
                                  HTML.span ! classes ["cell"] $ do
                                    charMeta & charMetaChar & HTML.toHtml
                            forM_ charsMeta \(charIndex, charMeta) -> do
                              let uniScript = charMeta & charMetaUnicodeBlock & fromMaybe (UnicodeBlockLatin UnicodeBlockLatin_Basic)
                              HTML.span
                                ! classes
                                  [ "sentence-cell"
                                  , "input"
                                  , "input-index-" <> show charIndex
                                  , "script-" <> className uniScript
                                  , if pageDifficulties
                                      & lookupOrTypeDefault uniScript
                                      & difficultyHiddenPatterns
                                      then "hidden"
                                      else ""
                                  , if isBreak $ charMetaChar charMeta
                                      then "break"
                                      else "non-break"
                                  ]
                                $ do
                                  HTML.span ! classes ["cell"] $ do
                                    charMeta & charMetaChar & HTML.toHtml