posplyu 0.1.0.3 → 0.1.1
raw patch · 3 files changed
+82/−8 lines, 3 filesdep ~time
Dependency ranges changed: time
Files
- Main.hs +11/−3
- ShowTDiff.hs +66/−0
- posplyu.cabal +5/−5
Main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE StrictData #-} module Main where import Control.Concurrent@@ -18,6 +19,8 @@ import System.Posix.Files import System.Process +import ShowTDiff+ pollPeriod = 5000 sleepThreshold = 1800000 @@ -48,7 +51,7 @@ case getOpt Permute options argv of (o,[],[] ) -> do home <- getAppUserDataDirectory "posplyu"- return $ foldl (flip id) (defaultOptions { optDatabaseFile = home ++ "/database" }) o+ return $ foldl' (flip id) (defaultOptions { optDatabaseFile = home ++ "/database" }) o (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options)) where header = "Usage: posplyu" @@ -70,8 +73,13 @@ when (optExpect opts) $ do db <- readDB $ optDatabaseFile opts let sleepOffset = 60 * 60 * 15- time <- utcToLocalZonedTime $ addUTCTime sleepOffset $ last $ head $ filter (not . isNap) $ reverse db- putStrLn $ "Sleepiness expected at " ++ (show time)+ let expectedTime = addUTCTime sleepOffset $ last $ head $ filter (not . isNap) $ reverse db+ expectedLocalTime <- utcToLocalZonedTime expectedTime+ currentTime <- getCurrentTime+ let relTimeS = if expectedTime > currentTime+ then "in " ++ showTDiff (diffUTCTime expectedTime currentTime)+ else showTDiff (diffUTCTime currentTime expectedTime) ++ " ago"+ putStrLn $ "Sleepiness expected at " ++ show expectedLocalTime ++ " (" ++ relTimeS ++ ")" when (not $ or [0 < optEdit opts, optExpect opts, optList opts]) $ do let dirname = intercalate "/" $ init $ split (dropDelims $ whenElt (== '/')) $ optDatabaseFile opts createDirectoryIfMissing True dirname
+ ShowTDiff.hs view
@@ -0,0 +1,66 @@+{-+SBV: SMT Based Verification in Haskell++Copyright (c) 2010-2025, Levent Erkok (erkokl@gmail.com)+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the developer (Levent Erkok) nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL LEVENT ERKOK BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}++module ShowTDiff where++import Data.List (intercalate)+import Data.Ratio+import Data.Time.Clock+import GHC.Real (Ratio((:%)))+import Numeric (showFFloat)++-- | Show 'NominalDiffTime' in human readable form. 'NominalDiffTime' is+-- essentially picoseconds (10^-12 seconds). We show it so that+-- it's represented at the day:hour:minute:second.XXX granularity.+showTDiff :: NominalDiffTime -> String+showTDiff diff+ | denom /= 1 -- Should never happen! But just in case.+ = show diff+ | True+ = intercalate ":" fields+ where total, denom :: Integer+ total :% denom = (picoFactor % 1) * toRational diff++ -- there are 10^12 pico-seconds in a second+ picoFactor :: Integer+ picoFactor = (10 :: Integer) ^ (12 :: Integer)++ (s2p, m2s, h2m, d2h) = case drop 1 $ scanl (*) 1 [picoFactor, 60, 60, 24] of+ (s2pv : m2sv : h2mv : d2hv : _) -> (s2pv, m2sv, h2mv, d2hv)+ _ -> (0, 0, 0, 0) -- won't ever happen++ (days, days') = total `divMod` d2h+ (hours, hours') = days' `divMod` h2m+ (minutes, seconds') = hours' `divMod` m2s+ (seconds, picos) = seconds' `divMod` s2p+ secondsPicos = show seconds+ ++ dropWhile (/= '.') (showFFloat (Just 3) (fromIntegral picos * (10**(-12) :: Double)) "s")++ aboveSeconds = map (\(t, v) -> show v ++ [t]) $ dropWhile (\p -> snd p == 0) [('d', days), ('h', hours), ('m', minutes)]+ fields = aboveSeconds ++ [secondsPicos]
posplyu.cabal view
@@ -1,6 +1,6 @@ name: posplyu -- semver-version: 0.1.0.3+version: 0.1.1 synopsis: Sleep tracker for X11, using XScreenSaver extension and manual input. description: posplyu is a sleep tracker for X11, using XScreenSaver extension and manual input, motivated by http://super-memory.com/articles/sleep.htm and designed to facilitate transitioning to the free running sleep regiment while living mostly with a GNU/Linux system handy. The tool allows you to measure and somewhat predict your sleeping cycle. For now it assumes a 24h cycle with one sleep period. category: Tools@@ -18,17 +18,17 @@ Source-repository this type: git location: https://github.com/l29ah/posplyu.git- tag: 0.1.0.3+ tag: 0.1.1 executable posplyu main-is: Main.hs- -- other-modules:+ other-modules: ShowTDiff -- other-extensions: build-depends: base >= 4.11 && < 5, X11 >= 1.9 && < 1.11, transformers >= 0.5.5.0 && < 0.7,- time >= 1.8.0.2 && < 1.13,+ time >= 1.8.0.2 && < 1.15, split >= 0.2.3.3 && < 0.3, unix >= 2.7.2.2 && < 2.9, process >= 1.6.3.0 && < 1.7,@@ -36,4 +36,4 @@ directory >= 1.3.1.5 && < 1.4 -- hs-source-dirs: default-language: Haskell2010- ghc-options: -fno-warn-tabs+ ghc-options: -fno-warn-tabs -fwrite-ide-info -hiedir=.hie