<commit_before>module Wikirick.Backends.Repository
  ( module Wikirick.Repository
  , initRepository
  , makeRepository
  ) where

import qualified Control.Concurrent.ReadWriteLock as RWL
import Control.Monad.CatchIO
import qualified Data.Attoparsec as A
import qualified Data.ByteString as BS
import qualified Data.Char as C
import qualified Data.Text.Encoding as TE
import qualified Data.Time as Time
import Data.Word
import Snap
import System.Exit
import System.FilePath
import qualified System.IO.Streams as S
import qualified System.IO.Streams.Attoparsec as SA
import qualified System.Locale as L

import Wikirick.Import
import Wikirick.Repository
import Wikirick.Util

initRepository :: Repository -> SnapletInit b Repository
initRepository = makeSnaplet "repo" "Serves Wiki articles" Nothing . return

makeRepository :: FilePath -> IO Repository
makeRepository dbDir = do
  lock <- RWL.new
  return Repository
    { _fetchArticle = \title -> liftIO $
        RWL.withRead lock $
          fetchArticle' title ["-p", title ^. unpacked]

    , _fetchRevision = \title rev -> liftIO $
        RWL.withRead lock $ do
          when (rev < 1) $ throw InvalidRevision
          fetchArticle' title ["-r1." <> show rev, "-p", title ^. unpacked]

    , _postArticle = \a -> liftIO $
        RWL.withWrite lock $ do
          checkOutRCSFile a
          S.withFileAsOutput (articlePath a) $ \out -> do
            textOut <- S.encodeUtf8 out
            S.write (Just $ a ^. articleSource) textOut

          (in_, _, err, p) <- runInteractiveProcess "ci" [a ^. articleTitle . unpacked]
          S.write Nothing in_
          S.waitForProcess p >>= \case
            ExitSuccess -> return ()
            _ -> throwFromRCSError err

    , _fetchAllArticleTitles = undefined
    }
  where
    fetchArticle' title coOptions = do
      (_, out, err, p) <- runInteractiveProcess "co" coOptions
      source <- consumeText =<< S.decodeUtf8 out
      a <- S.waitForProcess p >>= \case
        ExitSuccess -> do
          rev <- SA.parseFromStream revParser err
          return $ def
            & articleTitle .~ title
            & articleSource .~ source
            & articleRevision .~ Just rev
        _ -> throwFromRCSError err

      case a ^. articleRevision of
        Just rev -> do
          (_, out', err', p') <- runInteractiveProcess "rlog" ["-r1." <> show rev, title ^. unpacked]
          S.waitForProcess p' >>= \case
            ExitSuccess -> do
              log' <- SA.parseFromStream rlogParser out'
              return $ a & editLog .~ Just log'
            _ -> throwFromRCSError err'
        _ -> fail "fetchArticle': must not happen"

    checkOutRCSFile article = do
      (_, _, err, p) <- runInteractiveProcess "co" ["-l", article ^. articleTitle . unpacked]
      S.waitForProcess p >>= \case
        ExitSuccess -> return ()<commit_msg>Get articles revision directly from stderr<commit_after>module Wikirick.Backends.Repository
  ( module Wikirick.Repository
  , initRepository
  , makeRepository
  ) where

import qualified Control.Concurrent.ReadWriteLock as RWL
import Control.Monad.CatchIO
import qualified Data.Attoparsec as A
import qualified Data.ByteString as BS
import qualified Data.Char as C
import qualified Data.Text.Encoding as TE
import qualified Data.Time as Time
import Data.Word
import Snap
import System.Exit
import System.FilePath
import qualified System.IO.Streams as S
import qualified System.IO.Streams.Attoparsec as SA
import qualified System.Locale as L

import Wikirick.Import
import Wikirick.Repository
import Wikirick.Util

initRepository :: Repository -> SnapletInit b Repository
initRepository = makeSnaplet "repo" "Serves Wiki articles" Nothing . return

makeRepository :: FilePath -> IO Repository
makeRepository dbDir = do
  lock <- RWL.new
  return Repository
    { _fetchArticle = \title -> liftIO $
        RWL.withRead lock $
          fetchArticle' title ["-p", title ^. unpacked]

    , _fetchRevision = \title rev -> liftIO $
        RWL.withRead lock $ do
          when (rev < 1) $ throw InvalidRevision
          fetchArticle' title ["-r1." <> show rev, "-p", title ^. unpacked]

    , _postArticle = \a -> liftIO $
        RWL.withWrite lock $ do
          checkOutRCSFile a
          S.withFileAsOutput (articlePath a) $ \out -> do
            textOut <- S.encodeUtf8 out
            S.write (Just $ a ^. articleSource) textOut

          (in_, _, err, p) <- runInteractiveProcess "ci" [a ^. articleTitle . unpacked]
          S.write Nothing in_
          S.waitForProcess p >>= \case
            ExitSuccess -> return ()
            _ -> throwFromRCSError err

    , _fetchAllArticleTitles = undefined
    }
  where
    fetchArticle' title coOptions = do
      (_, out, err, p) <- runInteractiveProcess "co" coOptions
      source <- consumeText =<< S.decodeUtf8 out
      rev <- S.waitForProcess p >>= \case
        ExitSuccess -> SA.parseFromStream revParser err
        _ -> throwFromRCSError err
      (_, out', err', p') <- runInteractiveProcess "rlog" ["-r1." <> show rev, title ^. unpacked]
      log' <- S.waitForProcess p' >>= \case
        ExitSuccess -> SA.parseFromStream rlogParser out'
        _ -> throwFromRCSError err'
      return $ def
        & articleTitle .~ title
        & articleSource .~ source
        & articleRevision .~ Just rev
        & editLog .~ Just log'

    checkOutRCSFile article = do
      (_, _, err, p) <- runInteractiveProcess "co" ["-l", article ^. articleTitle . unpacked]
      S.waitForProcess p >>= \case
        ExitSuccess -> return ()
{'fraction_non_alphanumeric': 0.09519524923519884, 'fraction_numerical': 0.0017995321216483715, 'mean_word_length': 2.5044136191677175, 'pattern_counts': {'":': 0, '<': 32, '<?xml version=': 0, '>': 51, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2253037', 'n_tokens_mistral': 1654, 'n_tokens_neox': 1577, 'n_words': 494}