1 files changed, 29 insertions, 10 deletions
diff --git a/app/Sensor.hs b/app/Sensor.hs
index 512870b..a9acf15 100644
--- a/app/Sensor.hs
+++ b/app/Sensor.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE PartialTypeSignatures #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -50,7 +51,7 @@ 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 Network.HTTP.Simple
 import Pretty qualified as P
 import Process.Shell (sh)
 import Safe
@@ -300,7 +301,7 @@ diskStat = S.sensor DiskStat
 disk :: (S.MonadSensor m) => S.Sensor m () (P.Diagram [Float])
 disk = diagram 1 diskStat
 
-data WeatherForecast = WeatherForecast deriving (Show)
+data WeatherForecast = WeatherForecast LocationData deriving (Show)
 
 data Forecast = Forecast
   { properties :: ForecastProperties
@@ -347,27 +348,45 @@ instance FromJSON ForecastTimeserie where
     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
+  aggregate (WeatherForecast location) = forever do
+    forecast <- liftIO (getForecast location)
     S.yield (fmap ((.symbol_code) . (.summary)) (head forecast.properties.timeseries).data_.next_6_hours)
-    threadDelay (5 * 60 * 10 ^ 6)
+    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)
+getForecast :: LocationData -> IO Forecast
+getForecast LocationData {..} = do
+  fmap getResponseBody . httpJSON . addUserAgent . fromString $
+    printf "https://api.met.no/weatherapi/locationforecast/2.0/complete?lat=%f&lon=%f" latitude longitude
   where
     addUserAgent req = addRequestHeader (fromString "user-agent") (fromString "astatusbar") req
 
 weatherForecast :: (S.MonadSensor m) => S.Sensor m () (Maybe String)
 weatherForecast = do
-  value <- S.sensor WeatherForecast
+  value <- S.sensor . WeatherForecast =<< location
   return
     ( case value of
         Just "partlycloudy_night" -> Just "\xe37e"
         _ -> value
     )
 
+data Location = Location deriving (Show)
+
+location :: (S.MonadSensor m) => S.Sensor m () LocationData
+location = S.sensor Location
+
+data LocationData = LocationData
+  { latitude :: Float,
+    longitude :: Float
+  }
+  deriving (Generic, Show)
+
+instance FromJSON LocationData
+
+instance (S.MonadSensor m) => S.Aggregate m Location LocationData where
+  aggregate _ = forever do
+    S.yield . getResponseBody =<< liftIO (httpJSON (fromString "https://reallyfreegeoip.org/json/?fields=lat,lon"))
+    threadDelay (5 * 60 * 10 ^ 6)
+
 data CurrentTime = CurrentTime deriving (Show)
 
 instance (S.MonadSensor m) => S.Aggregate m CurrentTime UTCTime where