summaryrefslogtreecommitdiffstats
path: root/test1.hs
blob: 8ecfa361b4fed4d4b7c5ed399a5883219c0db521 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
module Main where

import Blessings
import Control.Applicative
import Data.Map (Map); import qualified Data.Map as Map
import Data.Monoid
import System.Environment
import Text.Megaparsec
import Text.Megaparsec.Lexer
import Text.Megaparsec.String
import Text.Printf

main :: IO ()
main = do
    [ueventPath] <- getArgs
    p <- parse uevent ueventPath <$> readFile ueventPath
    case p of
        Left x -> print x
        Right x ->
            let
                norm = (/10**6) . fromIntegral

                getdec k = norm <$>
                    (Map.lookup k x >>= parseMaybe (decimal :: Parser Integer))

                getstr k =
                    Map.lookup k x

                name = getstr "POWER_SUPPLY_NAME"
                charge_full = getdec "POWER_SUPPLY_CHARGE_FULL"
                charge_now = getdec "POWER_SUPPLY_CHARGE_NOW"
                current_now = getdec "POWER_SUPPLY_CURRENT_NOW"
                energy_full = getdec "POWER_SUPPLY_ENERGY_FULL"
                energy_now = getdec "POWER_SUPPLY_ENERGY_NOW"
                power_now = getdec "POWER_SUPPLY_POWER_NOW"
                voltage_min_design = getdec "POWER_SUPPLY_VOLTAGE_MIN_DESIGN"
                voltage_now = getdec "POWER_SUPPLY_VOLTAGE_NOW"

                capacity =
                    liftA2 (/) chargeNow chargeFull
                    -- as good: liftA2 (/) energyNow energyFull

                chargeFull = charge_full <|>
                    liftA2 (/) energy_full voltage_min_design

                chargeNow = charge_now <|>
                    liftA2 (/) energy_now voltage_min_design

                currentNow = current_now <|>
                    liftA2 (/) power_now voltage_now

                energyFull = energy_full <|>
                    liftA2 (*) charge_full voltage_min_design

                energyNow = energy_now <|>
                    liftA2 (*) charge_now voltage_min_design

                powerNow = power_now <|>
                    liftA2 (*) current_now voltage_now

                timeRemain =
                    liftA2 (/) chargeNow currentNow
                    --liftA2 (/) energyNow powerNow

                voltageMinDesign = voltage_min_design
                voltageNow = voltage_now
            in
              do
                putStrLn $ "name: " <> maybe "?" id name
                putStrLn $ "capacity: " <> maybe "?" pperc capacity
                putStrLn $ "chargeFull: " <> maybe "?" (ppu "Ah") chargeFull
                putStrLn $ "chargeNow: " <> maybe "?" (ppu "Ah") chargeNow
                putStrLn $ "currentNow: " <> maybe "?" (ppu "A") currentNow
                putStrLn $ "energyFull: " <> maybe "?" (ppu "Wh") energyFull
                putStrLn $ "energyNow: " <> maybe "?" (ppu "Wh") energyNow
                putStrLn $ "powerNow: " <> maybe "?" (ppu "W") powerNow
                putStrLn $ "timeRemain: " <> maybe "?" ppt timeRemain
                putStrLn $ "voltageMinDesign: " <> maybe "?" (ppu "V") voltageMinDesign
                putStrLn $ "voltageNow: " <> maybe "?" (ppu "V") voltageNow

                putStrLn $ maybe "?" id name
                    <-> maybe "?" (pbar 10) capacity
                    <-> maybe "?" pperc capacity
                    <-> maybe "?" (ppu "Ah") chargeNow
                        <> "/" <>
                        maybe "?" (ppu "A") currentNow
                    <->
                        maybe "?" (ppu "Wh") energyNow
                        <> "/" <>
                        maybe "?" (ppu "W") powerNow
                    <->
                        maybe "?" ppt timeRemain



(<->) :: String -> String -> String
a <-> b = a <> " " <> b

pperc :: Double -> String
pperc x = ppu "%" (100 * x)

ppu :: String -> Double -> String
ppu unit x =
  printf "%.2f" x ++ unit

ppt :: Double -> String
ppt t
    | isInfinite t = "inf"
    -- | isNaN t = "NaN"
    -- | isDenormalized t = "denorm"
    -- | isNegativeZero t = "-0"
    | otherwise = show h ++ "h" ++ show m ++ "m"
  where
    h = floor t :: Integer
    m = floor $ (t - fromIntegral h) * 60 :: Integer

pbar :: Int -> Double -> String
pbar n r =
    pp (SGR color (Plain (take t1 (repeat '■'))) <>
        SGR [30] (Plain (take t2 (repeat '■'))))
  where
    color
      | r >= 0.42 = [1,32]
      | r >= 0.23 = [1,33]
      | r >= 0.11 = [1,31]
      | otherwise = [5,1,31]
    t1 = truncate (r * fromIntegral n)
    t2 = n - t1

uevent :: Parser (Map String String)
uevent =
    Map.fromList <$> some param

param :: Parser (String,String)
param = do
    k <- someTill anyChar (char '=')
    v <- someTill anyChar newline
    return (k,v)