module GHC.Debug.Types.Version where

import Data.Word
import Data.Maybe (isJust)

data ProfilingMode
  = NoProfiling -- ^ We are running profiled code but not doing any profiling right now
  | RetainerProfiling
  | LDVProfiling
  | EraProfiling
  | OtherProfiling
  deriving (ProfilingMode -> ProfilingMode -> Bool
(ProfilingMode -> ProfilingMode -> Bool)
-> (ProfilingMode -> ProfilingMode -> Bool) -> Eq ProfilingMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProfilingMode -> ProfilingMode -> Bool
== :: ProfilingMode -> ProfilingMode -> Bool
$c/= :: ProfilingMode -> ProfilingMode -> Bool
/= :: ProfilingMode -> ProfilingMode -> Bool
Eq, Eq ProfilingMode
Eq ProfilingMode
-> (ProfilingMode -> ProfilingMode -> Ordering)
-> (ProfilingMode -> ProfilingMode -> Bool)
-> (ProfilingMode -> ProfilingMode -> Bool)
-> (ProfilingMode -> ProfilingMode -> Bool)
-> (ProfilingMode -> ProfilingMode -> Bool)
-> (ProfilingMode -> ProfilingMode -> ProfilingMode)
-> (ProfilingMode -> ProfilingMode -> ProfilingMode)
-> Ord ProfilingMode
ProfilingMode -> ProfilingMode -> Bool
ProfilingMode -> ProfilingMode -> Ordering
ProfilingMode -> ProfilingMode -> ProfilingMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ProfilingMode -> ProfilingMode -> Ordering
compare :: ProfilingMode -> ProfilingMode -> Ordering
$c< :: ProfilingMode -> ProfilingMode -> Bool
< :: ProfilingMode -> ProfilingMode -> Bool
$c<= :: ProfilingMode -> ProfilingMode -> Bool
<= :: ProfilingMode -> ProfilingMode -> Bool
$c> :: ProfilingMode -> ProfilingMode -> Bool
> :: ProfilingMode -> ProfilingMode -> Bool
$c>= :: ProfilingMode -> ProfilingMode -> Bool
>= :: ProfilingMode -> ProfilingMode -> Bool
$cmax :: ProfilingMode -> ProfilingMode -> ProfilingMode
max :: ProfilingMode -> ProfilingMode -> ProfilingMode
$cmin :: ProfilingMode -> ProfilingMode -> ProfilingMode
min :: ProfilingMode -> ProfilingMode -> ProfilingMode
Ord, Int -> ProfilingMode -> ShowS
[ProfilingMode] -> ShowS
ProfilingMode -> String
(Int -> ProfilingMode -> ShowS)
-> (ProfilingMode -> String)
-> ([ProfilingMode] -> ShowS)
-> Show ProfilingMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProfilingMode -> ShowS
showsPrec :: Int -> ProfilingMode -> ShowS
$cshow :: ProfilingMode -> String
show :: ProfilingMode -> String
$cshowList :: [ProfilingMode] -> ShowS
showList :: [ProfilingMode] -> ShowS
Show, Int -> ProfilingMode
ProfilingMode -> Int
ProfilingMode -> [ProfilingMode]
ProfilingMode -> ProfilingMode
ProfilingMode -> ProfilingMode -> [ProfilingMode]
ProfilingMode -> ProfilingMode -> ProfilingMode -> [ProfilingMode]
(ProfilingMode -> ProfilingMode)
-> (ProfilingMode -> ProfilingMode)
-> (Int -> ProfilingMode)
-> (ProfilingMode -> Int)
-> (ProfilingMode -> [ProfilingMode])
-> (ProfilingMode -> ProfilingMode -> [ProfilingMode])
-> (ProfilingMode -> ProfilingMode -> [ProfilingMode])
-> (ProfilingMode
    -> ProfilingMode -> ProfilingMode -> [ProfilingMode])
-> Enum ProfilingMode
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 :: ProfilingMode -> ProfilingMode
succ :: ProfilingMode -> ProfilingMode
$cpred :: ProfilingMode -> ProfilingMode
pred :: ProfilingMode -> ProfilingMode
$ctoEnum :: Int -> ProfilingMode
toEnum :: Int -> ProfilingMode
$cfromEnum :: ProfilingMode -> Int
fromEnum :: ProfilingMode -> Int
$cenumFrom :: ProfilingMode -> [ProfilingMode]
enumFrom :: ProfilingMode -> [ProfilingMode]
$cenumFromThen :: ProfilingMode -> ProfilingMode -> [ProfilingMode]
enumFromThen :: ProfilingMode -> ProfilingMode -> [ProfilingMode]
$cenumFromTo :: ProfilingMode -> ProfilingMode -> [ProfilingMode]
enumFromTo :: ProfilingMode -> ProfilingMode -> [ProfilingMode]
$cenumFromThenTo :: ProfilingMode -> ProfilingMode -> ProfilingMode -> [ProfilingMode]
enumFromThenTo :: ProfilingMode -> ProfilingMode -> ProfilingMode -> [ProfilingMode]
Enum)

data Version = Version { Version -> Word32
v_major :: Word32
                       , Version -> Word32
v_patch :: Word32
                       , Version -> Maybe ProfilingMode
v_profiling :: Maybe ProfilingMode
                       , Version -> Bool
v_tntc :: Bool
                       } deriving (Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Version -> ShowS
showsPrec :: Int -> Version -> ShowS
$cshow :: Version -> String
show :: Version -> String
$cshowList :: [Version] -> ShowS
showList :: [Version] -> ShowS
Show, Eq Version
Eq Version
-> (Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Version -> Version -> Ordering
compare :: Version -> Version -> Ordering
$c< :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
>= :: Version -> Version -> Bool
$cmax :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
min :: Version -> Version -> Version
Ord, Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: Version -> Version -> Bool
Eq)

isProfiledRTS :: Version -> Bool
isProfiledRTS :: Version -> Bool
isProfiledRTS = Maybe ProfilingMode -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ProfilingMode -> Bool)
-> (Version -> Maybe ProfilingMode) -> Version -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Maybe ProfilingMode
v_profiling