1 files changed, 67 insertions, 0 deletions
diff --git a/app/Sensor.hs b/app/Sensor.hs
index d0b8a0c..84f5b88 100644
--- a/app/Sensor.hs
+++ b/app/Sensor.hs
@@ -26,6 +26,7 @@ module Sensor
     date,
     time,
     wmName,
+    weatherForecast,
     wmWorkspaces,
   )
 where
@@ -34,6 +35,7 @@ import Control.Arrow
 import Control.DeepSeq
 import Control.Monad
 import Control.Monad.Reader
+import Data.Aeson
 import Data.Char
 import Data.Dynamic
 import Data.Functor.WithIndex
@@ -41,12 +43,14 @@ import Data.List
 import Data.Maybe
 import Data.Sensor qualified as S
 import Data.Set qualified as S
+import Data.String
 import Data.Time.Clock
 import Data.Time.Format
 import Data.Time.LocalTime
 import GHC.Generics (Generic)
 import Graphics.X11 qualified as X
 import Graphics.X11.Xlib.Extras qualified as X
+import Network.HTTP.Simple (addRequestHeader, getResponseBody, httpJSON)
 import Pretty qualified as P
 import Process.Shell (sh)
 import Safe
@@ -295,6 +299,69 @@ diskStat = S.sensor DiskStat
 disk :: (S.MonadSensor m) => S.Sensor m () (P.Diagram [Float])
 disk = diagram 1 diskStat
 
+data WeatherForecast = WeatherForecast deriving (Show)
+
+data Forecast = Forecast
+  { properties :: ForecastProperties
+  }
+  deriving (Generic)
+
+instance FromJSON Forecast
+
+data ForecastProperties = ForecastProperties
+  { timeseries :: [ForecastTimeserie]
+  }
+  deriving (Generic)
+
+instance FromJSON ForecastProperties
+
+data ForecastTimeserie = ForecastTimeserie
+  { data_ :: ForecastData
+  }
+  deriving (Generic)
+
+data ForecastData = ForecastData
+  { next_6_hours :: Maybe Next6Hours
+  }
+  deriving (Generic)
+
+instance FromJSON ForecastData
+
+data Next6Hours = Next6Hours
+  { summary :: Summary
+  }
+  deriving (Generic)
+
+instance FromJSON Next6Hours
+
+data Summary = Summary
+  { symbol_code :: String
+  }
+  deriving (Generic)
+
+instance FromJSON Summary
+
+instance FromJSON ForecastTimeserie where
+  parseJSON value =
+    fmap ForecastTimeserie (withObject "ForecastTimeserie" (\v -> v .: fromString "data") value)
+
+instance (S.MonadSensor m) => S.Aggregate m WeatherForecast (Maybe String) where
+  aggregate _ = forever do
+    forecast <- liftIO getForecast
+    S.yield (fmap ((.symbol_code) . (.summary)) (head forecast.properties.timeseries).data_.next_6_hours)
+    threadDelay (5 * 60 * 10 ^ 6)
+
+getForecast :: IO Forecast
+getForecast = handle (\(e :: SomeException) -> print e >> throwIO e) do
+  response <- httpJSON (addUserAgent (fromString "https://api.met.no/weatherapi/locationforecast/2.0/complete?lat=52.3759&lon=9.7320"))
+  return (getResponseBody response)
+  where
+    addUserAgent req = addRequestHeader (fromString "user-agent") (fromString "astatusbar") req
+
+weatherForecast :: (S.MonadSensor m) => S.Sensor m () (Maybe String)
+weatherForecast =
+  S.sensor WeatherForecast
+
 data CurrentTime = CurrentTime deriving (Show)
 
 instance (S.MonadSensor m) => S.Aggregate m CurrentTime UTCTime where