mirror of
https://github.com/quantum9Innovation/suntheme.git
synced 2024-11-25 01:43:50 -08:00
refactor: create types and const modules
This commit is contained in:
parent
546de7273f
commit
93d5d8ddd8
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
|
module Main where
|
||||||
|
|
||||||
|
import Const (darkModeScript, lightModeScript, prog, query)
|
||||||
|
import Types (ResponseMsg(..), ResponseCode(..), Status(..), genericErr, toResponseMsg)
|
||||||
|
|
||||||
import Data.Time (ZonedTime, getCurrentTime)
|
import Data.Time (ZonedTime, getCurrentTime)
|
||||||
import Data.Time.Solar (Location(Location), sunrise, sunset)
|
import Data.Time.Solar (Location(Location), sunrise, sunset)
|
||||||
import Data.Time.RFC3339 (formatTimeRFC3339)
|
import Data.Time.RFC3339 (formatTimeRFC3339)
|
||||||
|
@ -25,47 +28,6 @@ import Network.HTTP.Request (Response(responseBody, responseStatus), get)
|
||||||
-- introduce liquid types and checking
|
-- introduce liquid types and checking
|
||||||
-- whitepaper!
|
-- 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 :: IO ZonedTime
|
||||||
now = do
|
now = do
|
||||||
utcTime <- getCurrentTime
|
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
|
main-is: Main.hs
|
||||||
|
|
||||||
-- Modules included in this executable, other than Main.
|
-- Modules included in this executable, other than Main.
|
||||||
-- other-modules:
|
other-modules: Types, Const
|
||||||
|
|
||||||
-- LANGUAGE extensions used by modules in this package.
|
-- LANGUAGE extensions used by modules in this package.
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
|
|
||||||
-- Other library packages from which modules are imported.
|
-- Other library packages from which modules are imported.
|
||||||
build-depends: base ^>=4.17.2.1,
|
build-depends: base ^>=4.17.2.1,
|
||||||
request ^>=0.2.2.0,
|
request ^>=0.2.2.0,
|
||||||
process ^>=1.6.18.0,
|
process ^>=1.6.18.0,
|
||||||
bytestring ^>=0.11.5.3,
|
bytestring ^>=0.11.5.3,
|
||||||
filepath ^>=1.4.2.2,
|
filepath ^>=1.4.2.2,
|
||||||
time ^>=1.9.3,
|
time ^>=1.9.3,
|
||||||
solar ^>=0.1.0.0,
|
solar ^>=0.1.0.0,
|
||||||
timerep ^>=2.1.0.0,
|
timerep ^>=2.1.0.0,
|
||||||
extra ^>=1.7.16,
|
extra ^>=1.7.16,
|
||||||
directory ^>=1.3.8.5
|
directory ^>=1.3.8.5
|
||||||
|
|
||||||
-- Directories containing source files.
|
-- Directories containing source files.
|
||||||
hs-source-dirs: app
|
hs-source-dirs: app
|
||||||
|
|
Loading…
Reference in a new issue