mirror of
https://github.com/quantum9Innovation/suntheme.git
synced 2024-11-24 17:33:52 -08:00
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:
parent
cc1935f92c
commit
1ed2a75f6c
4 changed files with 38 additions and 31 deletions
31
app/Main.hs
31
app/Main.hs
|
@ -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
|
||||||
|
|
|
@ -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
28
app/Time.hs
Normal 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
|
|
@ -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:
|
||||||
|
|
Loading…
Reference in a new issue