feat: Parse command-line arguments

This commit is contained in:
Alexander Kobjolke 2025-01-04 23:16:18 +01:00
parent 6603e65131
commit 3376e24fc4
3 changed files with 54 additions and 31 deletions

View file

@ -11,9 +11,6 @@ extra-source-files:
dependencies: dependencies:
- base >= 4.13 && < 5 - base >= 4.13 && < 5
- time
- directory
- containers
- net-mqtt - net-mqtt
- network-uri - network-uri
- req - req
@ -21,7 +18,7 @@ dependencies:
- aeson - aeson
- text - text
- bytestring - bytestring
- process - optparse-applicative
ghc-options: ghc-options:
- -Wall - -Wall
@ -66,3 +63,5 @@ tests:
source-dirs: source-dirs:
- test/doctest - test/doctest
build-tools: doctest build-tools: doctest
dependencies:
- process

View file

@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module TK2MQTT module TK2MQTT
( runTK2MQTT, ( runTK2MQTT,
@ -10,24 +11,50 @@ import Control.Exception (catch)
import Control.Monad (void) import Control.Monad (void)
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Data.Aeson import Data.Aeson
import Data.List qualified as L
import Data.Maybe (fromMaybe)
import Data.Text qualified as T
import Network.HTTP.Req import Network.HTTP.Req
import Network.MQTT.Client qualified as MQTT import Network.MQTT.Client qualified as MQTT
import Network.URI (URI, parseURI) import Network.MQTT.Topic (mkTopic)
import System.Environment qualified as Env import Network.URI (URI, parseURI, pathSegments)
import Options.Applicative (eitherReader, (<**>))
import Options.Applicative qualified as O
import System.IO import System.IO
newtype APIKey = APIKey String data Config = Config
{ apiKey :: !String,
stationId :: !String,
brokerUrl :: !URI
}
deriving (Show)
newtype StationID = StationID String uriReader :: O.ReadM URI
uriReader = eitherReader $ \arg ->
case parseURI arg of
Nothing -> Left ("Cannot parse URI: " <> arg)
Just uri -> Right uri -- "mqtt://100.101.208.5"
runTK2MQTT :: URI -> APIKey -> StationID -> IO () pConfig :: O.Parser Config
runTK2MQTT uri (APIKey apikey) (StationID stationId) = do pConfig =
mc <- MQTT.connectURI MQTT.mqttConfig uri Config
<$> O.strOption (O.long "api-key" <> O.metavar "APIKEY" <> O.help "Tankerkönig API key")
<*> O.strOption (O.long "station-id" <> O.metavar "STATION" <> O.help "ID of the station to query the prices for")
<*> O.option uriReader (O.long "broker" <> O.metavar "URL" <> O.help "URL of the MQTT broker, e.g. mqtt://127.0.0.1:1883")
runTK2MQTT :: Config -> IO ()
runTK2MQTT Config {..} = do
mc <- MQTT.connectURI MQTT.mqttConfig brokerUrl
result <- runReq defaultHttpConfig $ do result <- runReq defaultHttpConfig $ do
r <- req GET (https "creativecommons.tankerkoenig.de" /: "json" /: "prices.php") NoReqBody jsonResponse ("apikey" =: apikey <> "ids" =: stationId) r <- req GET (https "creativecommons.tankerkoenig.de" /: "json" /: "prices.php") NoReqBody jsonResponse ("apikey" =: apiKey <> "ids" =: stationId)
pure (responseBody r :: Value) pure (responseBody r :: Value)
void $ liftIO $ MQTT.publish mc "tmp/fuel/diesel" (encode result) True void $ liftIO $ MQTT.publish mc topic (encode result) True
void $ liftIO $ print topic
void $ liftIO $ print $ encode result void $ liftIO $ print $ encode result
where
topic = fromMaybe "home/fuel" $ case L.intercalate "/" (pathSegments brokerUrl) of
"" -> Nothing
t -> mkTopic (T.pack t)
handleError :: IOError -> IO () handleError :: IOError -> IO ()
handleError e = do handleError e = do
@ -35,6 +62,14 @@ handleError e = do
defaultMain :: IO () defaultMain :: IO ()
defaultMain = do defaultMain = do
[apikey, stationId] <- Env.getArgs config <- O.execParser opts
let (Just uri) = parseURI "mqtt://hm.felis-halfmoon.ts.net" -- [apiKey, stationId] <- Env.getArgs
runTK2MQTT uri (APIKey apikey) (StationID stationId) `catch` handleError -- let (Just brokerUrl) = parseURI "mqtt://100.101.208.5"
-- config = Config{..}
runTK2MQTT config `catch` handleError
where
opts :: O.ParserInfo Config
opts =
O.info
(pConfig <**> O.helper)
(O.fullDesc <> O.progDesc "Retrieve fuel prices from tankerkönig and publish them to MQTT")

View file

@ -32,15 +32,12 @@ library
aeson aeson
, base >=4.13 && <5 , base >=4.13 && <5
, bytestring , bytestring
, containers
, directory
, effectful , effectful
, net-mqtt , net-mqtt
, network-uri , network-uri
, process , optparse-applicative
, req , req
, text , text
, time
default-language: GHC2021 default-language: GHC2021
executable tk2mqtt executable tk2mqtt
@ -58,15 +55,12 @@ executable tk2mqtt
aeson aeson
, base >=4.13 && <5 , base >=4.13 && <5
, bytestring , bytestring
, containers
, directory
, effectful , effectful
, net-mqtt , net-mqtt
, network-uri , network-uri
, process , optparse-applicative
, req , req
, text , text
, time
, tk2mqtt , tk2mqtt
default-language: GHC2021 default-language: GHC2021
@ -88,15 +82,13 @@ test-suite doctest
aeson aeson
, base >=4.13 && <5 , base >=4.13 && <5
, bytestring , bytestring
, containers
, directory
, effectful , effectful
, net-mqtt , net-mqtt
, network-uri , network-uri
, optparse-applicative
, process , process
, req , req
, text , text
, time
default-language: Haskell2010 default-language: Haskell2010
test-suite spec test-suite spec
@ -120,16 +112,13 @@ test-suite spec
, aeson , aeson
, base >=4.13 && <5 , base >=4.13 && <5
, bytestring , bytestring
, containers
, directory
, effectful , effectful
, hspec , hspec
, net-mqtt , net-mqtt
, network-uri , network-uri
, process , optparse-applicative
, quickcheck-instances , quickcheck-instances
, req , req
, text , text
, time
, tk2mqtt , tk2mqtt
default-language: GHC2021 default-language: GHC2021