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 - text
- bytestring - bytestring
- optparse-applicative - optparse-applicative
- time
ghc-options: ghc-options:
- -Wall - -Wall

View file

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

View file

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