chore: make computing `probabilityMap` more performance

1 files changed, 60 insertions, 0 deletions

diff --git a/app/Store.hs b/app/Store.hs
new file mode 100644
index 0000000..7a4637f
--- /dev/null
+++ b/app/Store.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+
+module Store
+  ( commitDocument,
+    replaceDocument,
+  )
+where
+
+import Control.Exception (Exception, throwIO)
+import Data.Aeson qualified as J
+import Data.ByteString.Lazy qualified as LB
+import Data.Default (Default (def))
+import Data.List (intercalate)
+import Data.String (IsString (fromString))
+import Document qualified as D
+import ProbabilityMap qualified as C
+import System.Directory (copyFile)
+import System.Exit (ExitCode (ExitFailure, ExitSuccess))
+import System.IO.LockFile (withLockFile)
+import System.Process.Typed (readProcessStderr)
+import Text.Printf (printf)
+
+replaceDocument :: String -> D.Document -> IO ()
+replaceDocument message doc = do
+  withGit do
+    J.encodeFile doc.iFilePath doc.index
+    oldDoc <- D.readDocument doc.iFileName
+    _ <- C.modifyProbabilityCache (C.replaceDocument oldDoc doc)
+    commitAll [doc.iFilePath, C.fileName] message
+
+commitDocument :: String -> FilePath -> D.Document -> IO ()
+commitDocument message original doc = do
+  withGit do
+    copyFile original doc.oFilePath
+    J.encodeFile doc.iFilePath doc.index
+    _ <- C.modifyProbabilityCache (C.addDocument doc)
+    commitAll [doc.iFilePath, doc.oFilePath, C.fileName] message
+
+withGit :: IO a -> IO a
+withGit = withLockFile def ".gitlock"
+
+commitAll :: [FilePath] -> String -> IO ()
+commitAll fps m = do
+  sh_ (">/dev/null git add -- " ++ intercalate " " (map (printf "'%s'") fps))
+  sh_ (printf ">/dev/null git commit -m '%s' || :" m)
+
+-- TODO Refacotor library `sh`
+sh_ :: String -> IO ()
+sh_ cmd = do
+  -- printf "+ %s\n" cmd
+  (exitCode, err) <- readProcessStderr (fromString cmd)
+  case exitCode of
+    ExitSuccess -> return ()
+    ExitFailure exitCode' -> throwIO $ ProcessException exitCode' err
+
+data ProcessException = ProcessException Int LB.ByteString
+  deriving (Show)
+
+instance Exception ProcessException