diff options
| -rwxr-xr-x | extras/HOME/.xmonad/xmobar-weather | 103 | ||||
| -rwxr-xr-x | install.sh | 5 | ||||
| -rw-r--r-- | package.yaml | 7 | ||||
| -rw-r--r-- | xmobar/extras/weather/src/Main.hs | 213 |
4 files changed, 225 insertions, 103 deletions
diff --git a/extras/HOME/.xmonad/xmobar-weather b/extras/HOME/.xmonad/xmobar-weather deleted file mode 100755 index b95fadb..0000000 --- a/extras/HOME/.xmonad/xmobar-weather +++ /dev/null @@ -1,103 +0,0 @@ -#!/usr/bin/perl - -use Time::Local; -use POSIX; - -$content = `curl https://ipinfo.io`; - -die "Unable to get IP info" unless defined $content; - -($city, $lat, $lon) = - ($content =~ m/.*"city":\s+"([^"]+)".*"loc":\s+"(-?[0-9.]+),(-?[0-9.]+).*"/ims); - -$content = `curl "https://api.sunrise-sunset.org/json?lat=$lat&lng=$lon&formatted=0"`; - -die "Unable to get sunrise/sunset data" unless defined $content; - -if (length($content) == 0) { - printf("<fc=#404040></fc> "); - exit -} - -$sunrise_str=$content; -$sunset_str=$content; -$sunrise_str =~ s#.*"sunrise":"([^"]*)".*#\1#; -$sunset_str =~ s#.*"sunset":"([^"]*)".*#\1#; -$current_str=strftime "%Y-%m-%dT%H:%M:%S+00:00", gmtime(); - -$content = `curl "https://tgftp.nws.noaa.gov/data/observations/metar/decoded/KLMO.TXT"`; - -die "Unable to get weather data" unless defined $content; - -$sky_conditions = $content; -$sky_conditions =~ s#.*Sky conditions:\s+([^\n]+).*#\1#ims; -$sky_conditions =~ s#\s#_#g; - -$wind = $content; -$wind =~ s#.*Wind:\s+([^\n]+).*#\1#ims; -($wind_direction, $wind_speed) = - ($wind =~ m/from the ([A-Z]+).*at (\d+) MPH.*/g); - - -$temp = $content; -$temp =~ s#.*Temperature:\s+(-?[0-9.]+) F.*#\1#ims; - -if ($current_str gt $sunrise_str and $current_str lt $sunset_str) { - $is_day = 1; -} else { - $is_day = 0; -} - -%directions = ( - NE => "", - NNE => "", - ENE => "", - SE => "", - SSE => "", - ESE => "", - NW => "", - NNW => "", - WNW => "", - SW => "", - SSW => "", - WSW => "", - N => "", - S => "", - W => "", - E => "" ); - -$dir=%directions{$wind_direction}; - -%conditions_day = ( - clear => "<fc=#ddcf04></fc> ", - sunny => "<fc=#ddcf04></fc> ", - mostly_clear => "<fc=#00a3c4></fc> ", - mostly_sunny => "<fc=#ddcf04></fc> ", - partly_sunny => "<fc=#ddcf04></fc> ", - fair => "<fc=#a0a0a0>🌑</fc> ", - cloudy =>"<fc=#a0a0a0>摒</fc> ", - overcast =>"<fc=#808080></fc> ", - partly_cloudy => "<fc=#a0a0a0>杖</fc> ", - mostly_cloudy => "<fc=#808080></fc> ", - considerable_cloudiness => "<fc=#a0a0a0>ﭽ</fc> " ); - -%conditions_night = ( - clear => "<fc=#00a3c4></fc> ", - sunny => "<fc=#00a3c4></fc> ", - mostly_clear => "<fc=#00a3c4></fc> ", - mostly_sunny => "<fc=#00a3c4></fc> ", - partly_sunny => "<fc=#00a3c4></fc> ", - fair => "<fc=#808080>🌑</fc> ", - cloudy =>"<fc=#808080>摒</fc> ", - overcast =>"<fc=#404040></fc> ", - partly_cloudy => "<fc=#a0a0a0></fc> ", - mostly_cloudy => "<fc=#808080></fc> ", - considerable_cloudiness => "<fc=#a0a0a0>ﭽ</fc> " ); - -if ($is_day) { - $conditions = %conditions_day{$sky_conditions}; -} else { - $conditions = %conditions_night{$sky_conditions}; -} - -printf("<fc=#a0a0a0><fn=3>$city</fn> <fn=3>$dir</fn> <fn=3>${wind_speed}</fn></fc> <fn=8>$conditions</fn><fn=3><fc=#a0a0a0>%.0f°F</fc></fn>\n", $temp); @@ -1,5 +1,7 @@ #!/bin/bash +stack build + real_dir=$(dirname $(readlink -f "$0")) cd "$real_dir" @@ -13,6 +15,9 @@ cc -o \ xmobar/extras/battery/battery.c \ -lm +ln -sf "$(stack path --local-install-root)/bin/xmobar-weather" build/extras/HOME/.xmonad/xmobar-weather +ln -sf "$(stack path --local-install-root)/bin/xmobar-weather" extras/HOME/.xmonad/xmobar-weather + GLOBIGNORE=".:.." shopt -u dotglob diff --git a/package.yaml b/package.yaml index 07a09df..81ba046 100644 --- a/package.yaml +++ b/package.yaml @@ -6,6 +6,10 @@ executables: main: Main.hs source-dirs: src + xmobar-weather: + main: Main.hs + source-dirs: xmobar/extras/weather/src + ghc-options: - -XBangPatterns - -XDataKinds @@ -44,3 +48,6 @@ dependencies: - linear - time - prettyprinter + - aeson + - curl + - text diff --git a/xmobar/extras/weather/src/Main.hs b/xmobar/extras/weather/src/Main.hs new file mode 100644 index 0000000..aa5a408 --- /dev/null +++ b/xmobar/extras/weather/src/Main.hs @@ -0,0 +1,213 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StrictData #-} + +module Main where + +import Control.Monad (when) +import Control.Monad.Writer hiding (getFirst) +import Data.Aeson +import Data.Aeson.Types (Parser) +import qualified Data.ByteString.Lazy.Char8 +import qualified Data.Char +import qualified Data.Map +import Data.Maybe (fromMaybe) +import qualified Data.Text +import GHC.Generics +import Network.Curl +import System.Exit (exitFailure) +import System.IO (hPutStrLn, stderr) +import Text.Printf (printf) + +-- Date time that easily comparable. +data SillyTime = SillyTime + { sillyTimeDate :: String, + sillyTimeAMPM :: String, + sillyTimeTime :: String + } + deriving (Ord, Eq, Show) + +data CurrentCondition = CurrentCondition + { feelsLikeF :: String, + cloudCover :: String, + humidity :: String, + tempF :: String, + weatherDesc :: String, + windspeedMiles :: String, + winddir :: String, + observationTime :: SillyTime + } + deriving (Generic, Show) + +newtype NearestArea = NearestArea + { areaName :: String + } + deriving (Generic, Show) + +data Astronomy = Astronomy + { sunrise :: SillyTime, + sunset :: SillyTime + } + deriving (Generic, Show) + +data Weather = Weather + { currentCondition :: CurrentCondition, + nearestArea :: NearestArea, + astronomy :: Astronomy + } + deriving (Generic, Show) + +getFirst :: Parser [a] -> Parser a +getFirst ls = do + l <- ls + case l of + (a : _) -> return a + [] -> fail "No current conditions" + +instance FromJSON CurrentCondition where + parseJSON = withObject "CurrentCondition" $ \v -> + CurrentCondition <$> v .: "FeelsLikeF" + <*> v .: "cloudcover" + <*> v .: "humidity" + <*> v .: "temp_F" + <*> ( withArray + "WeatherDescriptions" + ( \vs -> do + concat <$> mapM (withObject "Description" (.: "value")) vs + ) + =<< (v .: "weatherDesc") + ) + <*> v .: "windspeedMiles" + <*> v .: "winddir16Point" + <*> ( withText + "observationTime" + ( \txt -> case Data.Text.unpack <$> Data.Text.words txt of + [a, b, c] -> return (SillyTime a c b) + _ -> fail $ printf "1 Failed to parse SillyTime [%s]" (Data.Text.unpack txt) + ) + =<< (v .: "localObsDateTime") + ) + +instance FromJSON NearestArea where + parseJSON = withObject "NearestArea" $ \v -> + fmap NearestArea $ do + (areaNames :: [Object]) <- v .: "areaName" + concat <$> mapM (.: "value") areaNames + +parseAstronomy :: String -> Value -> Parser Astronomy +parseAstronomy date = withObject "Astronomy" $ \v -> + Astronomy <$> (withText "sunrise" toSillyTime =<< (v .: "sunrise")) <*> (withText "sunset" toSillyTime =<< (v .: "sunset")) + where + toSillyTime str = + case Data.Text.unpack <$> Data.Text.words str of + [a, b] -> return $ SillyTime date b a + _ -> fail $ printf "2 Failed to parse SillyTime [%s]" (Data.Text.unpack str) + +instance FromJSON Weather where + parseJSON = withObject "Weather" $ \v -> + Weather + <$> getFirst (v .: "current_condition") + <*> getFirst (v .: "nearest_area") + <*> ( withObject + "Timeline" + ( \v -> do + d <- v .: "date" + parseAstronomy d =<< getFirst (v .: "astronomy") + ) + =<< getFirst (v .: "weather") + ) + +conditionsIconDay :: Data.Map.Map String String +conditionsIconDay = + Data.Map.fromList + [ ("overcast", fc "#808080" "\63070"), + ("fair", fc "a0a0a0" "🌑"), + ("clear", fc "#ddcf04" "\58125"), + ("sunny", fc "#ddcf04" "\58125"), + ("mostly clear", fc "#00a3c4" "\57894"), + ("mostly sunny", fc "#ddcf04" "\58124"), + ("partly sunny", fc "#ddcf04" "\58124"), + ("fair", fc "#a0a0a0" "\127761"), + ("cloudy", fc "#a0a0a0" "\64143"), + ("overcast", fc "#808080" "\63070"), + ("partly cloudy", fc "#a0a0a0" "\64148"), + ("mostly cloudy", fc "#808080" "\63070"), + ("considerable cloudiness", fc "#a0a0a0" "\64381") + ] + +conditionsIconNight :: Data.Map.Map String String +conditionsIconNight = + Data.Map.fromList + [ ("clear", fc "#00a3c4" "\61830"), + ("sunny", fc "#00a3c4" "\61830"), + ("mostly clear", fc "#00a3c4" "\57894"), + ("mostly sunny", fc "#00a3c4" "\57894"), + ("partly sunny", fc "#00a3c4" "\57894"), + ("fair", fc "#808080" "\127761"), + ("cloudy", fc "#808080" "\64143"), + ("overcast", fc "#404040" "\63070"), + ("partly cloudy", fc "#a0a0a0" "\57894"), + ("mostly cloudy", fc "#808080" "\63070"), + ("considerable cloudiness", fc "#a0a0a0" "\64381") + ] + +handleWeather :: Weather -> String +handleWeather w = execWriter $ do + tell $ lightGrey $ fn 3 $ areaName (nearestArea w) + tell " " + tell $ + lightGrey $ + fn 3 $ + case winddir (currentCondition w) of + "NE" -> "\62785" + "NNE" -> "\62785" + "ENE" -> "\62785" + "SE" -> "\62810" + "SSE" -> "\62810" + "ESE" -> "\62810" + "NW" -> "\62786" + "NNW" -> "\62786" + "WNW" -> "\62786" + "SW" -> "\62811" + "SSW" -> "\62811" + "WSW" -> "\62811" + "N" -> "\62788" + "S" -> "\62812" + "W" -> "\62803" + "E" -> "\62796" + _ -> "?" + + tell " " + tell $ lightGrey $ fn 3 $ windspeedMiles (currentCondition w) ++ "mph" + tell " " + + let conditions = if isNight then conditionsIconNight else conditionsIconDay + tell $ + fn 5 $ + fromMaybe "?" $ + Data.Map.lookup (map Data.Char.toLower $ weatherDesc (currentCondition w)) conditions + + tell " " + tell $ lightGrey $ fn 3 $ printf "%s°F" (tempF $ currentCondition w) + where + isNight = + observationTime (currentCondition w) < sunrise (astronomy w) + || observationTime (currentCondition w) > sunset (astronomy w) + + lightGrey = fc "#a0a0a0" + + fn :: Int -> String -> String + fn = printf "<fn=%d>%s</fn>" + +fc :: String -> String -> String +fc = printf "<fc=%s>%s</fc>" + +main :: IO () +main = do + (code, resp) <- curlGetString "https://wttr.in?format=j2" [] + when (code /= CurlOK) exitFailure + + case eitherDecode (Data.ByteString.Lazy.Char8.pack resp) of + Left err -> hPutStrLn stderr $ printf "Failure to parse [%s]" err + Right weather -> putStrLn $ handleWeather weather |