feat: Run in a loop

This commit is contained in:
Alexander Kobjolke 2025-01-10 23:23:34 +01:00
parent 3376e24fc4
commit 99e5dbae97
3 changed files with 24 additions and 9 deletions

View file

@ -19,6 +19,7 @@ dependencies:
- text
- bytestring
- optparse-applicative
- time
ghc-options:
- -Wall

View file

@ -7,16 +7,20 @@ module TK2MQTT
)
where
import Control.Concurrent (threadDelay)
import Control.Exception (catch)
import Control.Monad (void)
import Control.Monad.IO.Class
import Control.Monad (forever, void)
import Data.Aeson
import Data.ByteString.Lazy qualified as BL
import Data.List qualified as L
import Data.Maybe (fromMaybe)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Time (getCurrentTime)
import Data.Time.Format.ISO8601 (iso8601Show)
import Network.HTTP.Req
import Network.MQTT.Client qualified as MQTT
import Network.MQTT.Topic (mkTopic)
import Network.MQTT.Topic (Topic (..), mkTopic)
import Network.URI (URI, parseURI, pathSegments)
import Options.Applicative (eitherReader, (<**>))
import Options.Applicative qualified as O
@ -45,16 +49,22 @@ pConfig =
runTK2MQTT :: Config -> IO ()
runTK2MQTT Config {..} = do
mc <- MQTT.connectURI MQTT.mqttConfig brokerUrl
result <- runReq defaultHttpConfig $ do
r <- req GET (https "creativecommons.tankerkoenig.de" /: "json" /: "prices.php") NoReqBody jsonResponse ("apikey" =: apiKey <> "ids" =: stationId)
pure (responseBody r :: Value)
void $ liftIO $ MQTT.publish mc topic (encode result) True
void $ liftIO $ print topic
void $ liftIO $ print $ encode result
T.putStrLn $ "Publishing to " <> unTopic topic
forever $ do
now <- iso8601Show <$> getCurrentTime
result <- runReq defaultHttpConfig $ do
r <- req GET (https "creativecommons.tankerkoenig.de" /: "json" /: "prices.php") NoReqBody jsonResponse ("apikey" =: apiKey <> "ids" =: stationId)
pure (responseBody r :: Value)
void $ MQTT.publish mc topic (encode result) True
putStr $ now <> " = "
BL.putStr $ encode result
putStrLn ""
threadDelay oneHour
where
topic = fromMaybe "home/fuel" $ case L.intercalate "/" (pathSegments brokerUrl) of
"" -> Nothing
t -> mkTopic (T.pack t)
oneHour = 60 * 60 * 1_000_000
handleError :: IOError -> IO ()
handleError e = do

View file

@ -38,6 +38,7 @@ library
, optparse-applicative
, req
, text
, time
default-language: GHC2021
executable tk2mqtt
@ -61,6 +62,7 @@ executable tk2mqtt
, optparse-applicative
, req
, text
, time
, tk2mqtt
default-language: GHC2021
@ -89,6 +91,7 @@ test-suite doctest
, process
, req
, text
, time
default-language: Haskell2010
test-suite spec
@ -120,5 +123,6 @@ test-suite spec
, quickcheck-instances
, req
, text
, time
, tk2mqtt
default-language: GHC2021