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
import Pure (buildCmd, kill, readLines)
import Time (activateOnSunrise, sunriseNow, sunsetNow)
import Const (darkModeScript, lightModeScript, prog, query)
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.ByteString.Char8 (unpack)
import System.Exit (ExitCode(ExitFailure), exitWith)
@ -28,24 +26,6 @@ import Network.HTTP.Request (Response(responseBody, responseStatus), get)
-- introduce liquid types and checking
-- 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 str = do
dir <- getXdgDirectory XdgCache prog
@ -153,15 +133,6 @@ finish queue = do
getId = head . words . last . lines
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 lat lon = do
sunriseTime <- sunriseNow lat lon

View file

@ -2,6 +2,7 @@ module Pure where
import Data.Time (ZonedTime)
import Data.Time.RFC3339 (formatTimeRFC3339)
import Data.Time.LocalTime (zonedTimeToUTC)
readLines :: [String] -> Maybe (String, Double, Double, String)
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 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
-- 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.
-- other-extensions: