mirror of
https://github.com/quantum9Innovation/suntheme.git
synced 2024-11-24 17:33:52 -08:00
refactor: create types and const modules
This commit is contained in:
parent
546de7273f
commit
6cf30685ad
4 changed files with 58 additions and 51 deletions
13
app/Const.hs
Normal file
13
app/Const.hs
Normal 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"
|
44
app/Main.hs
44
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
|
||||
|
|
32
app/Types.hs
Normal file
32
app/Types.hs
Normal 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"
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue