From 6cf30685ad465e66e8fae4862221939e9ecec677 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] 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