{-
  Copyright (c) Meta Platforms, Inc. and affiliates.
  All rights reserved.

  This source code is licensed under the BSD-style license found in the
  LICENSE file in the root directory of this source tree.
-}

-- | This is a very incomplete skeleton of an in-memory storage backend.
-- at the moment it is only usable for tests which don't produce or query
-- facts.

module Glean.Database.Storage.Memory
  ( Memory(..)
  , newStorage
  , Database(..)
  ) where

import Data.ByteString (ByteString)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import System.IO.Temp (withSystemTempDirectory)

import Util.STM

import Glean.Database.Exception
import Glean.Database.Storage
import Glean.Repo.Text
import Glean.RTS.Foreign.FactSet (FactSet)
import qualified Glean.RTS.Foreign.FactSet as FactSet
import Glean.RTS.Foreign.Lookup
import Glean.Types (Repo)

newtype Memory = Memory (TVar (HashMap Repo (Database Memory)))

newStorage :: IO Memory
newStorage = Memory <$> newTVarIO HashMap.empty

-- | An abstract storage for fact database
instance Storage Memory where
  data Database Memory = Database
    { dbRepo :: Repo
    , dbFacts :: FactSet
    , dbData :: TVar (HashMap ByteString ByteString)
    }

  describe = const "memory:"

  open (Memory v) repo (Create start _unit _) _ = do
    facts <- FactSet.new start
    atomically $ do
      dbs <- readTVar v
      case HashMap.lookup repo dbs of
        Nothing -> do
          db <- Database repo facts <$> newTVar mempty
          writeTVar v $ HashMap.insert repo db dbs
          return db
        Just _ -> dbError repo "database already exists"
  open (Memory v) repo _ _ = do
    dbs <- readTVarIO v
    case HashMap.lookup repo dbs of
      Just db -> return db
      Nothing -> dbError repo "database doesn't exist"

  -- TODO
  close _ = return ()

  delete (Memory v) = atomically . modifyTVar' v . HashMap.delete

  safeRemoveForcibly = delete

  predicateStats = FactSet.predicateStats . dbFacts

  store db key value =
    atomically $ modifyTVar' (dbData db) $ HashMap.insert key value
  retrieve db key =
    atomically $ HashMap.lookup key <$> readTVar (dbData db)

  commit db facts = FactSet.append (dbFacts db) facts

  -- TODO: ownership
  addOwnership _ _ _ = return ()

  optimize _ _ = return ()

  -- TODO: ownership
  computeOwnership _ _ _ = return (error "unimplemented computeOwnership")
  getUnitId _ _ = return (error "unimplemented getUnitId")
  getUnit _ _ = return (error "unimplemented getUnit")
  storeOwnership _ _ _ = return ()  -- can't fail, otherwise we fail tests
  getOwnership _ = return Nothing
  addDefineOwnership _ _ =
    return (error "unimplemented addDefineOwnership")
  computeDerivedOwnership _ _ _ =
    return (error "unimplemented computeDerivedOwnership")
  cacheOwnership _ = return ()
  prepareFactOwnerCache _ = return ()

  -- TODO
  getTotalCapacity _ = return Nothing

  -- TODO
  getUsedCapacity _ = return Nothing

  -- TODO
  getFreeCapacity _ = return maxBound

  withScratchRoot _ f = withSystemTempDirectory "glean" f

  -- TODO
  backup db _ _ = dbError (dbRepo db) "unimplemented 'backup'"
  -- TODO
  restore _ repo _ _ = dbError repo "unimplemented 'restore'"

instance CanLookup (Database Memory) where
  lookupName Database{..} = "memory:" <> repoToText dbRepo
  withLookup = withLookup . dbFacts