From 3376e24fc43421ed135617ae2639856f7582c69f Mon Sep 17 00:00:00 2001
From: Alexander Kobjolke <me@failco.de>
Date: Sat, 4 Jan 2025 23:16:18 +0100
Subject: [PATCH] feat: Parse command-line arguments

---
 package.yaml   |  7 +++---
 src/TK2MQTT.hs | 59 ++++++++++++++++++++++++++++++++++++++++----------
 tk2mqtt.cabal  | 19 ++++------------
 3 files changed, 54 insertions(+), 31 deletions(-)

diff --git a/package.yaml b/package.yaml
index 73e33c4..a4f5e35 100644
--- a/package.yaml
+++ b/package.yaml
@@ -11,9 +11,6 @@ extra-source-files:
 
 dependencies:
   - base >= 4.13 && < 5
-  - time
-  - directory
-  - containers
   - net-mqtt
   - network-uri
   - req
@@ -21,7 +18,7 @@ dependencies:
   - aeson
   - text
   - bytestring
-  - process
+  - optparse-applicative
 
 ghc-options:
   - -Wall
@@ -66,3 +63,5 @@ tests:
     source-dirs:
       - test/doctest
     build-tools: doctest
+    dependencies:
+      - process
diff --git a/src/TK2MQTT.hs b/src/TK2MQTT.hs
index f8603ad..e3b0e64 100644
--- a/src/TK2MQTT.hs
+++ b/src/TK2MQTT.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module TK2MQTT
   ( runTK2MQTT,
@@ -10,24 +11,50 @@ import Control.Exception (catch)
 import Control.Monad (void)
 import Control.Monad.IO.Class
 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.MQTT.Client qualified as MQTT
-import Network.URI (URI, parseURI)
-import System.Environment qualified as Env
+import Network.MQTT.Topic (mkTopic)
+import Network.URI (URI, parseURI, pathSegments)
+import Options.Applicative (eitherReader, (<**>))
+import Options.Applicative qualified as O
 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 ()
-runTK2MQTT uri (APIKey apikey) (StationID stationId) = do
-  mc <- MQTT.connectURI MQTT.mqttConfig uri
+pConfig :: O.Parser Config
+pConfig =
+  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
-    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)
-  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
+  where
+    topic = fromMaybe "home/fuel" $ case L.intercalate "/" (pathSegments brokerUrl) of
+      "" -> Nothing
+      t -> mkTopic (T.pack t)
 
 handleError :: IOError -> IO ()
 handleError e = do
@@ -35,6 +62,14 @@ handleError e = do
 
 defaultMain :: IO ()
 defaultMain = do
-  [apikey, stationId] <- Env.getArgs
-  let (Just uri) = parseURI "mqtt://hm.felis-halfmoon.ts.net"
-  runTK2MQTT uri (APIKey apikey) (StationID stationId) `catch` handleError
+  config <- O.execParser opts
+  -- [apiKey, stationId] <- Env.getArgs
+  -- 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")
diff --git a/tk2mqtt.cabal b/tk2mqtt.cabal
index 0ad3370..d89273c 100644
--- a/tk2mqtt.cabal
+++ b/tk2mqtt.cabal
@@ -32,15 +32,12 @@ library
       aeson
     , base >=4.13 && <5
     , bytestring
-    , containers
-    , directory
     , effectful
     , net-mqtt
     , network-uri
-    , process
+    , optparse-applicative
     , req
     , text
-    , time
   default-language: GHC2021
 
 executable tk2mqtt
@@ -58,15 +55,12 @@ executable tk2mqtt
       aeson
     , base >=4.13 && <5
     , bytestring
-    , containers
-    , directory
     , effectful
     , net-mqtt
     , network-uri
-    , process
+    , optparse-applicative
     , req
     , text
-    , time
     , tk2mqtt
   default-language: GHC2021
 
@@ -88,15 +82,13 @@ test-suite doctest
       aeson
     , base >=4.13 && <5
     , bytestring
-    , containers
-    , directory
     , effectful
     , net-mqtt
     , network-uri
+    , optparse-applicative
     , process
     , req
     , text
-    , time
   default-language: Haskell2010
 
 test-suite spec
@@ -120,16 +112,13 @@ test-suite spec
     , aeson
     , base >=4.13 && <5
     , bytestring
-    , containers
-    , directory
     , effectful
     , hspec
     , net-mqtt
     , network-uri
-    , process
+    , optparse-applicative
     , quickcheck-instances
     , req
     , text
-    , time
     , tk2mqtt
   default-language: GHC2021