{-
  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.
-}

module Glean.RTS.Foreign.Lookup
  ( Lookup(..)
  , CanLookup(..)
  , withCanLookup
  , EmptyLookup(..)
  , startingId
  , firstFreeId
  , lookupFact
  , withSnapshot
) where

import Control.Exception (bracket)
import Data.Int
import Data.Text
import Foreign.C
import Foreign.Ptr

import Util.FFI

import Glean.FFI
import Glean.RTS.Types (Fid(..))
import qualified Glean.Types as Thrift

-- | A reference to a thing we can look up facts in
data Lookup = Lookup
  { lookupPtr :: Ptr Lookup
  , lookupName_ :: Text
  }

-- | Class of things we can look up facts in
class CanLookup a where
  withLookup :: a -> (Ptr Lookup -> IO b) -> IO b
  lookupName :: a -> Text

instance CanLookup Lookup where
  withLookup l f = f (lookupPtr l)
  lookupName = lookupName_

withCanLookup :: CanLookup lookup => lookup -> (Lookup -> IO a) -> IO a
withCanLookup lookup f =
  withLookup lookup $ \p -> f (Lookup p (lookupName lookup))

startingId :: CanLookup a => a -> IO Fid
startingId x = withLookup x $ \l -> invoke $ glean_lookup_starting_id l

firstFreeId :: CanLookup a => a -> IO Fid
firstFreeId x = withLookup x $ \l -> invoke $ glean_lookup_first_free_id l

data EmptyLookup = EmptyLookup

instance CanLookup EmptyLookup where
  lookupName EmptyLookup = "lookup:empty"
  withLookup EmptyLookup f =
    bracket
      (invoke glean_lookup_empty)
      glean_lookup_free
      f

lookupFact :: CanLookup a => a -> Fid -> IO (Maybe Thrift.Fact)
lookupFact look fid =
  withLookup look $ \look_ptr -> do
    (pid, key_ptr, key_size, val_ptr, val_size) <-
      invoke $ glean_lookup_fact look_ptr fid
    if pid == 0
      then return Nothing
      else fmap Just $ Thrift.Fact pid
            <$> unsafeMallocedByteString key_ptr key_size
            <*> unsafeMallocedByteString val_ptr val_size

-- | Restrict the Lookup to facts up to the specified fact id
withSnapshot :: CanLookup a => a -> Fid -> (Lookup -> IO b) -> IO b
withSnapshot base boundary f =
  withLookup base $ \base_ptr ->
  bracket
    (invoke $ glean_snapshot_new base_ptr boundary)
    glean_lookup_free
    (\p -> f (Lookup p (lookupName base)))

foreign import ccall unsafe glean_lookup_empty
  :: Ptr (Ptr Lookup) -> IO CString

foreign import ccall unsafe glean_lookup_free
  :: Ptr Lookup -> IO ()

foreign import ccall unsafe glean_snapshot_new
  :: Ptr Lookup -> Fid -> Ptr (Ptr Lookup) -> IO CString

foreign import ccall unsafe glean_lookup_starting_id
  :: Ptr Lookup -> Ptr Fid -> IO CString
foreign import ccall unsafe glean_lookup_first_free_id
  :: Ptr Lookup -> Ptr Fid -> IO CString

foreign import ccall safe glean_lookup_fact
  :: Ptr Lookup
  -> Fid
  -> Ptr Int64
  -> Ptr (Ptr ())
  -> Ptr CSize
  -> Ptr (Ptr ())
  -> Ptr CSize
  -> IO CString