refactor: create pure module

`Pure` contains functions for processing data and building commands. The module includes functions for reading lines of input, formatting time, and constructing a command with a given script and time.
This commit is contained in:
q9i 2024-07-22 14:21:55 -07:00 committed by Ananth Venkatesh
parent 6cf30685ad
commit cc1935f92c
3 changed files with 22 additions and 18 deletions

View file

@ -5,12 +5,12 @@
module Main where module Main where
import Pure (buildCmd, kill, readLines)
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 (ZonedTime, getCurrentTime)
import Data.Time.Solar (Location(Location), sunrise, sunset) import Data.Time.Solar (Location(Location), sunrise, sunset)
import Data.Time.RFC3339 (formatTimeRFC3339)
import Data.Time.LocalTime (getTimeZone, utcToZonedTime, zonedTimeToUTC) 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)
@ -77,10 +77,6 @@ ping run err = do
runner = run r runner = run r
in destruct status runner err in destruct status runner err
readLines :: [String] -> Maybe (String, Double, Double, String)
readLines [msg, latStr, lonStr, tz] = Just (msg, read latStr, read lonStr, tz)
readLines _ = Nothing
process :: Response -> (Double -> Double -> String -> IO ()) -> IO () -> IO () process :: Response -> (Double -> Double -> String -> IO ()) -> IO () -> IO ()
process r run err = process r run err =
case info of case info of
@ -130,9 +126,6 @@ backupRunner = do
exec :: String -> (SomeException -> IO String) -> IO String exec :: String -> (SomeException -> IO String) -> IO String
exec cmd err = do catch (readProcess "bash" ["-c", cmd] "") err exec cmd err = do catch (readProcess "bash" ["-c", cmd] "") err
kill :: String -> String
kill = (++) "atrm "
killall :: [String] -> IO () killall :: [String] -> IO ()
killall = foldr ((>>) . dispatch . kill) (return ()) killall = foldr ((>>) . dispatch . kill) (return ())
where where
@ -160,15 +153,6 @@ finish queue = do
getId = head . words . last . lines getId = head . words . last . lines
failure = print :: SomeException -> IO () failure = print :: SomeException -> IO ()
after :: (Eq a) => a -> [a] -> [a]
after c = drop 1 . dropWhile (/= c)
formatTime :: ZonedTime -> String
formatTime = take 5 . after 'T' . formatTimeRFC3339
buildCmd :: String -> ZonedTime -> String
buildCmd script time = "echo \"" ++ script ++ "\" | at " ++ formatTime time
activateOnSunrise :: ZonedTime -> ZonedTime -> IO Bool activateOnSunrise :: ZonedTime -> ZonedTime -> IO Bool
activateOnSunrise sunriseTime sunsetTime = do activateOnSunrise sunriseTime sunsetTime = do
timeNow <- now timeNow <- now

20
app/Pure.hs Normal file
View file

@ -0,0 +1,20 @@
module Pure where
import Data.Time (ZonedTime)
import Data.Time.RFC3339 (formatTimeRFC3339)
readLines :: [String] -> Maybe (String, Double, Double, String)
readLines [msg, latStr, lonStr, tz] = Just (msg, read latStr, read lonStr, tz)
readLines _ = Nothing
kill :: String -> String
kill = (++) "atrm "
after :: (Eq a) => a -> [a] -> [a]
after c = drop 1 . dropWhile (/= c)
formatTime :: ZonedTime -> String
formatTime = take 5 . after 'T' . formatTimeRFC3339
buildCmd :: String -> ZonedTime -> String
buildCmd script time = "echo \"" ++ script ++ "\" | at " ++ formatTime time

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 other-modules: Types, Const, Pure
-- LANGUAGE extensions used by modules in this package. -- LANGUAGE extensions used by modules in this package.
-- other-extensions: -- other-extensions: