{-# LANGUAGE OverloadedLists #-}

module Rosetta.Writing 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 Control.Monad.Trans.State qualified as MT
-- import Control.Monad.Trans.Class qualified as MT
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.IPA qualified as IPA
import Worksheets.Utils.Paper
import Worksheets.Utils.Prelude

type Difficulties = Map Langue (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 :: [(Pron.Table, Text)]
  , partLangue :: Langue
  }
  deriving (Eq, Show, Generic)
  deriving (HasTypeDefault) via (Generically Part)

data Pages = Pages
  { pagesList :: [Page]
  , pagesDifficulties :: Difficulties
  }
  deriving (Eq, Show, Generic)
instance HasTypeDefault Pages where
  typeDefault =
    Pages
      { pagesList = []
      , pagesDifficulties =
          [ lang :=
            [ block := typeDefault
            | block <- Char.unicodeBlocks & toList
            ]
              & Map.fromList
          | lang <- langues & toList
          ]
            & Map.fromList
      }

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

instance HasTypeDefault Page where
  typeDefault =
    Page
      { pageParts = []
      , pageColumnPictureWidth = 1 & fr
      , pageColumnTextWidth = 1 & fr
      , pageSize = typeDefault
      , pageOrientation = typeDefault
      }

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

pagesHTML :: ChineseDict -> Text -> Pages -> IO Builder
pagesHTML chineseDict title Pages{..} = 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 pagesOrientation pagesSize
  HTML.styleCSS $ pagesDifficulties <&> fmap difficultyReading & Reading.difficultyCSS
HTML.body do
  forM_ pagesList \Page{..} -> do
    "\n"
    let numOfParts = pageParts & List.length
    HTML.section
      ! classes
        [ "rosetta-writing"
        , "A4"
        , "sheet"
        , pageOrientation & HTML.cssPageOrientation
        ]
      ! styles
        [ "grid-template-columns" := [pageColumnPictureWidth, pageColumnTextWidth] <&> HTML.toCSS & List.unwords
        , "grid-template-rows" := "1fr" & List.replicate numOfParts & List.unwords
        , "size" :=
            List.unwords
              [ pageSize & HTML.cssPageSize
              , pageOrientation & HTML.cssPageOrientation
              ]
        ]
      $ 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 :: [[Either Char Pron.Pron]] =
                  partText
                    & foldMap
                      ( \(tbl, txt) ->
                          txt
                            & Pron.runLexer
                            & either (\err -> errorShow (txt, err)) id
                            & Pron.runParser tbl
                            & either (\err -> errorShow (txt, err)) id
                      )
                    & Pron.words
            {-
            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 ->
            --                  case kv & lexemePron of
            --                    PronunciationIPABroad{pronunciationIPA = IPA.Syllable [IPA.Zero]} -> (i, (i, kv) : is)
            --                    PronunciationIPABroad{} -> (i + 1, (i + 1, kv) : is)
            --              )
            --              (idx, [])
            --              lexs
            -- let isBreak c =
            --      c
            --        == Pron.borderLeftChar
            --        || c
            --        == Pron.borderRightChar
            forM_ (textToSoundsGroup & Pron.addIndexes) \textToSounds -> do
              HTML.div ! classes ["sentence-horiz"] $ do
                -- let addWordIndexes (wordIndex :: Int) = \case
                --      [] -> []
                --      (pronIndex, lex@Lexeme{..}) : t ->
                --        (wordIndex, (pronIndex, lex)) : addWordIndexes idx' t
                --        where
                --          idx'
                --            | lexemeKey == Text.singleton Pron.borderLeftChar = wordIndex
                --            | lexemeKey == Text.singleton Pron.borderRightChar = wordIndex
                --            | otherwise = wordIndex + 1
                --  FIXME: 0::Int
                forM_ (textToSounds <&> (0 :: Int,)) \(wordIndex, (pronIndex, charOrPron)) -> do
                  let pronChars = case charOrPron of
                        Left c -> [c]
                        Right pron -> pron & Pron.pronInput & Pron.lexemesChars
                  -- 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 = lexemeKey & metanizer & addCharIndexes 0
                  HTML.div
                    ! classes
                      [ "sentence-word"
                      , "word-index-" <> show wordIndex
                      , "lang-" <> className partLangue
                      ]
                    ! styles
                      [ "grid-template-columns" :=
                          "repeat("
                            <> (pronChars & List.length & show)
                            <> ",auto)"
                      ]
                    $ do
                      HTML.div
                        ! classes
                          [ "sentence-cell"
                          , "pronunciation"
                          , -- , "cell-index-"<>show pronIndex
                            case charOrPron of
                              Left{} -> ""
                              Right Pron.Pron{pronRule = Pron.Rule{rulePron = PronunciationIPABroad{pronunciationIPA = [IPA.Syllable [IPA.Zero]]}}} -> "cell-silent"
                              Right Pron.Pron{pronRule = Pron.Rule{rulePron = PronunciationIPABroad{}}} -> if even pronIndex then "cell-even" else "cell-odd"
                          ]
                        ! styles
                          [ "grid-column-end" := "span " <> show (pronChars & List.length)
                          -- , "display" := if partLangue == LangueAnglais then "none" else ""
                          ]
                        $ do
                          HTML.toHtml $ case charOrPron of
                            Left{} -> ""
                            Right Pron.Pron{pronRule = Pron.Rule{rulePron = PronunciationIPABroad{pronunciationIPA = [IPA.Syllable [IPA.Zero]]}}} -> ""
                            Right Pron.Pron{pronRule = Pron.Rule{rulePron = PronunciationIPABroad{Pron.pronunciationText = txt}}} -> txt
                      forM_ pronChars \pronChar -> do
                        let uniScript = pronChar & Char.unicodeBlock & fromMaybe (UnicodeBlockLatin UnicodeBlockLatin_Basic)
                        HTML.span
                          ! classes
                            [ "sentence-cell"
                            , "model"
                            , "script-" <> className uniScript
                            , if pagesDifficulties
                                & lookupOrTypeDefault partLangue
                                & lookupOrTypeDefault uniScript
                                & difficultyModel
                                then mempty
                                else "hidden"
                                -- , if isBreak $ charMetaChar charMeta
                                --    then "break"
                                --    else "non-break"
                            ]
                          $ do
                            HTML.span ! classes ["cell"] $ do
                              pronChar & HTML.toHtml
                      forM_ (pronChars & List.zip [0 :: Int ..]) \(charIndex, pronChar) -> do
                        let uniScript = pronChar & Char.unicodeBlock & fromMaybe (UnicodeBlockLatin UnicodeBlockLatin_Basic)
                        HTML.span
                          ! classes
                            [ "sentence-cell"
                            , "input"
                            , "input-index-" <> show charIndex
                            , "script-" <> className uniScript
                            , if pagesDifficulties
                                & lookupOrTypeDefault partLangue
                                & lookupOrTypeDefault uniScript
                                & difficultyHiddenPatterns
                                then "hidden"
                                else ""
                                -- , if isBreak $ charMetaChar charMeta
                                --    then "break"
                                --    else "non-break"
                            ]
                          $ do
                            HTML.span ! classes ["cell"] $ do
                              pronChar & HTML.toHtml
-}