feat: Parse command-line arguments
This commit is contained in:
parent
6603e65131
commit
3376e24fc4
3 changed files with 54 additions and 31 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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")
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue