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 BangPatterns #-}
  
  -- |
  -- The 'Flags' type and related functions.  This module is provided
  -- for access to Haxl internals only; most users should import
  -- "Haxl.Core" instead.
  --
  module Haxl.Core.Flags
    (
      -- * Report flags
      ReportFlag(..)
    , ReportFlags
    , defaultReportFlags
    , profilingReportFlags
    , setReportFlag
    , clearReportFlag
    , testReportFlag
      -- * Flags
    , Flags(..)
    , defaultFlags
    , ifTrace
    , ifReport
    , ifProfiling
    ) where
  
  import Control.Monad
  import Data.Bits
  import Data.List (foldl')
  import Text.Printf (printf)
  
  -- ---------------------------------------------------------------------------
  -- ReportFlags
  data ReportFlag
    = ReportOutgoneFetches  -- ^ outgone fetches, for debugging eg: timeouts
    | ReportFetchStats  -- ^ data fetch stats & errors
    | ReportProfiling   -- ^ enabling label stack and profiling
    | ReportExceptionLabelStack  -- ^ include label stack in HaxlException
    | ReportFetchStack  -- ^ log cost-center stack traces of dataFetch calls
    deriving (Bounded, Enum, Eq, Show)
  
  profilingDependents :: [ReportFlag]
  profilingDependents =
    [ ReportExceptionLabelStack
    , ReportFetchStack
    ]
  
  newtype ReportFlags = ReportFlags Int
  
  instance Show ReportFlags where
    show (ReportFlags fs) = printf "%0*b" (fromEnum maxReportFlag + 1) fs
      where
        maxReportFlag = maxBound :: ReportFlag
  
  defaultReportFlags :: ReportFlags
  defaultReportFlags = ReportFlags 0
  
  profilingReportFlags :: ReportFlags
  profilingReportFlags = foldl' (flip setReportFlag) defaultReportFlags
    [ ReportOutgoneFetches
    , ReportFetchStats
    , ReportProfiling
    ]
  
  setReportFlag :: ReportFlag -> ReportFlags -> ReportFlags
  setReportFlag f (ReportFlags fs) =
    ReportFlags $ setDependencies $ setBit fs $ fromEnum f
    where
      setDependencies
        | f `elem` profilingDependents = flip setBit $ fromEnum ReportProfiling
        | otherwise = id
  
  clearReportFlag :: ReportFlag -> ReportFlags -> ReportFlags
  clearReportFlag f (ReportFlags fs) =
    ReportFlags $ clearDependents $ clearBit fs $ fromEnum f
    where
      clearDependents z = case f of
        ReportProfiling -> foldl' clearBit z $ map fromEnum profilingDependents
        _ -> z
  
  {-# INLINE testReportFlag #-}
  testReportFlag :: ReportFlag -> ReportFlags -> Bool
  testReportFlag !f (ReportFlags !fs) = testBit fs $ fromEnum f
  
  -- ---------------------------------------------------------------------------
  -- Flags
  
  -- | Flags that control the operation of the engine.
  data Flags = Flags
    { trace :: {-# UNPACK #-} !Int
      -- ^ Tracing level (0 = quiet, 3 = very verbose).
    , report :: {-# UNPACK #-} !ReportFlags
      -- ^ Report flags
    , caching :: {-# UNPACK #-} !Int
      -- ^ Non-zero if caching is enabled.  If caching is disabled, then
      -- we still do batching and de-duplication, but do not cache
      -- results.
    , recording :: {-# UNPACK #-} !Int
      -- ^ Non-zero if recording is enabled. This allows tests to record cache
      -- calls for datasources by making uncachedRequest behave like dataFetch
    }
  
  defaultFlags :: Flags
  defaultFlags = Flags
    { trace = 0
    , report = defaultReportFlags
    , caching = 1
    , recording = 0
    }
  
  -- | Runs an action if the tracing level is above the given threshold.
  ifTrace :: Monad m => Flags -> Int -> m a -> m ()
  ifTrace flags i = when (trace flags >= i) . void
  
  -- | Runs an action if the ReportFlag is set.
  ifReport :: Monad m => Flags -> ReportFlag -> m a -> m ()
  ifReport flags i = when (testReportFlag i $ report flags) . void
  
  ifProfiling :: Monad m => Flags -> m a -> m ()
  ifProfiling flags = ifReport flags ReportProfiling
  