module Language.ChineseSpec where

import Control.Arrow ((>>>))
import Control.Monad (Monad (..))
import Data.Bool
import Data.ByteString.Builder qualified as Builder
import Data.Eq (Eq (..))
import Data.Foldable (null)
import Data.Function (($), (&), (.))
import Data.Functor ((<&>))
import Data.GenValidity.Map ()
import Data.GenValidity.Sequence ()
import Data.GenValidity.Set ()
import Data.GenValidity.Text ()
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Maybe (isNothing)
import Data.Monoid (Monoid (..))
import Data.Ord (Down (..))
import Data.Set (Set)
import Data.Set qualified as Set
import Data.String (String)
import Data.Text qualified as Text
import Data.Text.Short qualified as ShortText
import Data.Validity.Map ()
import Data.Validity.Set ()
import Data.Validity.Text ()
import GHC.Stack (HasCallStack)
import System.FilePath (joinPath, pathSeparator, (<.>), (</>))
import Test.Syd
import Text.Show (Show (..))

import Language.Chinese (ChineseDict (..), ChineseDictEntries (..), unChineseDict)
import Language.Chinese qualified as Chinese
import Worksheets.Utils.Prelude

getGoldenPath title = do
  descrPath <- getTestDescriptionPath
  let dirPath =
        List.reverse descrPath
          <&> Text.unpack
            . Text.replace
              (Text.pack ".")
              (Text.singleton pathSeparator)
          & joinPath
  return $ "tests" </> dirPath </> title <.> "golden"

goldenShowWithOuter :: Show a => String -> (outer -> a) -> TestDefM (outer : outers) () ()
goldenShowWithOuter title run = do
  outPath <- getGoldenPath title
  itWithOuter title \outer -> do
    goldenPrettyShowInstance outPath $
      run outer

goldenBuilderWithOuter :: String -> (outer -> Builder.Builder) -> TestDefM (outer : outers) () ()
goldenBuilderWithOuter title run = do
  outPath <- getGoldenPath title
  itWithOuter title \outer -> do
    pureGoldenByteStringBuilderFile outPath $
      run outer

spec :: HasCallStack => Spec
spec =
  aroundAll (\k -> Chinese.readChineseLexicalDatabase >>= k) do
    goldenShowWithOuter "size" $ unChineseDict >>> Map.size
    goldenShowWithOuter "keyLengthToSumOfEntries" $ Chinese.keyLengthToSumOfEntries
    goldenShowWithOuter "keysWithoutStrokes" keysWithoutStrokes
    goldenShowWithOuter "keysWithoutDecomp" keysWithoutDecomp
    goldenShowWithOuter "keysWithoutFreq" $ keysWithoutFreq >>> Set.size
    describe "dictToWeights" do
      aroundAllWith (\k dict -> k (Chinese.dictToWeights dict)) do
        goldenShowWithOuter "size" Map.size
        goldenShowWithOuter "take_10" $ Map.take 10
        describe "dictOrder" do
          aroundAllWith (\k weights -> k ((Chinese.dictOrder weights))) do
            goldenBuilderWithOuter "all" chineseOrderTsv
            goldenBuilderWithOuter "take_10" $ Chinese.unChineseOrder >>> Map.take 10 >>> Chinese.ChineseOrder >>> chineseOrderTsv

chineseOrderTsv :: Chinese.ChineseOrder -> Builder.Builder
chineseOrderTsv (Chinese.ChineseOrder o) =
  ["weight\tkey\n"]
    <> [ [ weight & show & Builder.stringUtf8
         , "\t"
         , key & ShortText.unpack & Builder.stringUtf8
         , "\n"
         ]
        & mconcat
       | (Down weight, keyToBC) <- o & Map.toList
       , key <- keyToBC & Map.keys
       ]
    & mconcat

keysWithoutStrokes :: ChineseDict -> Set Chinese.DictKey
keysWithoutStrokes (ChineseDict d) =
  d
    & Map.filterWithKey
      ( \key ChineseDictEntries{chineseStrokes} ->
          ShortText.length key == 1
            && isNothing chineseStrokes
      )
    & Map.keysSet
keysWithoutDecomp :: ChineseDict -> Set Chinese.DictKey
keysWithoutDecomp (ChineseDict d) =
  d
    & Map.filterWithKey
      ( \key ChineseDictEntries{chineseComponents} ->
          ShortText.length key == 1
            && null chineseComponents
      )
    & Map.keysSet
keysWithoutFreq :: ChineseDict -> Set Chinese.DictKey
keysWithoutFreq (ChineseDict d) =
  d
    & Map.filterWithKey
      ( \key ChineseDictEntries{chineseFrequency} ->
          ShortText.length key == 1
            && isNothing chineseFrequency
      )
    & Map.keysSet