{-
  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.Database.Ownership
  ( factOwnership
  , OwnerExpr(..)
  ) where

import Control.Exception
import Data.ByteString (ByteString)
import Data.Coerce
import Data.Maybe
import qualified Data.Vector.Storable as Vector
import Data.Word

import Util.STM

import Glean.Database.Open
import Glean.Database.Storage as Storage
import Glean.Database.Types
import Glean.RTS.Foreign.Ownership
import Glean.RTS.Types
import Glean.Types

data OwnerExpr
  = Unit ByteString
  | AndOwners [OwnerExpr]
  | OrOwners [OwnerExpr]
  deriving Show

-- | Return the 'OwnerExpr' for a fact, if it has one. This is only for
-- introspection in the shell, and for tests.
factOwnership
  :: Env
  -> Repo
  -> Fid
  -> IO (Maybe OwnerExpr)
factOwnership env repo fid = do
  maybeSet <- readDatabase env repo $ \_ lookup -> getFactOwner lookup fid
  stack <- withOpenDatabaseStack env repo $ \OpenDB{..} -> do
    ownership <- readTVarIO odbOwnership
    return (ownership, Storage.getUnit odbHandle)
  let
    ownerships = mapMaybe fst stack

    getUnit unitId [] = getUset (coerce unitId) ownerships
    getUnit unitId (getUnitDB : rest) = do
      maybeUnit <- getUnitDB unitId
      case maybeUnit of
        Just unit -> return (Unit unit)
        Nothing -> getUnit unitId rest

    getUset usetId [] = throwIO $ ErrorCall $
      "unknown UsetId: " <> show (coerce usetId :: Word32)
    getUset usetId (own : owns) = do
      maybeExpr <- getOwnershipSet own usetId
      case maybeExpr of
        Nothing -> getUset usetId owns
        Just (op, vec) -> do
          contents <- mapM unpackSet (Vector.toList vec)
          case op of
            And -> return (AndOwners contents)
            Or -> return (OrOwners contents)

    unpackSet :: UsetId -> IO OwnerExpr
    unpackSet usetId = getUnit (coerce usetId) (map snd stack)

  mapM unpackSet maybeSet