From 93d5d8ddd812ff63b069b47c9d8eafa803eeb3a2 Mon Sep 17 00:00:00 2001
From: q9i <46249765+quantum9Innovation@users.noreply.github.com>
Date: Mon, 22 Jul 2024 14:06:18 -0700
Subject: [PATCH 1/6] refactor: create types and const modules

---
 app/Const.hs   | 13 +++++++++++++
 app/Main.hs    | 44 +++-----------------------------------------
 app/Types.hs   | 32 ++++++++++++++++++++++++++++++++
 suntheme.cabal | 20 ++++++++++----------
 4 files changed, 58 insertions(+), 51 deletions(-)
 create mode 100644 app/Const.hs
 create mode 100644 app/Types.hs

diff --git a/app/Const.hs b/app/Const.hs
new file mode 100644
index 0000000..607aa9c
--- /dev/null
+++ b/app/Const.hs
@@ -0,0 +1,13 @@
+module Const where
+
+query :: String
+query = "http://ip-api.com/line/?fields=status,lat,lon,timezone"
+
+prog :: String
+prog = "suntheme"
+
+lightModeScript :: String
+lightModeScript = "light.sh"
+
+darkModeScript :: String
+darkModeScript = "dark.sh"
diff --git a/app/Main.hs b/app/Main.hs
index 94f69de..aba8926 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -5,6 +5,9 @@
 
 module Main where
 
+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.RFC3339 (formatTimeRFC3339)
@@ -25,47 +28,6 @@ import Network.HTTP.Request (Response(responseBody, responseStatus), get)
 -- introduce liquid types and checking
 -- whitepaper!
 
-class Status s where
-    ok :: s -> Bool
-    ok = const False
-
-    disp :: s -> String
-    disp = const "encountered bad response (expected OK)"
-
-newtype ResponseCode = ResponseCode Int
-instance Status ResponseCode where
-    ok (ResponseCode code) = code == 200
-    disp (ResponseCode code) =
-        "encountered bad response code: "
-        ++ show code
-        ++ " (expected 200 'OK')"
-
-newtype ResponseMsg = ResponseMsg String
-instance Status ResponseMsg where
-    ok (ResponseMsg msg) = msg == "success"
-    disp (ResponseMsg msg) =
-        "encountered bad response message: "
-        ++ msg
-        ++ " (expected 'success')"
-
-toResponseMsg :: SomeException -> ResponseMsg
-toResponseMsg = ResponseMsg . show
-
-query :: String
-query = "http://ip-api.com/line/?fields=status,lat,lon,timezone"
-
-genericErr :: ResponseMsg
-genericErr = ResponseMsg "encountered unknown error"
-
-prog :: String
-prog = "suntheme"
-
-lightModeScript :: String
-lightModeScript = "light.sh"
-
-darkModeScript :: String
-darkModeScript = "dark.sh"
-
 now :: IO ZonedTime
 now = do
     utcTime <- getCurrentTime
diff --git a/app/Types.hs b/app/Types.hs
new file mode 100644
index 0000000..5601caa
--- /dev/null
+++ b/app/Types.hs
@@ -0,0 +1,32 @@
+module Types where
+
+import Control.Exception (SomeException)
+
+class Status s where
+    ok :: s -> Bool
+    ok = const False
+
+    disp :: s -> String
+    disp = const "encountered bad response (expected OK)"
+
+newtype ResponseCode = ResponseCode Int
+instance Status ResponseCode where
+    ok (ResponseCode code) = code == 200
+    disp (ResponseCode code) =
+        "encountered bad response code: "
+        ++ show code
+        ++ " (expected 200 'OK')"
+
+newtype ResponseMsg = ResponseMsg String
+instance Status ResponseMsg where
+    ok (ResponseMsg msg) = msg == "success"
+    disp (ResponseMsg msg) =
+        "encountered bad response message: "
+        ++ msg
+        ++ " (expected 'success')"
+
+toResponseMsg :: SomeException -> ResponseMsg
+toResponseMsg = ResponseMsg . show
+
+genericErr :: ResponseMsg
+genericErr = ResponseMsg "encountered unknown error"
diff --git a/suntheme.cabal b/suntheme.cabal
index fef2dfb..801f81d 100644
--- a/suntheme.cabal
+++ b/suntheme.cabal
@@ -62,22 +62,22 @@ executable suntheme
     main-is:          Main.hs
 
     -- Modules included in this executable, other than Main.
-    -- other-modules:
+    other-modules:    Types, Const
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
 
     -- Other library packages from which modules are imported.
     build-depends:    base ^>=4.17.2.1,
-        request ^>=0.2.2.0, 
-        process ^>=1.6.18.0,
-        bytestring ^>=0.11.5.3,
-        filepath ^>=1.4.2.2,
-        time ^>=1.9.3,
-        solar ^>=0.1.0.0,
-        timerep ^>=2.1.0.0,
-        extra ^>=1.7.16,
-        directory ^>=1.3.8.5
+                      request ^>=0.2.2.0, 
+                      process ^>=1.6.18.0,
+                      bytestring ^>=0.11.5.3,
+                      filepath ^>=1.4.2.2,
+                      time ^>=1.9.3,
+                      solar ^>=0.1.0.0,
+                      timerep ^>=2.1.0.0,
+                      extra ^>=1.7.16,
+                      directory ^>=1.3.8.5
 
     -- Directories containing source files.
     hs-source-dirs:   app

From 9258461e3ce99b968558899eb3f2d8d1da43e964 Mon Sep 17 00:00:00 2001
From: q9i <46249765+quantum9Innovation@users.noreply.github.com>
Date: Mon, 22 Jul 2024 14:21:55 -0700
Subject: [PATCH 2/6] 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.
---
 app/Main.hs    | 18 +-----------------
 app/Pure.hs    | 20 ++++++++++++++++++++
 suntheme.cabal |  2 +-
 3 files changed, 22 insertions(+), 18 deletions(-)
 create mode 100644 app/Pure.hs

diff --git a/app/Main.hs b/app/Main.hs
index aba8926..9d51013 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -5,12 +5,12 @@
 
 module Main where
 
+import Pure (buildCmd, kill, readLines)
 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.RFC3339 (formatTimeRFC3339)
 import Data.Time.LocalTime (getTimeZone, utcToZonedTime, zonedTimeToUTC)
 import Data.List.Extra ((!?))
 import Data.ByteString.Char8 (unpack)
@@ -77,10 +77,6 @@ ping run err = do
                 runner = run r
             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 r run err =
     case info of
@@ -130,9 +126,6 @@ backupRunner = do
 exec :: String -> (SomeException -> IO String) -> IO String
 exec cmd err = do catch (readProcess "bash" ["-c", cmd] "") err
 
-kill :: String -> String
-kill = (++) "atrm "
-
 killall :: [String] -> IO ()
 killall = foldr ((>>) . dispatch . kill) (return ())
     where
@@ -160,15 +153,6 @@ finish queue = do
         getId = head . words . last . lines
         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 sunriseTime sunsetTime = do
     timeNow <- now
diff --git a/app/Pure.hs b/app/Pure.hs
new file mode 100644
index 0000000..30ceef1
--- /dev/null
+++ b/app/Pure.hs
@@ -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
diff --git a/suntheme.cabal b/suntheme.cabal
index 801f81d..d2c530e 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
+    other-modules:    Types, Const, Pure
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:

From 4f0db471bcb1f774c7b41d9892a9fff962a2b739 Mon Sep 17 00:00:00 2001
From: q9i <46249765+quantum9Innovation@users.noreply.github.com>
Date: Mon, 22 Jul 2024 14:47:11 -0700
Subject: [PATCH 3/6] refactor: create time module

move time-related functions from `Main.hs` to a new `Time` module for better
organization and code separation
---
 app/Main.hs    | 31 +------------------------------
 app/Pure.hs    |  8 ++++++++
 app/Time.hs    | 28 ++++++++++++++++++++++++++++
 suntheme.cabal |  2 +-
 4 files changed, 38 insertions(+), 31 deletions(-)
 create mode 100644 app/Time.hs

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:

From 9fbc5d0f534c2419946df373d556107080964ade Mon Sep 17 00:00:00 2001
From: q9i <46249765+quantum9Innovation@users.noreply.github.com>
Date: Mon, 22 Jul 2024 15:27:06 -0700
Subject: [PATCH 4/6] refactor: create sugar module

move IO abstractions and desugaring processes into a separate module
---
 app/Main.hs    | 34 ++++++----------------------------
 app/Sugar.hs   | 28 ++++++++++++++++++++++++++++
 suntheme.cabal |  2 +-
 3 files changed, 35 insertions(+), 29 deletions(-)
 create mode 100644 app/Sugar.hs

diff --git a/app/Main.hs b/app/Main.hs
index 2be7bac..3c43d4c 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -5,15 +5,14 @@
 
 module Main where
 
-import Pure (buildCmd, kill, readLines)
+import Pure (buildCmd, readLines)
 import Time (activateOnSunrise, sunriseNow, sunsetNow)
 import Const (darkModeScript, lightModeScript, prog, query)
-import Types (ResponseMsg(..), ResponseCode(..), Status(..), genericErr, toResponseMsg)
+import Sugar (continue, crash, destruct, exec, killall)
+import Types (ResponseMsg(..), ResponseCode(..), genericErr, toResponseMsg)
 
 import Data.List.Extra ((!?))
 import Data.ByteString.Char8 (unpack)
-import System.Exit (ExitCode(ExitFailure), exitWith)
-import System.Process (readProcess)
 import System.FilePath ((</>), takeDirectory)
 import System.Directory (XdgDirectory(XdgCache, XdgConfig), createDirectoryIfMissing, doesFileExist, getXdgDirectory)
 import Control.Exception (SomeException, catch, try)
@@ -39,19 +38,11 @@ pathToConfig str = do
 fetch :: String -> IO (Either SomeException Response)
 fetch = try . get
 
-cont :: (Status s) => s -> IO () -> IO ()
-cont e err = (putStrLn . disp) e >> err
-
-destruct :: (Status s) => s -> IO () -> IO () -> IO ()
-destruct status success failure
-    | ok status = success
-    | otherwise = cont status failure
-
 ping :: (Response -> IO ()) -> IO () -> IO ()
 ping run err = do
     res <- fetch query
     case res of
-        Left e -> cont (toResponseMsg e) err
+        Left e -> continue (toResponseMsg e) err
         Right r ->
             let status = (ResponseCode . responseStatus) r
                 runner = run r
@@ -60,7 +51,7 @@ ping run err = do
 process :: Response -> (Double -> Double -> String -> IO ()) -> IO () -> IO ()
 process r run err =
     case info of
-        Nothing -> cont genericErr err
+        Nothing -> continue genericErr err
         Just (msg, lat, lon, tz) ->
             let status = ResponseMsg msg
                 runner = run lat lon tz
@@ -91,9 +82,6 @@ readCache = do
 processRunner :: Response -> IO ()
 processRunner r = process r dumpCache backupRunner
 
-crash :: IO ()
-crash = exitWith (ExitFailure 1)
-
 backupRunner :: IO ()
 backupRunner = do
     contents <- readCache
@@ -103,16 +91,6 @@ backupRunner = do
             crash
         Just (lat, lon, _) -> prepareScripts lat lon
 
-exec :: String -> (SomeException -> IO String) -> IO String
-exec cmd err = do catch (readProcess "bash" ["-c", cmd] "") err
-
-killall :: [String] -> IO ()
-killall = foldr ((>>) . dispatch . kill) (return ())
-    where
-        dispatch cmd = exec cmd failure
-        failure :: SomeException -> IO String
-        failure e = print e >> return []
-
 start :: IO () -> IO ()
 start act = do
     logFile <- pathToCache "log.txt"
@@ -120,7 +98,7 @@ start act = do
     if existsLog then do
         contents <- readFile logFile
         let entries = lines contents
-        killall entries
+        (sequence_ . killall) entries
     else createDirectoryIfMissing True (takeDirectory logFile)
     act
 
diff --git a/app/Sugar.hs b/app/Sugar.hs
new file mode 100644
index 0000000..4c6658e
--- /dev/null
+++ b/app/Sugar.hs
@@ -0,0 +1,28 @@
+module Sugar where
+
+import Pure (kill)
+import Types (Status(..))
+
+import System.Exit (ExitCode(ExitFailure), exitWith)
+import System.Process (readProcess)
+import Control.Exception (SomeException, catch)
+
+throw :: (Monoid m) => SomeException -> IO m
+throw e = print e >> return mempty
+
+continue :: (Status s) => s -> IO () -> IO ()
+continue e err = (putStrLn . disp) e >> err
+
+destruct :: (Status s) => s -> IO () -> IO () -> IO ()
+destruct status success failure
+    | ok status = success
+    | otherwise = continue status failure
+
+crash :: IO ()
+crash = (exitWith . ExitFailure) 1
+
+exec :: String -> (SomeException -> IO String) -> IO String
+exec cmd = catch (readProcess "bash" ["-c", cmd] "")
+
+killall :: [String] -> [IO String]
+killall = map (dispatch . kill) where dispatch cmd = exec cmd throw
diff --git a/suntheme.cabal b/suntheme.cabal
index 2f3e41c..0c421aa 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, Time
+    other-modules:    Types, Const, Pure, Time, Sugar
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:

From 76973ba364ea49481c95c09a1ed400f9444ba4df Mon Sep 17 00:00:00 2001
From: q9i <46249765+quantum9Innovation@users.noreply.github.com>
Date: Mon, 22 Jul 2024 15:39:35 -0700
Subject: [PATCH 5/6] refactor: create getters module

group helper funcs for creating directory names and fetching network resources into a single module
---
 app/Getters.hs | 17 +++++++++++++++++
 app/Main.hs    | 26 +++++++-------------------
 suntheme.cabal |  2 +-
 3 files changed, 25 insertions(+), 20 deletions(-)
 create mode 100644 app/Getters.hs

diff --git a/app/Getters.hs b/app/Getters.hs
new file mode 100644
index 0000000..96087d9
--- /dev/null
+++ b/app/Getters.hs
@@ -0,0 +1,17 @@
+module Getters where
+
+import Const (prog)
+
+import System.FilePath ((</>))
+import System.Directory (XdgDirectory(XdgCache, XdgConfig), getXdgDirectory)
+import Control.Exception (SomeException, try)
+import Network.HTTP.Request (Response, get)
+
+pathToCache :: String -> IO String
+pathToCache str = (</> str) <$> getXdgDirectory XdgCache prog
+
+pathToConfig :: String -> IO String
+pathToConfig str = (</> str) <$> getXdgDirectory XdgConfig prog
+
+fetch :: String -> IO (Either SomeException Response)
+fetch = try . get
diff --git a/app/Main.hs b/app/Main.hs
index 3c43d4c..1a1f823 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -7,16 +7,17 @@ module Main where
 
 import Pure (buildCmd, readLines)
 import Time (activateOnSunrise, sunriseNow, sunsetNow)
-import Const (darkModeScript, lightModeScript, prog, query)
+import Const (darkModeScript, lightModeScript, query)
 import Sugar (continue, crash, destruct, exec, killall)
-import Types (ResponseMsg(..), ResponseCode(..), genericErr, toResponseMsg)
+import Types (ResponseCode(..), ResponseMsg(..), genericErr, toResponseMsg)
+import Getters (fetch, pathToCache, pathToConfig)
 
 import Data.List.Extra ((!?))
 import Data.ByteString.Char8 (unpack)
-import System.FilePath ((</>), takeDirectory)
-import System.Directory (XdgDirectory(XdgCache, XdgConfig), createDirectoryIfMissing, doesFileExist, getXdgDirectory)
-import Control.Exception (SomeException, catch, try)
-import Network.HTTP.Request (Response(responseBody, responseStatus), get)
+import System.FilePath (takeDirectory)
+import System.Directory (createDirectoryIfMissing, doesFileExist)
+import Control.Exception (SomeException, catch)
+import Network.HTTP.Request (Response(responseBody, responseStatus))
 
 -- error handling
 -- refactor into modules
@@ -25,19 +26,6 @@ import Network.HTTP.Request (Response(responseBody, responseStatus), get)
 -- introduce liquid types and checking
 -- whitepaper!
 
-pathToCache :: String -> IO String
-pathToCache str = do
-    dir <- getXdgDirectory XdgCache prog
-    return (dir </> str)
-
-pathToConfig :: String -> IO String
-pathToConfig str = do
-    dir <- getXdgDirectory XdgConfig prog
-    return (dir </> str)
-
-fetch :: String -> IO (Either SomeException Response)
-fetch = try . get
-
 ping :: (Response -> IO ()) -> IO () -> IO ()
 ping run err = do
     res <- fetch query
diff --git a/suntheme.cabal b/suntheme.cabal
index 0c421aa..9499d09 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, Time, Sugar
+    other-modules:    Types, Const, Pure, Time, Sugar, Getters
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:

From f22d715b8e497459766a3cc6bb1ce91fa86385f8 Mon Sep 17 00:00:00 2001
From: q9i <46249765+quantum9Innovation@users.noreply.github.com>
Date: Thu, 1 Aug 2024 20:15:32 -0700
Subject: [PATCH 6/6] refactor: complete modularization

introduce Workers, Cache modules and shuffle around some existing functions
---
 app/Cache.hs   |  51 ++++++++++++++++++++++
 app/Const.hs   |   6 +++
 app/Getters.hs |  10 -----
 app/Main.hs    | 116 +++++++++++--------------------------------------
 app/Sugar.hs   |   7 ++-
 app/Time.hs    |  18 +++++++-
 app/Workers.hs |  26 +++++++++++
 suntheme.cabal |   2 +-
 8 files changed, 131 insertions(+), 105 deletions(-)
 create mode 100644 app/Cache.hs
 create mode 100644 app/Workers.hs

diff --git a/app/Cache.hs b/app/Cache.hs
new file mode 100644
index 0000000..ef0ebef
--- /dev/null
+++ b/app/Cache.hs
@@ -0,0 +1,51 @@
+module Cache where
+
+import Const (cacheFile, logFile, prog)
+import Sugar (killall, failure)
+
+import Data.List.Extra ((!?))
+import System.FilePath ((</>), takeDirectory)
+import System.Directory (
+        XdgDirectory(XdgCache, XdgConfig),
+        createDirectoryIfMissing, doesFileExist, getXdgDirectory
+    )
+import Control.Exception (catch)
+
+pathToCache :: String -> IO String
+pathToCache str = (</> str) <$> getXdgDirectory XdgCache prog
+
+pathToConfig :: String -> IO String
+pathToConfig str = (</> str) <$> getXdgDirectory XdgConfig prog
+
+readCache :: IO (Maybe (Double, Double, String))
+readCache = do
+    cache <- pathToCache cacheFile
+    contents <- readFile cache
+    let entries = lines contents
+    case (entries !? 0, entries !? 1, entries !? 2) of
+        (Just lat, Just lon, Just tz) -> return (Just (read lat, read lon, tz))
+        _ -> return Nothing
+
+dumpCache :: Double -> Double -> String -> IO (Double, Double)
+dumpCache lat lon tz = do
+    cache <- pathToCache cacheFile
+    catch (writer cache) failure
+    return (lat, lon)
+    where writer dir = writeFile dir (show lat ++ "\n" ++ show lon ++ "\n" ++ tz)
+
+start :: IO ()
+start = do
+    logs <- pathToCache logFile
+    existsLog <- doesFileExist logs
+    if existsLog then do
+        contents <- readFile logs
+        (sequence_ . killall . lines) contents
+    else createDirectoryIfMissing True (takeDirectory logs)
+
+finish :: String -> IO ()
+finish queue = do
+    cache <- pathToCache logFile
+    catch (writeFile cache num) failure
+    where
+        getId = head . words . last . lines
+        num = getId queue
diff --git a/app/Const.hs b/app/Const.hs
index 607aa9c..3af5223 100644
--- a/app/Const.hs
+++ b/app/Const.hs
@@ -6,6 +6,12 @@ query = "http://ip-api.com/line/?fields=status,lat,lon,timezone"
 prog :: String
 prog = "suntheme"
 
+cacheFile :: String
+cacheFile = "data.txt"
+
+logFile :: String
+logFile = "log.txt"
+
 lightModeScript :: String
 lightModeScript = "light.sh"
 
diff --git a/app/Getters.hs b/app/Getters.hs
index 96087d9..6239d4d 100644
--- a/app/Getters.hs
+++ b/app/Getters.hs
@@ -1,17 +1,7 @@
 module Getters where
 
-import Const (prog)
-
-import System.FilePath ((</>))
-import System.Directory (XdgDirectory(XdgCache, XdgConfig), getXdgDirectory)
 import Control.Exception (SomeException, try)
 import Network.HTTP.Request (Response, get)
 
-pathToCache :: String -> IO String
-pathToCache str = (</> str) <$> getXdgDirectory XdgCache prog
-
-pathToConfig :: String -> IO String
-pathToConfig str = (</> str) <$> getXdgDirectory XdgConfig prog
-
 fetch :: String -> IO (Either SomeException Response)
 fetch = try . get
diff --git a/app/Main.hs b/app/Main.hs
index 1a1f823..9d4ac6b 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -5,37 +5,29 @@
 
 module Main where
 
-import Pure (buildCmd, readLines)
-import Time (activateOnSunrise, sunriseNow, sunsetNow)
-import Const (darkModeScript, lightModeScript, query)
-import Sugar (continue, crash, destruct, exec, killall)
+import Pure (readLines)
+import Cache (dumpCache, start)
+import Const (query)
+import Sugar (continue, destruct)
 import Types (ResponseCode(..), ResponseMsg(..), genericErr, toResponseMsg)
-import Getters (fetch, pathToCache, pathToConfig)
+import Getters (fetch)
+import Workers (backupRunner, prepareScripts)
 
-import Data.List.Extra ((!?))
 import Data.ByteString.Char8 (unpack)
-import System.FilePath (takeDirectory)
-import System.Directory (createDirectoryIfMissing, doesFileExist)
-import Control.Exception (SomeException, catch)
 import Network.HTTP.Request (Response(responseBody, responseStatus))
 
 -- error handling
--- refactor into modules
--- clean up jank (reduce lines in functions, more atomic/functional, etc)
+-- clean up jank (
+--  create types,
+--  more pure functions,
+--  reduce lines in functions,
+--  more atomic/functional,
+--  etc
+-- )
 -- eliminate as many do blocks as possible
 -- introduce liquid types and checking
 -- whitepaper!
 
-ping :: (Response -> IO ()) -> IO () -> IO ()
-ping run err = do
-    res <- fetch query
-    case res of
-        Left e -> continue (toResponseMsg e) err
-        Right r ->
-            let status = (ResponseCode . responseStatus) r
-                runner = run r
-            in destruct status runner err
-
 process :: Response -> (Double -> Double -> String -> IO ()) -> IO () -> IO ()
 process r run err =
     case info of
@@ -49,80 +41,22 @@ process r run err =
         parts = (lines . unpack) body
         info = (readLines . take 4) parts
 
-dumpCache :: Double -> Double -> String -> IO ()
-dumpCache lat lon tz = do
-    cache <- pathToCache "data.txt"
-    catch (writer cache) failure
-    prepareScripts lat lon
-    where
-        writer dir = writeFile dir (show lat ++ "\n" ++ show lon ++ "\n" ++ tz)
-        failure = print :: SomeException -> IO ()
-
-readCache :: IO (Maybe (Double, Double, String))
-readCache = do
-    cache <- pathToCache "data.txt"
-    contents <- readFile cache
-    let entries = lines contents
-    case (entries !? 0, entries !? 1, entries !? 2) of
-        (Just lat, Just lon, Just tz) -> return (Just (read lat, read lon, tz))
-        _ -> return Nothing
-
 processRunner :: Response -> IO ()
-processRunner r = process r dumpCache backupRunner
+processRunner r = process r run backupRunner
+    where run lat lon tz = dumpCache lat lon tz >>= prepareScripts
 
-backupRunner :: IO ()
-backupRunner = do
-    contents <- readCache
-    case contents of
-        Nothing -> do
-            putStrLn "Failed to read cache after IP location failed"
-            crash
-        Just (lat, lon, _) -> prepareScripts lat lon
-
-start :: IO () -> IO ()
-start act = do
-    logFile <- pathToCache "log.txt"
-    existsLog <- doesFileExist logFile
-    if existsLog then do
-        contents <- readFile logFile
-        let entries = lines contents
-        (sequence_ . killall) entries
-    else createDirectoryIfMissing True (takeDirectory logFile)
-    act
-
-finish :: String -> IO ()
-finish queue = do
-    cache <- pathToCache "log.txt"
-    catch (writeFile cache num) failure
-    where
-        num = getId queue
-        getId = head . words . last . lines
-        failure = print :: SomeException -> IO ()
-
-prepareScripts :: Double -> Double -> IO ()
-prepareScripts lat lon = do
-    sunriseTime <- sunriseNow lat lon
-    sunsetTime <- sunsetNow lat lon
-    lightMode <- activateOnSunrise sunriseTime sunsetTime
-    _ <- if lightMode then do
-        putStr "Light mode activation script scheduled for "
-        print sunriseTime
-        script <- pathToConfig lightModeScript
-        exec (buildCmd script sunriseTime) terminate
-    else do
-        putStrLn "Dark mode activation script scheduled for "
-        print sunsetTime
-        script <- pathToConfig darkModeScript
-        exec (buildCmd script sunsetTime) terminate
-    queue <- exec "atq" noQueue
-    finish queue
-    where
-        terminate _ = print "Scheduling process failed" >> return ""
-        noQueueMsg = "Scheduled process could not be retrieved (try rerunning if 'atq' fails)"
-        noQueue _ = print noQueueMsg >> return ""
+ping :: (Response -> IO ()) -> IO () -> IO ()
+ping run err = do
+    res <- fetch query
+    case res of
+        Left e -> continue (toResponseMsg e) err
+        Right r ->
+            let status = (ResponseCode . responseStatus) r
+                runner = run r
+            in destruct status runner err
 
 routine :: IO ()
 routine = ping processRunner backupRunner
 
 main :: IO ()
-main = start routine
+main = start >> routine
diff --git a/app/Sugar.hs b/app/Sugar.hs
index 4c6658e..1d2213a 100644
--- a/app/Sugar.hs
+++ b/app/Sugar.hs
@@ -13,10 +13,13 @@ throw e = print e >> return mempty
 continue :: (Status s) => s -> IO () -> IO ()
 continue e err = (putStrLn . disp) e >> err
 
+failure :: SomeException -> IO ()
+failure = print
+
 destruct :: (Status s) => s -> IO () -> IO () -> IO ()
-destruct status success failure
+destruct status success unsuccessful
     | ok status = success
-    | otherwise = continue status failure
+    | otherwise = continue status unsuccessful
 
 crash :: IO ()
 crash = (exitWith . ExitFailure) 1
diff --git a/app/Time.hs b/app/Time.hs
index 2594007..93d37c8 100644
--- a/app/Time.hs
+++ b/app/Time.hs
@@ -1,6 +1,9 @@
 module Time where
 
-import Pure (sunriseNext)
+import Pure (buildCmd, sunriseNext)
+import Cache (pathToConfig)
+import Const (darkModeScript, lightModeScript)
+import Sugar (exec)
 
 import Data.Time (ZonedTime, getCurrentTime)
 import Data.Time.Solar (Location(Location), sunrise, sunset)
@@ -26,3 +29,16 @@ sunsetNow lat lon = do
 
 activateOnSunrise :: ZonedTime -> ZonedTime -> IO Bool
 activateOnSunrise sunriseTime sunsetTime = sunriseNext sunriseTime sunsetTime <$> now
+
+activate :: String -> ZonedTime -> String -> IO String
+activate msg time script = do
+    putStr msg
+    print time
+    scriptPath <- pathToConfig script
+    exec (buildCmd scriptPath time) terminate
+    where terminate _ = print "Scheduling process failed" >> return "" 
+
+chooseActivation :: Bool -> ZonedTime -> ZonedTime -> IO String
+chooseActivation lightMode sunriseTime sunsetTime
+    | lightMode = activate "Light mode activation script scheduled for " sunriseTime lightModeScript
+    | otherwise = activate "Dark mode activation script scheduled for " sunsetTime darkModeScript
diff --git a/app/Workers.hs b/app/Workers.hs
new file mode 100644
index 0000000..de22849
--- /dev/null
+++ b/app/Workers.hs
@@ -0,0 +1,26 @@
+module Workers where
+
+import Time (chooseActivation, activateOnSunrise, sunriseNow, sunsetNow)
+import Cache (finish, readCache)
+import Sugar (crash, exec)
+
+prepareScripts :: (Double, Double) -> IO ()
+prepareScripts (lat, lon) = do
+    sunriseTime <- sunriseNow lat lon
+    sunsetTime <- sunsetNow lat lon
+    lightMode <- activateOnSunrise sunriseTime sunsetTime
+    _ <- chooseActivation lightMode sunriseTime sunsetTime
+    queue <- exec "atq" noQueue
+    finish queue
+    where
+        noQueueMsg = "Scheduled process could not be retrieved (try rerunning if 'atq' fails)"
+        noQueue _ = print noQueueMsg >> return ""
+
+backupRunner :: IO ()
+backupRunner = do
+    contents <- readCache
+    case contents of
+        Nothing -> do
+            putStrLn "Failed to read cache after IP location failed"
+            crash
+        Just (lat, lon, _) -> prepareScripts (lat, lon)
diff --git a/suntheme.cabal b/suntheme.cabal
index 9499d09..e8a3179 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, Time, Sugar, Getters
+    other-modules:    Types, Const, Pure, Time, Sugar, Getters, Cache, Workers
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions: