diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | Makefile | 6 | ||||
| -rw-r--r-- | Parser.hs | 26 | ||||
| -rw-r--r-- | q.cabal | 11 | ||||
| -rw-r--r-- | test1.hs | 138 | ||||
| -rw-r--r-- | test2.hs | 118 |
6 files changed, 301 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..974d6d6 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +/.graveyard +/shell.nix diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..29fc3ca --- /dev/null +++ b/Makefile @@ -0,0 +1,6 @@ +.PHONY: ghci +ghci: shell.nix + nix-shell --arg nixpkgs 'import <stockholm>' --command 'exec ghci -Wall' + +shell.nix: $(wildcard *.cabal) + cabal2nix --shell . > $@ diff --git a/Parser.hs b/Parser.hs new file mode 100644 index 0000000..be42375 --- /dev/null +++ b/Parser.hs @@ -0,0 +1,26 @@ +module Parser + ( module Export + , decimal + , ueventFile + ) where + +import qualified Text.Megaparsec.Lexer as Lexer +import Text.Megaparsec as Export (parse, parseMaybe) +import Text.Megaparsec.String as Export (Parser) + +import Data.Map (Map); import qualified Data.Map as Map +import Text.Megaparsec + + +decimal :: Parser Integer +decimal = Lexer.decimal + +ueventFile :: Parser (Map String String) +ueventFile = + Map.fromList <$> some param + +param :: Parser (String,String) +param = do + k <- someTill anyChar (char '=') + v <- someTill anyChar newline + return (k,v) @@ -0,0 +1,11 @@ +Author: tv +Build-Type: Simple +Cabal-Version: >= 1.2 +License: MIT +Name: q +Version: 1.0.0 + +Executable q + Build-Depends: base, blessings, dimensional, megaparsec, memoize, text + GHC-Options: -Wall -O3 -threaded -rtsopts + Main-Is: test2.hs diff --git a/test1.hs b/test1.hs new file mode 100644 index 0000000..8ecfa36 --- /dev/null +++ b/test1.hs @@ -0,0 +1,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) diff --git a/test2.hs b/test2.hs new file mode 100644 index 0000000..b9572e9 --- /dev/null +++ b/test2.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE DataKinds #-} + +module Main (main) where + +import qualified Prelude +import Control.Applicative +import Data.Maybe +import Data.Map (Map); import qualified Data.Map as Map +import Numeric.Units.Dimensional.Prelude hiding (lookup,showIn) +import Numeric.Units.Dimensional.UnitNames (atom) +import Parser +import System.Environment +import Text.Megaparsec +import Text.Printf + + +main :: IO () +main = do + [p] <- getArgs + parse ueventFile p <$> readFile p >>= either printError printPowerSupply + + +printError :: ParseError (Token String) Dec -> IO () +printError = print . show + + +printPowerSupply :: Map String String -> IO () +printPowerSupply x = do + putStrLn $ "capacity: " ++ showIn percent capacity + putStrLn $ "chargeFull: " ++ showIn (milli ampere * hour) chargeFull + putStrLn $ "chargeNow: " ++ showIn (milli ampere * hour) chargeNow + putStrLn $ "currentNow: " ++ showIn (milli ampere) currentNow + putStrLn $ "energyFull: " ++ showIn (watt * hour) energyFull + putStrLn $ "energyNow: " ++ showIn (watt * hour) energyNow + putStrLn $ "powerNow: " ++ showIn watt powerNow + putStrLn $ "timeRemain: " ++ showHourMinute timeRemain + putStrLn $ "voltageNow: " ++ showIn volt voltageNow + putStrLn $ "voltageMin: " ++ showIn volt voltageMin + where + chargeFull = + fromMaybe (energyFull / voltageMin) + (getQty (micro ampere * hour) "POWER_SUPPLY_CHARGE_FULL" x) + chargeNow = + fromMaybe (energyNow / voltageMin) + (getQty (micro ampere * hour) "POWER_SUPPLY_CHARGE_NOW" x) + currentNow = + fromMaybe (powerNow / voltageNow) + (getQty (micro ampere) "POWER_SUPPLY_CURRENT_NOW" x) + energyFull = + fromMaybe (chargeFull * voltageMin) + (getQty (micro watt * hour) "POWER_SUPPLY_ENERGY_FULL" x) + energyNow = + fromMaybe (chargeNow * voltageMin) + (getQty (micro watt * hour) "POWER_SUPPLY_ENERGY_NOW" x) + powerNow = + fromMaybe (currentNow * voltageNow) + (getQty (micro watt) "POWER_SUPPLY_POWER_NOW" x) + voltageNow = + fromMaybe (error "no voltageNow") + (getQty (micro volt) "POWER_SUPPLY_VOLTAGE_NOW" x) + voltageMin = + fromMaybe (error "no voltageMin") + (getQty (micro volt) "POWER_SUPPLY_VOLTAGE_MIN_DESIGN" x) + capacity = chargeNow / chargeFull + timeRemain = chargeNow / currentNow + + +getQty :: (Ord k, Num a) => + Unit m d a -> k -> Map k String -> Maybe (Quantity d a) +getQty u k x = + (*~ u) . fromIntegral <$> (parseMaybe decimal =<< Map.lookup k x) + + +percent :: Unit 'NonMetric DOne Double +percent = mkUnitQ (atom "%" "%" "percent") (1 Prelude./ 100) one + + +scale :: Double -> Int +scale v + | v == 0 || v >= 100 = 0 + | v >= 10 = 1 + | v >= 1 = 2 + | otherwise = 3 + + +showIn :: Unit m d Double -> Quantity d Double -> String +showIn u q + | isInfinite v = "inf" + | otherwise = printf "%.*f%s" (scale v) v (showUnit u) + where + v = q /~ u :: Double + +showHourMinute :: Quantity DTime Double -> String +showHourMinute q + | isInfinite v = "inf" + | otherwise = printf "%dh%dm" h m + where + (h,hfrac) = properFraction v :: (Integer,Double) + m = round $ 60 Prelude.* hfrac :: Integer + v = q /~ hour :: Double + + +showUnit :: Unit m d a -> String +showUnit = filter (/=' ') . show . name + + +--showBar :: Int -> Double -> String +--showBar 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 |