{-
  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.Define
  ( Define(..)
  , CanDefine(..)
  , InvalidRedefinition(..)
  , DefineFlags(..)
  , defineFact
  , defineBatch
  ) where

import Control.Exception
import Control.Monad
import Data.Default
import Data.Typeable
import qualified Data.Vector.Storable as VS
import Foreign.C.String
import Foreign.C.Types
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Utils (fromBool)

import Util.FFI

import Glean.FFI
import Glean.RTS.Builder
import Glean.RTS.Foreign.Inventory (Inventory)
import Glean.RTS.Foreign.Subst (Subst)
import Glean.RTS.Types (Fid(..), Pid(..), invalidFid)
import qualified Glean.Types as Thrift
import Glean.Util.Vector

-- | A reference to a thing we can define facts in
newtype Define = Define (Ptr Define)
  deriving(Storable)

-- | Class of things we can define facts in
class CanDefine a where
  withDefine :: a -> (Define -> IO b) -> IO b

instance CanDefine Define where
  withDefine l f = f l

newtype InvalidRedefinition = InvalidRedefinition String
  deriving(Show, Typeable)

instance Exception InvalidRedefinition

defineFact :: CanDefine a => a -> Pid -> Builder -> CSize -> IO Fid
defineFact facts pred clause key_size =
  withDefine facts $ \facts_ptr -> do
    id <- invoke $ glean_define_fact facts_ptr pred clause key_size
    when (id == invalidFid) $
      throwIO $ InvalidRedefinition "invalid fact redefinition"
    return id

data DefineFlags = DefineFlags
  { trustRefs :: Bool
    -- ^ Whether to trust that fact references have the right type.
    -- If the facts have already been typechecked then this can be set
    -- to True to improve performance.
  , ignoreRedef :: Bool
    -- ^ When True, if we see a redefinition of a key/value fact where
    -- the value is different, just discard the fact. When False,
    -- redefinition is an error. Redefinition may safely arise in
    -- cases where we have a cache of remote facts and the values have
    -- been rebased with respect to different caches: the values may
    -- be literally different but semantically identical.
  }

instance Default DefineFlags where
  def = DefineFlags
    { trustRefs = False
    , ignoreRedef = False
    }

-- Prepare a Thrift batch for writing into the database by renaming and
-- deduplicating facts.
defineBatch
  :: CanDefine a
  => a                  -- ^ where to define facts
  -> Inventory          -- ^ inventory
  -> Thrift.Batch       -- ^ batch to rename
  -> DefineFlags        -- ^ flags
  -> IO Subst           -- ^ resulting substitution
defineBatch facts inventory batch DefineFlags{..} =
  withDefine facts $ \p_facts ->
  with inventory $ \p_inventory ->
  withIds $ \ids_ptr ->
  unsafeWithBytes (Thrift.batch_facts batch) $ \facts_ptr facts_size ->
    construct $ invoke $ glean_define_batch
      p_facts
      p_inventory
      (Fid $ Thrift.batch_firstId batch)
      ids_ptr
      (fromIntegral $ Thrift.batch_count batch)
      facts_ptr
      facts_size
      (fromBool trustRefs)
      (fromBool ignoreRedef)
  where
    withIds f
      | Just ids <- Thrift.batch_ids batch =
          if fromIntegral (VS.length ids) == Thrift.batch_count batch
            then VS.unsafeWith (unsafeCoerceVector ids) f
            else throwIO $
              Thrift.Exception "mismatch between count and ids.size in batch"
      | otherwise = f nullPtr

foreign import ccall unsafe glean_define_fact
  :: Define
  -> Pid
  -> Builder
  -> CSize
  -> Ptr Fid
  -> IO CString

foreign import ccall safe glean_define_batch
  :: Define
  -> Ptr Inventory
  -> Fid
  -> Ptr Fid
  -> CSize
  -> Ptr ()
  -> CSize
  -> CBool
  -> CBool
  -> Ptr (Ptr Subst)
  -> IO CString