feat: add `check` cmd

1 files changed, 44 insertions, 3 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 936f053..ebf94c9 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -18,6 +18,7 @@ import Control.Arrow (first, second)
 import Control.Concurrent.ParallelIO.Local (parallel, withPool)
 import Control.Exception (Exception, throw, throwIO)
 import Control.Monad (unless, when)
+import Control.Parallel.Strategies (parList, rdeepseq, withStrategy)
 import Data.Aeson qualified as J
 import Data.Attoparsec.Text qualified as A
 import Data.ByteString.Lazy qualified as LB
@@ -28,7 +29,7 @@ import Data.HashMap.Internal qualified as HM
 import Data.List
 import Data.List.NonEmpty qualified as N
 import Data.Map qualified as M
-import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
 import Data.Ord (comparing)
 import Data.Set qualified as S
 import Data.String (IsString (fromString))
@@ -39,8 +40,9 @@ import Data.Time.Clock (getCurrentTime)
 import Data.Time.Format.ISO8601 (iso8601ParseM)
 import Debug.Trace
 import Document qualified as D
-import GHC.Conc (getNumProcessors)
+import GHC.Conc (getNumProcessors, numCapabilities)
 import Options.Applicative qualified as O
+import Parallel (streamsOf)
 import ProbabilityMap qualified as C
 import Prompt qualified as P
 import Settings qualified as S
@@ -89,6 +91,7 @@ data Cmd
         tags :: [G.Tag],
         untags :: [G.Tag]
       }
+  | Check
 
 args :: O.Parser Args
 args =
@@ -110,7 +113,9 @@ cmd =
       O.command "topwords" . O.info topWordsCmd $
         O.progDesc "View probability map per tag",
       O.command "modify" . O.info modifyCmd $
-        O.progDesc "Modify document(s)"
+        O.progDesc "Modify document(s)",
+      O.command "check" . O.info checkCmd $
+        O.progDesc "Check document tags"
     ]
 
 consumeCmd :: O.Parser Cmd
@@ -157,6 +162,10 @@ modifyCmd =
     <*> tagsArg
     <*> untagsArg
 
+checkCmd :: O.Parser Cmd
+checkCmd =
+  pure Check
+
 inputsArg :: O.Parser [FilePath]
 inputsArg =
   O.many
@@ -374,6 +383,38 @@ main = do
               doc
         )
         (map (addTags tags . removeTags untags) docs)
+    Args {cmd = Check} -> do
+      allDocs <- D.getDocuments
+      probabilityCache <- C.readProbabilityCache
+      mapM_
+        ( \(doc, tags, tags') -> do
+            printf "%s\n" (takeBaseName doc.iFileName)
+            printTags doc
+            mapM_
+              (\tag -> printf ("- %s\n") (show tag))
+              (tags `S.difference` tags')
+            mapM_
+              (\tag -> printf ("+ %s\n") (show tag))
+              (tags' `S.difference` tags)
+        )
+        ( catMaybes
+            ( concat
+                ( withStrategy
+                    (parList rdeepseq)
+                    ( streamsOf
+                        numCapabilities
+                        ( map
+                            ( \doc ->
+                                let tags = S.filter arbitrarilySelectTag doc.index.tags
+                                    tags' = S.fromList $ autoApplySuggestedTags $ suggestTags settings probabilityCache doc
+                                 in if tags == tags' then Nothing else Just (doc, tags, tags')
+                            )
+                            allDocs
+                        )
+                    )
+                )
+            )
+        )
 
 printTags :: D.Document -> IO ()
 printTags doc =