{-
  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 (ReportFlag
ReportFlag -> ReportFlag -> Bounded ReportFlag
forall a. a -> a -> Bounded a
$cminBound :: ReportFlag
minBound :: ReportFlag
$cmaxBound :: ReportFlag
maxBound :: ReportFlag
Bounded, Int -> ReportFlag
ReportFlag -> Int
ReportFlag -> [ReportFlag]
ReportFlag -> ReportFlag
ReportFlag -> ReportFlag -> [ReportFlag]
ReportFlag -> ReportFlag -> ReportFlag -> [ReportFlag]
(ReportFlag -> ReportFlag)
-> (ReportFlag -> ReportFlag)
-> (Int -> ReportFlag)
-> (ReportFlag -> Int)
-> (ReportFlag -> [ReportFlag])
-> (ReportFlag -> ReportFlag -> [ReportFlag])
-> (ReportFlag -> ReportFlag -> [ReportFlag])
-> (ReportFlag -> ReportFlag -> ReportFlag -> [ReportFlag])
-> Enum ReportFlag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ReportFlag -> ReportFlag
succ :: ReportFlag -> ReportFlag
$cpred :: ReportFlag -> ReportFlag
pred :: ReportFlag -> ReportFlag
$ctoEnum :: Int -> ReportFlag
toEnum :: Int -> ReportFlag
$cfromEnum :: ReportFlag -> Int
fromEnum :: ReportFlag -> Int
$cenumFrom :: ReportFlag -> [ReportFlag]
enumFrom :: ReportFlag -> [ReportFlag]
$cenumFromThen :: ReportFlag -> ReportFlag -> [ReportFlag]
enumFromThen :: ReportFlag -> ReportFlag -> [ReportFlag]
$cenumFromTo :: ReportFlag -> ReportFlag -> [ReportFlag]
enumFromTo :: ReportFlag -> ReportFlag -> [ReportFlag]
$cenumFromThenTo :: ReportFlag -> ReportFlag -> ReportFlag -> [ReportFlag]
enumFromThenTo :: ReportFlag -> ReportFlag -> ReportFlag -> [ReportFlag]
Enum, ReportFlag -> ReportFlag -> Bool
(ReportFlag -> ReportFlag -> Bool)
-> (ReportFlag -> ReportFlag -> Bool) -> Eq ReportFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReportFlag -> ReportFlag -> Bool
== :: ReportFlag -> ReportFlag -> Bool
$c/= :: ReportFlag -> ReportFlag -> Bool
/= :: ReportFlag -> ReportFlag -> Bool
Eq, Int -> ReportFlag -> ShowS
[ReportFlag] -> ShowS
ReportFlag -> String
(Int -> ReportFlag -> ShowS)
-> (ReportFlag -> String)
-> ([ReportFlag] -> ShowS)
-> Show ReportFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReportFlag -> ShowS
showsPrec :: Int -> ReportFlag -> ShowS
$cshow :: ReportFlag -> String
show :: ReportFlag -> String
$cshowList :: [ReportFlag] -> ShowS
showList :: [ReportFlag] -> ShowS
Show)

profilingDependents :: [ReportFlag]
profilingDependents :: [ReportFlag]
profilingDependents =
  [ ReportFlag
ReportExceptionLabelStack
  , ReportFlag
ReportFetchStack
  ]

newtype ReportFlags = ReportFlags Int

instance Show ReportFlags where
  show :: ReportFlags -> String
show (ReportFlags Int
fs) = String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%0*b" (ReportFlag -> Int
forall a. Enum a => a -> Int
fromEnum ReportFlag
maxReportFlag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
fs
    where
      maxReportFlag :: ReportFlag
maxReportFlag = ReportFlag
forall a. Bounded a => a
maxBound :: ReportFlag

defaultReportFlags :: ReportFlags
defaultReportFlags :: ReportFlags
defaultReportFlags = Int -> ReportFlags
ReportFlags Int
0

profilingReportFlags :: ReportFlags
profilingReportFlags :: ReportFlags
profilingReportFlags = (ReportFlags -> ReportFlag -> ReportFlags)
-> ReportFlags -> [ReportFlag] -> ReportFlags
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((ReportFlag -> ReportFlags -> ReportFlags)
-> ReportFlags -> ReportFlag -> ReportFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReportFlag -> ReportFlags -> ReportFlags
setReportFlag) ReportFlags
defaultReportFlags
  [ ReportFlag
ReportOutgoneFetches
  , ReportFlag
ReportFetchStats
  , ReportFlag
ReportProfiling
  ]

setReportFlag :: ReportFlag -> ReportFlags -> ReportFlags
setReportFlag :: ReportFlag -> ReportFlags -> ReportFlags
setReportFlag ReportFlag
f (ReportFlags Int
fs) =
  Int -> ReportFlags
ReportFlags (Int -> ReportFlags) -> Int -> ReportFlags
forall a b. (a -> b) -> a -> b
$ Int -> Int
setDependencies (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
setBit Int
fs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ReportFlag -> Int
forall a. Enum a => a -> Int
fromEnum ReportFlag
f
  where
    setDependencies :: Int -> Int
setDependencies
      | ReportFlag
f ReportFlag -> [ReportFlag] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ReportFlag]
profilingDependents = (Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
forall a. Bits a => a -> Int -> a
setBit (Int -> Int -> Int) -> Int -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ReportFlag -> Int
forall a. Enum a => a -> Int
fromEnum ReportFlag
ReportProfiling
      | Bool
otherwise = Int -> Int
forall a. a -> a
id

clearReportFlag :: ReportFlag -> ReportFlags -> ReportFlags
clearReportFlag :: ReportFlag -> ReportFlags -> ReportFlags
clearReportFlag ReportFlag
f (ReportFlags Int
fs) =
  Int -> ReportFlags
ReportFlags (Int -> ReportFlags) -> Int -> ReportFlags
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall {b}. Bits b => b -> b
clearDependents (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
clearBit Int
fs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ReportFlag -> Int
forall a. Enum a => a -> Int
fromEnum ReportFlag
f
  where
    clearDependents :: b -> b
clearDependents b
z = case ReportFlag
f of
      ReportFlag
ReportProfiling -> (b -> Int -> b) -> b -> [Int] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> Int -> b
forall a. Bits a => a -> Int -> a
clearBit b
z ([Int] -> b) -> [Int] -> b
forall a b. (a -> b) -> a -> b
$ (ReportFlag -> Int) -> [ReportFlag] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ReportFlag -> Int
forall a. Enum a => a -> Int
fromEnum [ReportFlag]
profilingDependents
      ReportFlag
_ -> b
z

{-# INLINE testReportFlag #-}
testReportFlag :: ReportFlag -> ReportFlags -> Bool
testReportFlag :: ReportFlag -> ReportFlags -> Bool
testReportFlag !ReportFlag
f (ReportFlags !Int
fs) = Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
fs (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ ReportFlag -> Int
forall a. Enum a => a -> Int
fromEnum ReportFlag
f

-- ---------------------------------------------------------------------------
-- Flags

-- | Flags that control the operation of the engine.
data Flags = Flags
  { Flags -> Int
trace :: {-# UNPACK #-} !Int
    -- ^ Tracing level (0 = quiet, 3 = very verbose).
  , Flags -> ReportFlags
report :: {-# UNPACK #-} !ReportFlags
    -- ^ Report flags
  , Flags -> Int
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.
  , Flags -> Int
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
defaultFlags = Flags
  { trace :: Int
trace = Int
0
  , report :: ReportFlags
report = ReportFlags
defaultReportFlags
  , caching :: Int
caching = Int
1
  , recording :: Int
recording = Int
0
  }

-- | Runs an action if the tracing level is above the given threshold.
ifTrace :: Monad m => Flags -> Int -> m a -> m ()
ifTrace :: forall (m :: * -> *) a. Monad m => Flags -> Int -> m a -> m ()
ifTrace Flags
flags Int
i = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Flags -> Int
trace Flags
flags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i) (m () -> m ()) -> (m a -> m ()) -> m a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void

-- | Runs an action if the ReportFlag is set.
ifReport :: Monad m => Flags -> ReportFlag -> m a -> m ()
ifReport :: forall (m :: * -> *) a.
Monad m =>
Flags -> ReportFlag -> m a -> m ()
ifReport Flags
flags ReportFlag
i = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ReportFlag -> ReportFlags -> Bool
testReportFlag ReportFlag
i (ReportFlags -> Bool) -> ReportFlags -> Bool
forall a b. (a -> b) -> a -> b
$ Flags -> ReportFlags
report Flags
flags) (m () -> m ()) -> (m a -> m ()) -> m a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void

ifProfiling :: Monad m => Flags -> m a -> m ()
ifProfiling :: forall (m :: * -> *) a. Monad m => Flags -> m a -> m ()
ifProfiling Flags
flags = Flags -> ReportFlag -> m a -> m ()
forall (m :: * -> *) a.
Monad m =>
Flags -> ReportFlag -> m a -> m ()
ifReport Flags
flags ReportFlag
ReportProfiling