summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.gitignore2
-rw-r--r--Makefile6
-rw-r--r--Parser.hs26
-rw-r--r--q.cabal11
-rw-r--r--test1.hs138
-rw-r--r--test2.hs118
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)
diff --git a/q.cabal b/q.cabal
new file mode 100644
index 0000000..9d7f0fa
--- /dev/null
+++ b/q.cabal
@@ -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