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 System.FilePath (joinPath, pathSeparator, (<.>), (</>))
  30 import Test.Syd
  31 import Text.Show (Show (..))
  32
  33 import Language.Chinese (ChineseDict (..), ChineseDictEntries (..), unChineseDict)
  34 import Language.Chinese qualified as Chinese
  35 import Worksheets.Utils.Prelude
  36
  37 getGoldenPath title = do
  38   descrPath <- getTestDescriptionPath
  39   let dirPath =
  40         List.reverse descrPath
  41           <&> Text.unpack
  42             . Text.replace
  43               (Text.pack ".")
  44               (Text.singleton pathSeparator)
  45           & joinPath
  46   return $ "tests" </> dirPath </> title <.> "golden"
  47
  48 goldenShowWithOuter :: Show a => String -> (outer -> a) -> TestDefM (outer : outers) () ()
  49 goldenShowWithOuter title run = do
  50   outPath <- getGoldenPath title
  51   itWithOuter title \outer -> do
  52     goldenPrettyShowInstance outPath $
  53       run outer
  54
  55 goldenBuilderWithOuter :: String -> (outer -> Builder.Builder) -> TestDefM (outer : outers) () ()
  56 goldenBuilderWithOuter title run = do
  57   outPath <- getGoldenPath title
  58   itWithOuter title \outer -> do
  59     pureGoldenByteStringBuilderFile outPath $
  60       run outer
  61
  62 spec :: HasCallStack => Spec
  63 spec =
  64   aroundAll (\k -> Chinese.readChineseLexicalDatabase >>= k) do
  65     goldenShowWithOuter "size" $ unChineseDict >>> Map.size
  66     goldenShowWithOuter "keyLengthToSumOfEntries" $ Chinese.keyLengthToSumOfEntries
  67     goldenShowWithOuter "keysWithoutStrokes" keysWithoutStrokes
  68     goldenShowWithOuter "keysWithoutDecomp" keysWithoutDecomp
  69     goldenShowWithOuter "keysWithoutFreq" $ keysWithoutFreq >>> Set.size
  70     describe "dictToWeights" do
  71       aroundAllWith (\k dict -> k (Chinese.dictToWeights dict)) do
  72         goldenShowWithOuter "size" $ Chinese.weightsMap >>> Map.size
  73         goldenShowWithOuter "take_10" $ Chinese.weightsMap >>> Map.take 10
  74         describe "dictOrder" do
  75           aroundAllWith (\k weights -> k ((Chinese.dictOrder weights))) do
  76             goldenBuilderWithOuter "all" chineseOrderTsv
  77             goldenBuilderWithOuter "take_10" $ Chinese.unChineseOrder >>> Map.take 10 >>> Chinese.ChineseOrder >>> chineseOrderTsv
  78
  79 chineseOrderTsv :: Chinese.ChineseOrder -> Builder.Builder
  80 chineseOrderTsv (Chinese.ChineseOrder o) =
  81   ["weight\tkey\n"]
  82     <> [ [ weight & show & Builder.stringUtf8
  83          , "\t"
  84          , key & ShortText.unpack & Builder.stringUtf8
  85          , "\n"
  86          ]
  87         & mconcat
  88        | (Down weight, keyToBC) <- o & Map.toList
  89        , key <- keyToBC & Chinese.weightsMap & Map.keys
  90        ]
  91     & mconcat
  92
  93 keysWithoutStrokes :: ChineseDict -> Set Chinese.DictKey
  94 keysWithoutStrokes (ChineseDict d) =
  95   d
  96     & Map.filterWithKey
  97       ( \key ChineseDictEntries{chineseStrokes} ->
  98           ShortText.length key == 1
  99             && isNothing chineseStrokes
 100       )
 101     & Map.keysSet
 102 keysWithoutDecomp :: ChineseDict -> Set Chinese.DictKey
 103 keysWithoutDecomp (ChineseDict d) =
 104   d
 105     & Map.filterWithKey
 106       ( \key ChineseDictEntries{chineseComponents} ->
 107           ShortText.length key == 1
 108             && null chineseComponents
 109       )
 110     & Map.keysSet
 111 keysWithoutFreq :: ChineseDict -> Set Chinese.DictKey
 112 keysWithoutFreq (ChineseDict d) =
 113   d
 114     & Map.filterWithKey
 115       ( \key ChineseDictEntries{chineseFrequency} ->
 116           ShortText.length key == 1
 117             && isNothing chineseFrequency
 118       )
 119     & Map.keysSet