content: {-
    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.
  -}
  
  {-# LANGUAGE ForeignFunctionInterface #-}
  
  module Util.GFlags
    ( FlagException(..)
    , getFlagValue
    , setFlagDefault
    , setFlagValue
    , setFlagValueIfDefault
    , withFlagSaver
    ) where
  
  import Control.Exception
  import Data.Text (Text)
  import Foreign.C
  import Foreign.Ptr
  import Foreign.Storable
  
  import Foreign.CPP.HsStruct
  import qualified Util.Text as Text
  
  --  export
  
  data FlagException = FlagException Text deriving (Eq, Show)
  instance Exception FlagException
  
  getFlagValue :: Text -> IO (Either FlagException Text)
  getFlagValue k = do
    Text.useTextAsCString k $ \ ck -> do
    withHsText $ \ out -> do
    c_get_flag_value ck out >>= \ case
      0 -> Left <$> pure (FlagException k)
      _ -> Right <$> hsText <$> peek out
  
  setFlagDefault :: Text -> Text -> IO (Either FlagException ())
  setFlagDefault = resultOfWithCStringKV c_set_flag_default
  
  setFlagValue :: Text -> Text -> IO (Either FlagException ())
  setFlagValue = resultOfWithCStringKV c_set_flag_value
  
  setFlagValueIfDefault :: Text -> Text -> IO (Either FlagException ())
  setFlagValueIfDefault = resultOfWithCStringKV c_set_flag_value_if_default
  
  withFlagSaver :: IO a -> IO a
  withFlagSaver = bracketConst c_flag_saver_create c_flag_saver_delete
  
  --  utility
  
  data FlagSaver -- C++ gflags::FlagSaver
  
  withHsText :: (Ptr HsText -> IO a) -> IO a
  withHsText = bracket c_hs_string_create c_hs_string_delete
  
  resultOfWithCStringKV
    :: (CString -> CString -> IO CInt) -> Text -> Text
    -> IO (Either FlagException ())
  resultOfWithCStringKV cb k v = result k <$> withCStringKV k v cb
  
  withCStringKV :: Text -> Text -> (CString -> CString -> IO a) -> IO a
  withCStringKV k v cb = do
    Text.useTextAsCString k $ \ ck -> do
    Text.useTextAsCString v $ \ cv -> do
    cb ck cv
  
  result :: Text -> CInt -> Either FlagException ()
  result k 0 = Left (FlagException k)
  result _ _ = Right ()
  
  bracketConst :: IO a -> (a -> IO b) -> IO c -> IO c
  bracketConst before after = bracket before after . const
  
  --  ffi
  
  foreign import ccall unsafe
    "facebook_gflags_hs_set_flag_default"
    c_set_flag_default :: CString -> CString -> IO CInt
  
  foreign import ccall unsafe
    "facebook_gflags_hs_set_flag_value"
    c_set_flag_value :: CString -> CString -> IO CInt
  
  foreign import ccall unsafe
    "facebook_gflags_hs_set_flag_value_if_default"
    c_set_flag_value_if_default :: CString -> CString -> IO CInt
  
  foreign import ccall unsafe
    "facebook_gflags_hs_get_flag_value"
    c_get_flag_value :: CString -> Ptr HsText -> IO CInt
  
  foreign import ccall unsafe
    "facebook_gflags_hs_flag_saver_create"
    c_flag_saver_create :: IO (Ptr FlagSaver)
  
  foreign import ccall unsafe
    "facebook_gflags_hs_flag_saver_delete"
    c_flag_saver_delete :: Ptr FlagSaver -> IO ()
  
  foreign import ccall unsafe
    "facebook_gflags_hs_hs_string_create"
    c_hs_string_create :: IO (Ptr HsText)
  
  foreign import ccall unsafe
    "facebook_gflags_hs_hs_string_delete"
    c_hs_string_delete :: Ptr HsText -> IO ()
  