posplyu (empty) → 0.1.0

raw patch · 4 files changed

+185/−0 lines, 4 filesdep +X11dep +basedep +directorysetup-changed

Dependencies added: X11, base, directory, process, split, time, timerep, transformers, unix

Files

• LICENSE +20/−0
• Main.hs +124/−0
• Setup.hs +2/−0
• posplyu.cabal +39/−0

@@ -0,0 +1,20 @@+Copyright (c) 2018 Sergey Alirzaev++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,124 @@+module Main where++import Control.Concurrent+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.State+import Data.List+import Data.List.Split+import Data.Maybe+import Data.Time.Clock+import Data.Time.LocalTime+import Data.Time.RFC3339+import Graphics.X11+import Graphics.X11.XScreenSaver+import System.Console.GetOpt+import System.Directory+import System.Environment+import System.Posix.Files+import System.Process++pollPeriod = 5000+sleepThreshold = 1800000++data Options = Options+	{ optEdit :: Int+	, optExpect :: Bool+	, optDatabaseFile :: FilePath+	, optList :: Bool+	} deriving Show++defaultOptions    = Options+	{ optEdit = 0+	, optExpect = False+	, optDatabaseFile = ""+	, optList = False+	}++options :: [OptDescr (Options -> Options)]+options =+	[ Option ['e'] ["edit"] (OptArg ((\a o -> o { optEdit = a }) . read . fromMaybe "10") "N") "edit the last N database entries"+	, Option ['x'] ["expect"] (NoArg (\o -> o { optExpect = True })) "print the expected sleepiness time"+	, Option ['d'] ["database-file"] (ReqArg (\a o -> o { optDatabaseFile = a}) "FILE") "use FILE as the sleep data base"+	, Option ['l'] ["list"] (NoArg (\o -> o { optList = True })) "display the database in the current timezone"+	]++parseOpts :: [String] -> IO Options+parseOpts argv =+	case getOpt Permute options argv of+		(o,[],[]  ) -> do+			home <- getAppUserDataDirectory "posplyu"+			return $ foldl (flip id) (defaultOptions { optDatabaseFile = home ++ "/database" }) o+		(_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))+	where header = "Usage: posplyu"++main :: IO ()+main = do+	setFileCreationMask $ unionFileModes groupModes otherModes+	args <- getArgs+	opts <- parseOpts args+	when (0 < optEdit opts) $ do+		db <- readDB $ optDatabaseFile opts+		let (left, edit) = splitAt ((length db) - optEdit opts) db+		editLocal <- mapM (mapM utcToLocalZonedTime) edit+		edited <- toUser editLocal+		writeDB (optDatabaseFile opts) $ left ++ map (map zonedTimeToUTC) edited+	when (optList opts) $ do+		db <- readDB $ optDatabaseFile opts+		times <- mapM (mapM utcToLocalZonedTime) db+		putStr $ formatUser times+	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)+	when (not $ or [0 < optEdit opts, optExpect opts, optList opts]) $ do+		let dirname = intercalate "/" $ init $ split (dropDelims $ whenElt (== '/')) $ optDatabaseFile opts+		createDirectoryIfMissing True dirname+		d <- openDisplay ""+		flip evalStateT False $ forever $ pollIdle d $ optDatabaseFile opts+		return ()++ser :: Show a => [[a]] -> String+ser = unlines . map ((intercalate "\t") . (map show))+des :: Read a => String -> [[a]]+des = map ((map read) . (wordsBy (== '\t'))) . lines++readDB :: FilePath -> IO [[UTCTime]]+readDB dbfn = do+	f <- readFile dbfn+	return $ des f++writeDB :: FilePath -> [[UTCTime]] -> IO ()+writeDB dbfn list = writeFile dbfn $ ser list++formatUser :: [[ZonedTime]] -> String+formatUser = unlines . map ((intercalate "\t") . (map formatTimeRFC3339))++toUser :: [[ZonedTime]] -> IO [[ZonedTime]]+toUser list = do+	let tmpfn = "tmp"+	writeFile tmpfn $ formatUser list+	system $ "\"$EDITOR\" " ++ tmpfn+	fromUser <- readFile tmpfn+	removeLink tmpfn+	return $ map ((map (fromJust . parseTimeRFC3339)) . (wordsBy (== '\t'))) $ lines $ fromUser++pollIdle :: Display -> FilePath -> StateT Bool IO ()+pollIdle d dbfn = do+	t <- liftIO $ getXIdleTime d+	s1 <- get+	put $ t > sleepThreshold+	s2 <- get+	liftIO $ when (s1 /= s2) $ (forkIO $ notify dbfn s2) >> return ()+	liftIO $ threadDelay $ pollPeriod * 1000++isNap :: [UTCTime] -> Bool+isNap [a, b] = diffUTCTime b a < 60 * 60 * 3++notify :: FilePath -> Bool -> IO ()+notify dbfn status = do+	t <- getCurrentTime+	let dbline = (show t) ++ if status then "\t" else "\n"+	appendFile dbfn dbline+	putStr dbline

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,39 @@+name:                posplyu+-- semver+version:             0.1.0+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+license:             MIT+license-file:        LICENSE+author:              Sergey Alirzaev+maintainer:          zl29ah@gmail.com+build-type:          Simple+cabal-version:       >= 1.10++Source-repository head+  type:              git+  location:          https://github.com/l29ah/posplyu.git++Source-repository this+  type:              git+  location:          https://github.com/l29ah/posplyu.git+  tag:               0.1.0+++executable posplyu+  main-is:              Main.hs+  -- other-modules:+  -- other-extensions:+  build-depends:        base >= 4.11 && < 4.13,+                        X11 >= 1.9 && < 1.10,+                        transformers >= 0.5.5.0 && < 0.6,+                        time >= 1.8.0.2 && < 1.9,+                        split >= 0.2.3.3 && < 0.3,+                        unix >= 2.7.2.2 && < 2.8,+                        process >= 1.6.3.0 && < 1.7,+                        timerep >= 2.0.0.2 && < 2.1,+                        directory >= 1.3.1.5 && < 1.4+  -- hs-source-dirs:+  default-language:     Haskell2010+  ghc-options:          -fno-warn-tabs