feat: Run in a loop
This commit is contained in:
parent
3376e24fc4
commit
99e5dbae97
3 changed files with 24 additions and 9 deletions
|
|
@ -19,6 +19,7 @@ dependencies:
|
||||||
- text
|
- text
|
||||||
- bytestring
|
- bytestring
|
||||||
- optparse-applicative
|
- optparse-applicative
|
||||||
|
- time
|
||||||
|
|
||||||
ghc-options:
|
ghc-options:
|
||||||
- -Wall
|
- -Wall
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue