initial commit [WIP]HEADni/mastermaster

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