diff options
| -rw-r--r-- | app/Sensor.hs | 39 |
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 |