import ProjectM36.Base
import ProjectM36.Tuple
import ProjectM36.DatabaseContext.SelfTest
import ProjectM36.Attribute
import ProjectM36.Session
import ProjectM36.Client
import ProjectM36.Relation
import ProjectM36.Cache.RelationalExprCache
import ProjectM36.Cache.Tuple
import ProjectM36.SystemMemory

import Test.HUnit
import Text.Megaparsec
import System.Exit
import Control.Concurrent.STM
import Data.UUID.V4
import qualified Streamly.Data.Stream.Prelude as S
import qualified Data.Vector as V
import System.IO.Temp
import System.IO
import qualified Data.Text as T
import System.FilePath
import qualified Data.Map as M
import Data.Time.Clock
import qualified Data.Set as Set
import System.Random

testList :: Test
testList = TestList [
                     testTupleCacheRoundtripv000,
                     testExpensiveExpr,
                     testCacheEviction,
                     testMemoryPressureParsers
                     ]

main :: IO ()
main = do
  tcounts <- runTestTT testList
  if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess  


testConnection :: NotificationCallback -> IO (SessionId, Connection)
testConnection callback = do
  dbconn <- connectProjectM36 (InProcessConnectionInfo NoPersistence callback [] selfTestDatabaseContext (mkStdGen 36) adminRoleName)
  case dbconn of 
    Left err -> error (show err)
    Right conn -> do
      eSessionId <- createSessionAtHead conn "master"
      case eSessionId of
        Left err -> error (show err)
        Right sessionId -> do
          Right _ <- commit sessionId conn 
          pure (sessionId, conn)

{-
testCachePurgeProbability :: Test
testCachePurgeProbability = TestCase $ do
  

testInMemoryCache :: Test
testInMemoryCache = TestCase $ do
  cache <- empty
  --test adding an entry
-}

testTupleCacheRoundtripv000 :: Test
testTupleCacheRoundtripv000 = TestCase $ do
  newTid <- nextRandom
  let tuples = mkRelationTuples attrs (map (\n -> V.fromList [IntegerAtom n, TextAtom (T.pack (show n))]) numbers)
      numbers = [1 .. 500]
      attrs = attributesFromList [Attribute "a" IntegerAtomType, Attribute "b" TextAtomType]
      expr = RelationVariable "x" newTid
  
  withSystemTempDirectory "pm36tuplecache" $ \tmpdir ->
    withFile (tmpdir </> "pm36tuplecache") ReadWriteMode $ \h -> do
      writeTupleStream h expr 100 tuples
      hSeek h AbsoluteSeek 0
      rrTuples <- S.toList (readTupleStream h)
      assertEqual "round-trip tuple cache" tuples rrTuples
    
testExpensiveExpr :: Test
testExpensiveExpr = TestCase $ do
  -- run expensive query twice, the second time the result should be cached since the cache is large enough and nothing else should be in the cache.
  (session, conn) <- testConnection emptyNotificationCallback
  cache <- case conn of
             RemoteConnection{} -> assertFailure "unexpected remote connection"
             InProcessConnection conf -> pure (ipRelExprCache conf)

  currentSize' <- readTVarIO (currentSize cache)
  assertEqual "cache size zero" 0 currentSize'
  
  Right headTransId <- headTransactionId session conn
  let expensiveExpr = MakeRelationFromExprs Nothing
                      (TupleExprs tmarker
                       [TupleExpr (M.fromList [("expensive",
                                                FunctionAtomExpr "test_expensive"
                                                  [NakedAtomExpr (TextAtom "test"),
                                                   NakedAtomExpr (IntegerAtom 1000000)] tmarker)
                                              ])
                       ])
      tmarker = TransactionIdLookup headTransId
      expensiveResult = mkRelationFromList (attributesFromList [Attribute "expensive" TextAtomType]) [[TextAtom "test"]]
  before <- getCurrentTime
  result1 <- executeTransGraphRelationalExpr session conn expensiveExpr
  
  assertEqual "first expensive run" expensiveResult result1
  after <- getCurrentTime  
  let firstDiff = diffUTCTime after before
--  print $ firstDiff
  assertBool "first expensive time" (firstDiff > 1.0)

  -- run the expensive expression again but we expect that it should be cached
  before' <- getCurrentTime
  result' <- executeTransGraphRelationalExpr session conn expensiveExpr
  
  assertEqual "second expensive run" expensiveResult result'
  after' <- getCurrentTime
  let secondDiff = diffUTCTime after' before'
--  print secondDiff
  assertBool ("second expensive time, actual: " <> show secondDiff) (secondDiff < 1.0)  

  currentSize'' <- readTVarIO (currentSize cache)
  assertEqual "primed cache size" 80 currentSize''

  putStrLn "ext_expensive"
  -- project on the expensive attribute to check that the composed expression can still be serviced by the cache
  let expensiveExpr2 = Project (AttributeNames (Set.singleton "ext_expensive")) $ Extend (AttributeExtendTupleExpr "ext_expensive" (FunctionAtomExpr "text_length" [AttributeAtomExpr "expensive"] tmarker)) expensiveExpr
      expensiveResult2 = mkRelationFromList (attributesFromList [Attribute "ext_expensive" IntegerAtomType]) [[IntegerAtom 4]]
  before'' <- getCurrentTime

  result'' <- executeTransGraphRelationalExpr session conn expensiveExpr2

  assertEqual "extended expensive (cached)" expensiveResult2 result''

  after'' <- getCurrentTime

  let expensive2Diff = diffUTCTime after'' before''
  assertBool ("stacked expensive time, actual: " <> show expensive2Diff) (expensive2Diff < 1.0)    

--test cache eviction when size boundaries are hit
testCacheEviction :: Test
testCacheEviction = TestCase $ do
  (session, conn) <- testConnection emptyNotificationCallback
  Right headTransId <- headTransactionId session conn  
  let maxCacheSize = 100
      -- change the attribute to create multiple cache entries
      tmarker = TransactionIdLookup headTransId      
      expensiveExpr attr = MakeRelationFromExprs Nothing
                      (TupleExprs tmarker
                       [TupleExpr (M.fromList [(attr,
                                                FunctionAtomExpr "test_expensive"
                                                  [NakedAtomExpr (TextAtom "test"),
                                                   NakedAtomExpr (IntegerAtom 100000)] tmarker)
                                              ])
                       ])
  
  cache <- case conn of
             RemoteConnection{} -> assertFailure "unexpected remote connection"
             InProcessConnection conf -> pure (ipRelExprCache conf)
  
  -- add something to the cache
  _result1 <- executeTransGraphRelationalExpr session conn (expensiveExpr "expensive1")
  
  -- check size
  currentSize' <- readTVarIO (currentSize cache)
  assertBool ("expensive1 cache size: " <> show currentSize') (currentSize' > 0)

  atomically $ writeTVar (upperBound cache) maxCacheSize

  -- add an item to go over the max cache size
  _result2 <- executeTransGraphRelationalExpr session conn (expensiveExpr "expensive2")  

  -- check cache size to ensure that previous entry was evicted
  currentSize'' <- readTVarIO (currentSize cache)
  assertBool ("expensive2 cache size: " <> show currentSize'' <> " maxCacheSize: " <> show maxCacheSize) (currentSize'' < maxCacheSize)  -- fails because maxCacheSize is now ignored in preference to totalMem

  -- check that the correct entry was evicted
  before <- getCurrentTime
  _result2 <- executeTransGraphRelationalExpr session conn (expensiveExpr "expensive2")
  after <- getCurrentTime

  assertBool "expensive2 was not cached" (diffUTCTime after before < 1.0)
  
testMemoryPressureParsers :: Test
testMemoryPressureParsers = TestCase $ do
  let memPressureText = "The system has 17179869184 (4194304 pages with a page size of 4096).\n\nStats: \nPages free: 21520 \nPages purgeable: 35807 \nPages purged: 1955197 \n\nSwap I/O:\nSwapins: 3271498 \nSwapouts: 3621839 \n\nPage Q counts:\nPages active: 1384067 \nPages inactive: 1355579 \nPages speculative: 31236 \nPages throttled: 0 \nPages wired down: 785131 \n\nCompressor Stats:\nPages used by compressor: 616157 \nPages decompressed: 16701642 \nPages compressed: 26508007 \n\nFile I/O:\nPageins: 31529331 \nPageouts: 166002 \n\nSystem-wide memory free percentage: 66%"
  let res = parse parseMemoryPressureFreeMem "" memPressureText
  case res of
    Left err -> putStrLn (errorBundlePretty err)
    Right _ -> pure ()
  assertEqual "parse free mem memory_pressure" (Right (21520 * 4096, 17179869184)) res

  let res' = parse parseMemoryPressureValue "" memPressureText
  case res' of
    Left err -> putStrLn (errorBundlePretty err)
    Right _ -> pure ()
  assertEqual "parse memory_pressure percentage" (Right 66) res'