refactor: create time module

move time-related functions from `Main.hs` to a new `Time` module for better
organization and code separation
This commit is contained in:
q9i 2024-07-22 14:47:11 -07:00
parent 9258461e3c
commit 4f0db471bc
4 changed files with 38 additions and 31 deletions

View file

@ -6,12 +6,10 @@
module Main where module Main where
import Pure (buildCmd, kill, readLines) import Pure (buildCmd, kill, readLines)
import Time (activateOnSunrise, sunriseNow, sunsetNow)
import Const (darkModeScript, lightModeScript, prog, query) import Const (darkModeScript, lightModeScript, prog, query)
import Types (ResponseMsg(..), ResponseCode(..), Status(..), genericErr, toResponseMsg) import Types (ResponseMsg(..), ResponseCode(..), Status(..), genericErr, toResponseMsg)
import Data.Time (ZonedTime, getCurrentTime)
import Data.Time.Solar (Location(Location), sunrise, sunset)
import Data.Time.LocalTime (getTimeZone, utcToZonedTime, zonedTimeToUTC)
import Data.List.Extra ((!?)) import Data.List.Extra ((!?))
import Data.ByteString.Char8 (unpack) import Data.ByteString.Char8 (unpack)
import System.Exit (ExitCode(ExitFailure), exitWith) import System.Exit (ExitCode(ExitFailure), exitWith)
@ -28,24 +26,6 @@ import Network.HTTP.Request (Response(responseBody, responseStatus), get)
-- introduce liquid types and checking -- introduce liquid types and checking
-- whitepaper! -- whitepaper!
now :: IO ZonedTime
now = do
utcTime <- getCurrentTime
timeZone <- getTimeZone utcTime
return (utcToZonedTime timeZone utcTime)
sunriseNow :: Double -> Double -> IO ZonedTime
sunriseNow lat lon = do
time <- now
return (sunrise time here)
where here = Location lat lon
sunsetNow :: Double -> Double -> IO ZonedTime
sunsetNow lat lon = do
time <- now
return (sunset time here)
where here = Location lat lon
pathToCache :: String -> IO String pathToCache :: String -> IO String
pathToCache str = do pathToCache str = do
dir <- getXdgDirectory XdgCache prog dir <- getXdgDirectory XdgCache prog
@ -153,15 +133,6 @@ finish queue = do
getId = head . words . last . lines getId = head . words . last . lines
failure = print :: SomeException -> IO () failure = print :: SomeException -> IO ()
activateOnSunrise :: ZonedTime -> ZonedTime -> IO Bool
activateOnSunrise sunriseTime sunsetTime = do
timeNow <- now
let utcTimeNow = zonedTimeToUTC timeNow
utcSunrise = zonedTimeToUTC sunriseTime
utcSunset = zonedTimeToUTC sunsetTime
if utcTimeNow < utcSunrise || utcTimeNow > utcSunset then return True
else return False
prepareScripts :: Double -> Double -> IO () prepareScripts :: Double -> Double -> IO ()
prepareScripts lat lon = do prepareScripts lat lon = do
sunriseTime <- sunriseNow lat lon sunriseTime <- sunriseNow lat lon

View file

@ -2,6 +2,7 @@ module Pure where
import Data.Time (ZonedTime) import Data.Time (ZonedTime)
import Data.Time.RFC3339 (formatTimeRFC3339) import Data.Time.RFC3339 (formatTimeRFC3339)
import Data.Time.LocalTime (zonedTimeToUTC)
readLines :: [String] -> Maybe (String, Double, Double, String) readLines :: [String] -> Maybe (String, Double, Double, String)
readLines [msg, latStr, lonStr, tz] = Just (msg, read latStr, read lonStr, tz) readLines [msg, latStr, lonStr, tz] = Just (msg, read latStr, read lonStr, tz)
@ -18,3 +19,10 @@ formatTime = take 5 . after 'T' . formatTimeRFC3339
buildCmd :: String -> ZonedTime -> String buildCmd :: String -> ZonedTime -> String
buildCmd script time = "echo \"" ++ script ++ "\" | at " ++ formatTime time buildCmd script time = "echo \"" ++ script ++ "\" | at " ++ formatTime time
sunriseNext :: ZonedTime -> ZonedTime -> ZonedTime -> Bool
sunriseNext sunriseTime sunsetTime time =
let utcTimeNow = zonedTimeToUTC time
utcSunrise = zonedTimeToUTC sunriseTime
utcSunset = zonedTimeToUTC sunsetTime
in utcTimeNow < utcSunrise || utcTimeNow > utcSunset

28
app/Time.hs Normal file
View file

@ -0,0 +1,28 @@
module Time where
import Pure (sunriseNext)
import Data.Time (ZonedTime, getCurrentTime)
import Data.Time.Solar (Location(Location), sunrise, sunset)
import Data.Time.LocalTime (getTimeZone, utcToZonedTime)
now :: IO ZonedTime
now = do
utcTime <- getCurrentTime
timeZone <- getTimeZone utcTime
return (utcToZonedTime timeZone utcTime)
sunriseNow :: Double -> Double -> IO ZonedTime
sunriseNow lat lon = do
time <- now
return (sunrise time here)
where here = Location lat lon
sunsetNow :: Double -> Double -> IO ZonedTime
sunsetNow lat lon = do
time <- now
return (sunset time here)
where here = Location lat lon
activateOnSunrise :: ZonedTime -> ZonedTime -> IO Bool
activateOnSunrise sunriseTime sunsetTime = sunriseNext sunriseTime sunsetTime <$> now

View file

@ -62,7 +62,7 @@ executable suntheme
main-is: Main.hs main-is: Main.hs
-- Modules included in this executable, other than Main. -- Modules included in this executable, other than Main.
other-modules: Types, Const, Pure other-modules: Types, Const, Pure, Time
-- LANGUAGE extensions used by modules in this package. -- LANGUAGE extensions used by modules in this package.
-- other-extensions: -- other-extensions: