diff --git a/app/Main.hs b/app/Main.hs index 9d51013..2be7bac 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/app/Pure.hs b/app/Pure.hs index 30ceef1..fba5ece 100644 --- a/app/Pure.hs +++ b/app/Pure.hs @@ -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 diff --git a/app/Time.hs b/app/Time.hs new file mode 100644 index 0000000..2594007 --- /dev/null +++ b/app/Time.hs @@ -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 diff --git a/suntheme.cabal b/suntheme.cabal index d2c530e..2f3e41c 100644 --- a/suntheme.cabal +++ b/suntheme.cabal @@ -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: