tests/Language/ChineseSpec.hs

   1 module Language.ChineseSpec where
   2
   3 import Control.Arrow ((>>>))
   4 import Control.Monad (Monad (..))
   5 import Data.Bool
   6 import Data.ByteString.Builder qualified as Builder
   7 import Data.Eq (Eq (..))
   8 import Data.Foldable (null)
   9 import Data.Function (($), (&), (.))
  10 import Data.Functor ((<&>))
  11 import Data.GenValidity.Map ()
  12 import Data.GenValidity.Sequence ()
  13 import Data.GenValidity.Set ()
  14 import Data.GenValidity.Text ()
  15 import Data.List qualified as List
  16 import Data.Map.Strict qualified as Map
  17 import Data.Maybe (isNothing)
  18 import Data.Monoid (Monoid (..))
  19 import Data.Ord (Down (..))
  20 import Data.Set (Set)
  21 import Data.Set qualified as Set
  22 import Data.String (String)
  23 import Data.Text qualified as Text
  24 import Data.Text.Short qualified as ShortText
  25 import Data.Validity.Map ()
  26 import Data.Validity.Set ()
  27 import Data.Validity.Text ()
  28 import GHC.Stack (HasCallStack)
  29 import Paths_worksheets qualified as Self
  30 import System.FilePath (joinPath, pathSeparator, (<.>), (</>))
  31 import System.FilePath.Posix qualified as File
  32 import Test.Syd
  33 import Text.Show (Show (..))
  34
  35 import Language.Chinese (ChineseDict (..), ChineseDictEntries (..), unChineseDict)
  36 import Language.Chinese qualified as Chinese
  37 import Worksheets.Utils.Prelude
  38
  39 getGoldenPath title ext = do
  40   descrPath <- getTestDescriptionPath
  41   let dirPath =
  42         List.reverse descrPath
  43           <&> Text.unpack
  44             . Text.replace
  45               (Text.pack ".")
  46               (Text.singleton pathSeparator)
  47           & joinPath
  48   return $ "tests" </> dirPath </> title <.> ext
  49
  50 goldenShowWithOuter :: Show a => String -> String -> (outer -> a) -> TestDefM (outer : outers) () ()
  51 goldenShowWithOuter title ext run = do
  52   outPath <- getGoldenPath title ext
  53   itWithOuter title \outer -> do
  54     goldenPrettyShowInstance outPath $
  55       run outer
  56
  57 goldenBuilderWithOuter :: String -> String -> (outer -> Builder.Builder) -> TestDefM (outer : outers) () ()
  58 goldenBuilderWithOuter title ext run = do
  59   outPath <- getGoldenPath title ext
  60   itWithOuter title \outer -> do
  61     pureGoldenByteStringBuilderFile outPath $
  62       run outer
  63
  64 spec :: HasCallStack => Spec
  65 spec =
  66   aroundAll (\k -> Chinese.readChineseDict >>= k) do
  67     {-
  68     goldenShowWithOuter "size" "txt" $ unChineseDict >>> Map.size
  69     goldenShowWithOuter "keyLengthToSumOfEntries" "txt" $ Chinese.keyLengthToSumOfEntries
  70     goldenShowWithOuter "keysWithoutStrokes" "txt" keysWithoutStrokes
  71     goldenShowWithOuter "keysWithoutDecomp" "txt" keysWithoutDecomp
  72     goldenShowWithOuter "keysWithoutFreq" "txt" $ keysWithoutFreq >>> Set.size
  73     describe "dictToWeights" do
  74       aroundAllWith (\k dict -> k (Chinese.dictToWeights dict)) do
  75         goldenShowWithOuter "size" "txt" $ Chinese.weightsMap >>> Map.size
  76         goldenShowWithOuter "take_10" "txt" $ Chinese.weightsMap >>> Map.take 10
  77         describe "dictOrder" do
  78           aroundAllWith (\k weights -> k ((Chinese.dictOrder weights))) do
  79             goldenBuilderWithOuter "all" "tsv" chineseOrderTsv
  80             goldenBuilderWithOuter "take_10" "tsv" $ Chinese.unChineseOrder >>> Map.take 10 >>> Chinese.ChineseOrder >>> chineseOrderTsv
  81     -}
  82     outPath <- getGoldenPath "order.5000" "html"
  83     itWithOuter "order" \dict -> do
  84       goldenByteStringBuilderFile outPath do
  85         Chinese.orderHTML (Just 5000) dict
  86
  87 chineseOrderTsv :: Chinese.ChineseOrder -> Builder.Builder
  88 chineseOrderTsv (Chinese.ChineseOrder o) =
  89   ["weight\tkey\n"]
  90     <> [ [ weight & show & Builder.stringUtf8
  91          , "\t"
  92          , key & ShortText.unpack & Builder.stringUtf8
  93          , "\n"
  94          ]
  95            & mconcat
  96        | (Down weight, keyToBC) <- o & Map.toList
  97        , key <- keyToBC & Chinese.weightsMap & Map.keys
  98        ]
  99     & mconcat
 100
 101 keysWithoutStrokes :: ChineseDict -> Set Chinese.DictKey
 102 keysWithoutStrokes (ChineseDict d) =
 103   d
 104     & Map.filterWithKey
 105       ( \key ChineseDictEntries{chineseStrokes} ->
 106           ShortText.length key == 1
 107             && isNothing chineseStrokes
 108       )
 109     & Map.keysSet
 110 keysWithoutDecomp :: ChineseDict -> Set Chinese.DictKey
 111 keysWithoutDecomp (ChineseDict d) =
 112   d
 113     & Map.filterWithKey
 114       ( \key ChineseDictEntries{chineseComponents} ->
 115           ShortText.length key == 1
 116             && null chineseComponents
 117       )
 118     & Map.keysSet
 119 keysWithoutFreq :: ChineseDict -> Set Chinese.DictKey
 120 keysWithoutFreq (ChineseDict d) =
 121   d
 122     & Map.filterWithKey
 123       ( \key ChineseDictEntries{chineseFrequency} ->
 124           ShortText.length key == 1
 125             && isNothing chineseFrequency
 126       )
 127     & Map.keysSet