<commit_before>{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}

module Hecate.Database.Properties
  ( doDatabaseProperties
  ) where

import Control.Monad.Except
import Control.Monad.Reader
import Data.List ((\\))
import Data.Text.Arbitrary ()
import Database.SQLite.Simple hiding (Error)
import System.Directory (copyFile, createDirectory)
import System.Posix.Temp
import Test.QuickCheck
import Test.QuickCheck.Monadic

import Hecate.Context
import Hecate.Data
import Hecate.Database
import Hecate.Error
import Hecate.GPG (Plaintext)
import Hecate.Orphans ()


data TestData = TestData
  { testDescription :: Description
  , testIdentity    :: Maybe Identity
  , testPlainText   :: Plaintext
  , testMetadata    :: Maybe Metadata
  } deriving (Eq, Show)

instance Arbitrary TestData where
  arbitrary                     = TestData <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
  shrink (TestData as bs cs ds) = TestData <$> shrink as <*> shrink bs <*> shrink cs <*> shrink ds

addEntryToDatabase
  :: (MonadIO m, MonadReader AppContext m, MonadError AppError m)
  => Connection
  -> [TestData]
  -> m [Entry]
addEntryToDatabase c tds = do
  es <- mapM (\td -> createEntry (testDescription td) (testIdentity td) (testPlainText td) (testMetadata td)) tds
  _  <- mapM (put c) es
  return es

prop_roundTripEntriesToDatabase :: AppContext -> Property
prop_roundTripEntriesToDatabase ctx = monadicIO $ do
  tds <- pick $ listOf1 arbitrary
  es  <- run $ runExceptT $ flip runReaderT ctx $ addEntryToDatabase (appContextConnection ctx) tds
  res <- run $ selectAll (appContextConnection ctx)
  case es of
    Right xs -> assert $ null (xs \\ res)
    _        -> assert False

dbTests :: [AppContext -> Property]
dbTests = [ prop_roundTripEntriesToDatabase ]

doDatabaseProperties :: IO [Result]
doDatabaseProperties = do
  dir         <- mkdtemp "/tmp/hecate-tests-"
  _           <- copyFile "./example/hecate.toml" (dir ++ "/hecate.toml")
  _           <- createDirectory (dir ++ "/db")
  (Right ctx) <- runExceptT (configure dir >>= createContext)
  results     <- mapM (\p -> quickCheckWithResult stdArgs (p ctx)) dbTests
  _           <- close (appContextConnection ctx)<commit_msg>tests: update doDatabaseProperties<commit_after>{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}

module Hecate.Database.Properties
  ( doDatabaseProperties
  ) where

import Control.Monad.Except
import Control.Monad.Reader
import Data.List ((\\))
import Data.Text.Arbitrary ()
import Database.SQLite.Simple hiding (Error)
import System.Directory (copyFile)
import System.Posix.Temp
import Test.QuickCheck
import Test.QuickCheck.Monadic

import Hecate.Context
import Hecate.Data
import Hecate.Database
import Hecate.Error
import Hecate.GPG (Plaintext)
import Hecate.Orphans ()


data TestData = TestData
  { testDescription :: Description
  , testIdentity    :: Maybe Identity
  , testPlainText   :: Plaintext
  , testMetadata    :: Maybe Metadata
  } deriving (Eq, Show)

instance Arbitrary TestData where
  arbitrary                     = TestData <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
  shrink (TestData as bs cs ds) = TestData <$> shrink as <*> shrink bs <*> shrink cs <*> shrink ds

addEntryToDatabase
  :: (MonadIO m, MonadReader AppContext m, MonadError AppError m)
  => Connection
  -> [TestData]
  -> m [Entry]
addEntryToDatabase c tds = do
  es <- mapM (\td -> createEntry (testDescription td) (testIdentity td) (testPlainText td) (testMetadata td)) tds
  _  <- mapM (put c) es
  return es

prop_roundTripEntriesToDatabase :: AppContext -> Property
prop_roundTripEntriesToDatabase ctx = monadicIO $ do
  tds <- pick $ listOf1 arbitrary
  es  <- run $ runExceptT $ flip runReaderT ctx $ addEntryToDatabase (appContextConnection ctx) tds
  res <- run $ selectAll (appContextConnection ctx)
  case es of
    Right xs -> assert $ null (xs \\ res)
    _        -> assert False

dbTests :: [AppContext -> Property]
dbTests = [ prop_roundTripEntriesToDatabase ]

doDatabaseProperties :: IO [Result]
doDatabaseProperties = do
  dir         <- mkdtemp "/tmp/hecate-tests-"
  _           <- copyFile "./example/hecate.toml" (dir ++ "/hecate.toml")
  (Right ctx) <- runExceptT (configure dir >>= createContext)
  results     <- mapM (\p -> quickCheckWithResult stdArgs (p ctx)) dbTests
  _           <- close (appContextConnection ctx)
{'fraction_non_alphanumeric': 0.10592255125284739, 'fraction_numerical': 0.00045558086560364467, 'mean_word_length': 3.6514830508474576, 'pattern_counts': {'":': 0, '<': 40, '<?xml version=': 0, '>': 41, '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': '3611795', 'n_tokens_mistral': 1395, 'n_tokens_neox': 1336, 'n_words': 387}