From b9750dafeabc99f68547d11ba8f2f9b49ffb4e8e 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] 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: