Skip to content
Snippets Groups Projects
Verified Commit f35c557d authored by Legy (Beini)'s avatar Legy (Beini)
Browse files

Improve the Importance type to have its own constructors for different levels

parent 309f3078
No related branches found
No related tags found
No related merge requests found
......@@ -40,11 +40,13 @@ data BlockTextSegment = BlockTextSegment {
}
deriving (Eq, Show)
type Importance = Float
data Importance = NormalImportant Float | WarnImportant Float | ErrorImportant Float | CriticalImportant Float
deriving (Eq, Show)
$(deriveJSON defaultOptions ''BlockOutput)
makeLenses ''BlockOutput
$(deriveJSON defaultOptions ''Importance)
$(deriveJSON defaultOptions ''BlockTextSegment)
$(deriveJSON defaultOptions ''BlockText)
......@@ -76,67 +78,68 @@ addIcon icon = over fullText $ (<>) . normalText $ icon <> " "
normalImportant :: Importance
normalImportant = 1
normalImportant = NormalImportant 0.5
normalImportant' :: Float -> Importance
normalImportant' = NormalImportant . min 1 . max 0
warnImportant :: Importance
warnImportant = 2
warnImportant = WarnImportant 0.5
warnImportant' :: Float -> Importance
warnImportant' = WarnImportant . min 1 . max 0
errorImportant :: Importance
errorImportant = 3
errorImportant = ErrorImportant 0.5
errorImportant' :: Float -> Importance
errorImportant' = ErrorImportant . min 1 . max 0
criticalImportant :: Importance
criticalImportant = 4
criticalImportant = CriticalImportant 0.5
criticalImportant' :: Float -> Importance
criticalImportant' = CriticalImportant . min 1 . max 0
isCritical :: Importance -> Bool
isCritical i
| i >= criticalImportant = True
| otherwise = False
isCritical (CriticalImportant _) = True
isCritical _ = False
isError :: Importance -> Bool
isError i
| isCritical i = False
| i >= errorImportant = True
| otherwise = False
isError (ErrorImportant _) = True
isError _ = False
isWarning :: Importance -> Bool
isWarning i
| isCritical i = False
| isError i = False
| i >= warnImportant = True
| otherwise = False
isWarning (WarnImportant _) = True
isWarning _ = False
isNormal :: Importance -> Bool
isNormal i
| isCritical i = False
| isError i = False
| isWarning i = False
| otherwise = True
toImportance :: Real a => (a, a, a, a, a, a) -> a -> Importance
toImportance (tMax, tCritical, tError, tWarning, tNormal, tMinimal) =
toImportance' (Just tMax, tCritical, tError, tWarning, tNormal, Just tMinimal)
toImportance' :: forall a. Real a => (Maybe a, a, a, a, a, Maybe a) -> a -> Importance
toImportance' (tMax, tCritical, tError, tWarning, tNormal, tMinimal) val
| tCritical <= val = 4 + valueCritical tMax tCritical val
| tError <= val = 3 + linearMatch tCritical tError val
| tWarning <= val = 2 + linearMatch tError tWarning val
| tNormal <= val = 1 + linearMatch tWarning tNormal val
| otherwise = 0 + valueOtherwise tNormal tMinimal val
isNormal (NormalImportant _) = True
isNormal _ = False
toImportance :: Real a => (a, a, a, a, a) -> a -> Importance
toImportance (tMin, tWarning, tError, tCritical, tMax) =
toImportance' (Just tMin, tWarning, tError, tCritical, Just tMax)
toImportance' :: Real a => (Maybe a, a, a, a, Maybe a) -> a -> Importance
toImportance' (tMin, tWarning, tError, tCritical, tMax) val
| tCritical <= val = criticalImportant' valueCritical
| tError <= val = errorImportant' $ linearMatch tCritical tError val
| tWarning <= val = warnImportant' $ linearMatch tError tWarning val
| otherwise = normalImportant' valueNormal
where
e :: Importance
e = exp 1
linearMatch :: a -> a -> a -> Importance
linearMatch u l v = frac (v - l) (u - l)
logarithmicMatch :: a -> a -> Importance
logarithmicMatch l u = 1 - 1 / log (e + realToFrac (u - l))
frac :: a -> a -> Importance
frac a b = realToFrac a / realToFrac b
valueCritical :: Maybe a -> a -> a -> Importance
valueCritical (Just tMax') tCritical' v
| tMax' > v = linearMatch tMax' tCritical' v
| otherwise = 1
valueCritical Nothing tCritical' v = logarithmicMatch tCritical' v
valueOtherwise :: a -> Maybe a -> a -> Importance
valueOtherwise tNormal' (Just tMinimal') v
| tMinimal' < v = linearMatch tNormal' tMinimal' v
| otherwise = 0
valueOtherwise tNormal' Nothing v = 1 - logarithmicMatch v tNormal'
linearMatch :: Real a => a -> a -> a -> Float
linearMatch u l v = realToFrac (v - l) / realToFrac (u - l)
logarithmicMatch :: Real a => a -> a -> Float
logarithmicMatch l u = (\x -> 1 - 1 / (1 + x)) . log . realToFrac $ u - l
valueCritical :: Float
valueCritical = case tMax of
Just tMax' -> if tMax' > val then linearMatch tMax' tCritical val else 1
Nothing -> logarithmicMatch tCritical val
valueNormal :: Float
valueNormal = case tMin of
Just tMin' -> if tMin' < val then linearMatch tWarning tMin' val else 0
Nothing -> 1 - logarithmicMatch val tWarning
invalidateBlock :: BlockOutput -> BlockOutput
invalidateBlock block@BlockOutput{ _fullText, _shortText } = block {
......
......@@ -141,7 +141,7 @@ updateBatteryBlock isPlugged bs = sendBlockUpdate $ (shortText.~shortText') $ mk
batteryImportance :: [BatteryState] -> Importance
batteryImportance = toImportance (100, 90, 80, 60, 50, 0) . (100-) . batteryPercentage
batteryImportance = toImportance (0, 60, 80, 90, 100) . (100 -) . batteryPercentage
batteryPercentage :: [BatteryState] -> Float
......
......@@ -128,7 +128,7 @@ cpuUsageBlock decimalPlaces = pullBlock $ evalStateT cpuUsageBlock' createState
_lastCpuUsage = 0
}
cpuUsageImportance :: Monad m => StateT CpuBlockState m Importance
cpuUsageImportance = toImportance (100, 90, 80, 60, 50, 0) <$> use lastCpuUsage
cpuUsageImportance = toImportance (0, 60, 80, 90 ,100) <$> use lastCpuUsage
cpuUsageTextWidth :: Num a => a
cpuUsageTextWidth
| decimalPlaces == 0 = 3
......
......@@ -122,15 +122,14 @@ defaultTheme :: Theme
defaultTheme = mkTheme defaultTheme'
where
defaultTheme' :: SimplifiedTheme
defaultTheme' active importance
| isCritical importance, active = (ColorRGB (RGB 0 0 0), Just $ ColorRGB (RGB 1 0 0))
| isCritical importance = (ColorRGB (RGB 0.8 0.15 0.15), Nothing)
| isError importance, active = (ColorRGB (RGB 1 0.3 0), Nothing)
| isError importance = (ColorRGB (RGB 0.7 0.35 0.2), Nothing)
| isWarning importance,active = (ColorRGB (RGB 1 0.9 0), Nothing)
| isWarning importance = (ColorRGB (RGB 0.6 0.6 0), Nothing)
| otherwise, active = (ColorRGB (RGB 1 1 1), Nothing)
| otherwise = (ColorRGB (RGB (0x96 / 255) (0x98 / 255) (0x96 / 255)), Nothing)
defaultTheme' True (CriticalImportant _) = (ColorRGB (RGB 0 0 0), Just $ ColorRGB (RGB 1 0 0))
defaultTheme' False (CriticalImportant _) = (ColorRGB (RGB 0.8 0.15 0.15), Nothing)
defaultTheme' True (ErrorImportant _) = (ColorRGB (RGB 1 0.3 0), Nothing)
defaultTheme' False (ErrorImportant _) = (ColorRGB (RGB 0.7 0.35 0.2), Nothing)
defaultTheme' True (WarnImportant _) = (ColorRGB (RGB 1 0.9 0), Nothing)
defaultTheme' False (WarnImportant _) = (ColorRGB (RGB 0.6 0.6 0), Nothing)
defaultTheme' True (NormalImportant _) = (ColorRGB (RGB 1 1 1), Nothing)
defaultTheme' False (NormalImportant _) = (ColorRGB (RGB (0x96 / 255) (0x98 / 255) (0x96 / 255)), Nothing)
rainbowTheme :: Theme
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment