refactor: create types and const modules

This commit is contained in:
q9i 2024-07-22 14:06:18 -07:00
parent 546de7273f
commit 93d5d8ddd8
4 changed files with 58 additions and 51 deletions

13
app/Const.hs Normal file
View file

@ -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"

View file

@ -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

32
app/Types.hs Normal file
View file

@ -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"

View file

@ -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