New WeatherX variant with sky conditions translations

4 files changed, 59 insertions, 8 deletions

diff --git a/changelog.md b/changelog.md
index 34d1ef2..fd1316d 100644
--- a/changelog.md
+++ b/changelog.md
@@ -4,6 +4,8 @@ _New features_
 
   - `DiskIO`: Additional template variables for absolute number of
     bytes rather than speeds (see [issue #390].
+  - `WeatherX`: An extension to the `Weather` monitor allowing the
+    spefication of custom strings or icons for sky conditions.
 
 [issue #390]: https://github.com/jaor/xmobar/issues/390
 
diff --git a/readme.md b/readme.md
index 6834eaf..2214bda 100644
--- a/readme.md
+++ b/readme.md
@@ -739,6 +739,39 @@ something like:
 - Default template: `<station>: <tempC>C, rh <rh>% (<hour>)`
 - Retrieves weather information from http://tgftp.nws.noaa.gov.
 
+### `WeatherX StationID SkyConditions Args RefreshRate`
+
+- Works in the same way as `Weather`, but takes an additional
+  argument, a list of pairs from sky conditions to their replacement
+  (typically a unicode string or an icon specification).
+- Use the variable `skyConditionS` to display the replacement of the
+  corresponding sky condition.  All other `Weather` template variables
+  are available as well.
+
+For example:
+
+```haskell
+  WeatherX "LEBL"
+           [ ("clear", "🌣")
+           , ("sunny", "🌣")
+           , ("mostly clear", "🌤")
+           , ("mostly sunny", "🌤")
+           , ("partly sunny", "⛅")
+           , ("fair", "🌑")
+           , ("cloudy","☁")
+           , ("overcast","☁")
+           , ("partly cloudy", "⛅")
+           , ("mostly cloudy", "🌧")
+           , ("considerable cloudiness", "⛈")]
+           ["-t", "<fn=2><skyConditionS></fn> <tempC>° <rh>%  <windKmh> (<hour>)"
+           , "-L","10", "-H", "25", "--normal", "black"
+           , "--high", "lightgoldenrod4", "--low", "darkseagreen4"]
+           18000
+```
+
+As mentioned, the replacement string can also be an icon
+specification, such as `("clear", "<icon=weather-clear.xbm/>")`.
+
 ### `Network Interface Args RefreshRate`
 
 - Aliases to the interface name: so `Network "eth0" []` can be used as
diff --git a/src/Xmobar/Plugins/Monitors.hs b/src/Xmobar/Plugins/Monitors.hs
index 3e7584f..8ce5300 100644
--- a/src/Xmobar/Plugins/Monitors.hs
+++ b/src/Xmobar/Plugins/Monitors.hs
@@ -3,7 +3,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Xmobar.Plugins.Monitors
--- Copyright   :  (c) 2010, 2011, 2012, 2013, 2017, 2018 Jose Antonio Ortega Ruiz
+-- Copyright   :  (c) 2010, 2011, 2012, 2013, 2017, 2018, 2019 Jose Antonio Ortega Ruiz
 --                (c) 2007-10 Andrea Rossato
 -- License     :  BSD-style (see LICENSE)
 --
@@ -78,6 +78,7 @@ data Monitors = Network      Interface   Args Rate
               | CatInt       Int FilePath Args Rate
 #ifdef WEATHER
               | Weather      Station     Args Rate
+              | WeatherX     Station SkyConditions Args Rate
 #endif
 #ifdef UVMETER
               | UVMeter      Station     Args Rate
@@ -103,6 +104,7 @@ type Args      = [String]
 type Program   = String
 type Alias     = String
 type Station   = String
+type SkyConditions = [(String, String)]
 type Zone      = String
 type ZoneNo    = Int
 type Interface = String
@@ -112,6 +114,7 @@ type DiskSpec  = [(String, String)]
 instance Exec Monitors where
 #ifdef WEATHER
     alias (Weather s _ _) = s
+    alias (WeatherX s _ _ _) = s
 #endif
     alias (Network i _ _) = i
     alias (DynNetwork _ _) = "dynnetwork"
@@ -159,6 +162,7 @@ instance Exec Monitors where
     start (TopMem a r) = runM a topMemConfig runTopMem r
 #ifdef WEATHER
     start (Weather s a r) = runMD (a ++ [s]) weatherConfig runWeather r weatherReady
+    start (WeatherX s c a r) = runMD (a ++ [s]) weatherConfig (runWeather' c) r weatherReady
 #endif
     start (Thermal z a r) = runM (a ++ [z]) thermalConfig runThermal r
     start (ThermalZone z a r) =
diff --git a/src/Xmobar/Plugins/Monitors/Weather.hs b/src/Xmobar/Plugins/Monitors/Weather.hs
index 30439f5..fb5732b 100644
--- a/src/Xmobar/Plugins/Monitors/Weather.hs
+++ b/src/Xmobar/Plugins/Monitors/Weather.hs
@@ -23,6 +23,7 @@ import Network.HTTP.Conduit
 import Network.HTTP.Types.Status
 import Network.HTTP.Types.Method
 import qualified Data.ByteString.Lazy.Char8 as B
+import Data.Char (toLower)
 
 import Text.ParserCombinators.Parsec
 
@@ -43,6 +44,7 @@ weatherConfig = mkMConfig
        , "windMs"
        , "visibility"
        , "skyCondition"
+       , "skyConditionS"
        , "tempC"
        , "tempF"
        , "dewPointC"
@@ -194,18 +196,28 @@ getData station = CE.catch (do
     where errHandler :: CE.SomeException -> IO String
           errHandler _ = return "<Could not retrieve data>"
 
-formatWeather :: [WeatherInfo] -> Monitor String
-formatWeather [WI st ss y m d h (WindInfo wc wa wm wk wkh wms) v sk tC tF dC dF r p] =
+formatSk :: Eq p => [(p, p)] -> p -> p
+formatSk ((a,b):sks) sk = if a == sk then b else formatSk sks sk
+formatSk [] sk = sk
+
+formatWeather :: [(String,String)] -> [WeatherInfo] -> Monitor String
+formatWeather sks [WI st ss y m d h (WindInfo wc wa wm wk wkh wms) v sk tC tF dC dF r p] =
     do cel <- showWithColors show tC
        far <- showWithColors show tF
-       parseTemplate [st, ss, y, m, d, h, wc, wa, wm, wk, wkh, wms, v, sk, cel, far, show dC, show dF, show r , show p ]
-formatWeather _ = getConfigValue naString
+       let sk' = formatSk sks (map toLower sk)
+       parseTemplate [st, ss, y, m, d, h, wc, wa, wm, wk, wkh
+                     , wms, v, sk, sk', cel, far
+                     , show dC, show dF, show r , show p ]
+formatWeather _ _ = getConfigValue naString
 
 runWeather :: [String] -> Monitor String
-runWeather str =
-    do d <- io $ getData $ head str
+runWeather = runWeather' []
+
+runWeather' :: [(String, String)] -> [String] -> Monitor String
+runWeather' sks args =
+    do d <- io $ getData $ head args
        i <- io $ runP parseData d
-       formatWeather i
+       formatWeather sks i
 
 weatherReady :: [String] -> Monitor Bool
 weatherReady str = do