Fact.hs

{-
  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.Typed.Fact
  ( decodeFact
  , decodeRef
  ) where

import Control.Exception
import Control.Monad.IO.Class
import Data.Dynamic
import qualified Data.IntMap as IntMap
import Data.IORef
import Data.IntMap (IntMap)

import Glean.Typed.Build
import Glean.Typed.Binary
import Glean.Typed.Id
import Glean.Typed.Predicate
import Glean.Types as Thrift

-- | Decode a serialized fact, possibly with nested facts
decodeFact
  :: (Predicate p, MonadIO m)
  => IntMap Thrift.Fact               -- ^ serialized nested facts
  -> IORef (IntMap Dynamic)           -- ^ cached deserialized facts
  -> IdOf p                           -- ^ Id of fact to decode
  -> Thrift.Fact                      -- ^ fact to decode
  -> m p
{-# INLINE decodeFact #-}
decodeFact serialized cache fid (Thrift.Fact _pid k v) = mkFact fid
  <$> (Just <$> decodeWithCache serialized cache decodeRtsValue k)
  <*> (Just <$> case constantRtsValue of
    Just val -> return val
    Nothing -> decodeWithCache serialized cache decodeRtsValue v)

-- | Decode a fact reference inside a fact.
--
-- * If the nested fact is in the cache, then return it
-- * If the serialized fact is available, we decode it and add it to the cache
-- * Otherwise, we simply construct the empty fact with 'justId'.
--
decodeRef
  :: forall p. (Predicate p, Typeable p)
  => Decoder p
decodeRef = Decoder $ \env@DecoderEnv{..} -> do
  (fid :: IdOf p) <- runDecoder decodeRtsValue env
  cache <- liftIO $ readIORef cacheRef
  let id = fromIntegral (fromFid (idOf fid))
  case IntMap.lookup id cache of
    Just dyn
      | Just p <- fromDynamic dyn -> return p
      | otherwise -> liftIO $ throwIO $ ErrorCall "decodeRef: wrong type"
    Nothing -> do
      case IntMap.lookup id serialized of
        Nothing -> return (justId fid)
        Just fact -> do
          f <- decodeFact serialized cacheRef fid fact
          liftIO $ modifyIORef' cacheRef $ \cache ->
            IntMap.insert id (toDyn f) cache
          return f