metar: adding METAR and TAF weather parsers.
John Benediktsson
parent
59ec7f599e
commit
96ea327702
|
|
@ -0,0 +1 @@
|
|||
John Benediktsson
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,7 @@
|
|||
|
||||
USING: metar.private tools.test ;
|
||||
|
||||
IN: metar
|
||||
|
||||
{ { "RAB05" "E30" "SNB20" "E55" } }
|
||||
[ "RAB05E30SNB20E55" split-recent-weather ] unit-test
|
||||
|
|
@ -0,0 +1,731 @@
|
|||
! Copyright (C) 2013 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: accessors arrays ascii assocs calendar calendar.format
|
||||
combinators continuations csv formatting fry grouping
|
||||
http.client io io.encodings.ascii io.files io.styles kernel math
|
||||
math.extras math.parser memoize regexp sequences sorting.human
|
||||
splitting strings urls wrap.strings ;
|
||||
|
||||
IN: metar
|
||||
|
||||
TUPLE: station cccc name state country latitude longitude ;
|
||||
|
||||
C: <station> station
|
||||
|
||||
<PRIVATE
|
||||
|
||||
ERROR: bad-location str ;
|
||||
|
||||
: parse-location ( str -- n )
|
||||
"-" split dup length {
|
||||
{ 3 [ first3 [ string>number ] tri@ 60.0 / + 60.0 / + ] }
|
||||
{ 2 [ first2 [ string>number ] bi@ 60.0 / + ] }
|
||||
{ 1 [ first string>number ] }
|
||||
[ drop bad-location ]
|
||||
} case ;
|
||||
|
||||
: string>longitude ( str -- lon/f )
|
||||
dup R/ \d+-\d+(-\d+(\.\d+)?)?[WE]/ matches? [
|
||||
unclip-last
|
||||
[ parse-location ]
|
||||
[ CHAR: W = [ neg ] when ] bi*
|
||||
] [ drop f ] if ;
|
||||
|
||||
: string>latitude ( str -- lat/f )
|
||||
dup R/ \d+-\d+(-\d+(\.\d+)?)?[NS]/ matches? [
|
||||
unclip-last
|
||||
[ parse-location ]
|
||||
[ CHAR: S = [ neg ] when ] bi*
|
||||
] [ drop f ] if ;
|
||||
|
||||
: stations-data ( -- seq )
|
||||
URL" http://weather.noaa.gov/data/nsd_cccc.txt"
|
||||
http-get nip CHAR: ; [ string>csv ] with-delimiter ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
MEMO: all-stations ( -- seq )
|
||||
stations-data [
|
||||
{
|
||||
[ 0 swap nth ]
|
||||
[ 3 swap nth ]
|
||||
[ 4 swap nth ]
|
||||
[ 5 swap nth ]
|
||||
[ 7 swap nth string>latitude ]
|
||||
[ 8 swap nth string>longitude ]
|
||||
} cleave <station>
|
||||
] map ;
|
||||
|
||||
: find-by-cccc ( cccc -- station )
|
||||
all-stations swap '[ cccc>> _ = ] find nip ;
|
||||
|
||||
: find-by-country ( country -- stations )
|
||||
all-stations swap '[ country>> _ = ] filter ;
|
||||
|
||||
: find-by-state ( state -- stations )
|
||||
all-stations swap '[ state>> _ = ] filter ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
TUPLE: metar-report type station timestamp modifier wind
|
||||
visibility rvr weather sky-condition temperature dew-point
|
||||
altimeter remarks raw ;
|
||||
|
||||
CONSTANT: pressure-tendency H{
|
||||
{ "0" "increasing then decreasing" }
|
||||
{ "1" "increasing more slowly" }
|
||||
{ "2" "increasing" }
|
||||
{ "3" "increasing more quickly" }
|
||||
{ "4" "steady" }
|
||||
{ "5" "decreasing then increasing" }
|
||||
{ "6" "decreasing more slowly" }
|
||||
{ "7" "decreasing" }
|
||||
{ "8" "decreasing more quickly" }
|
||||
}
|
||||
|
||||
CONSTANT: lightning H{
|
||||
{ "CA" "cloud-air lightning" }
|
||||
{ "CC" "cloud-cloud lightning" }
|
||||
{ "CG" "cloud-ground lightning" }
|
||||
{ "IC" "in-cloud lightning" }
|
||||
}
|
||||
|
||||
CONSTANT: weather H{
|
||||
{ "BC" "patches" }
|
||||
{ "BL" "blowing" }
|
||||
{ "BR" "mist" }
|
||||
{ "DR" "low drifting" }
|
||||
{ "DS" "duststorm" }
|
||||
{ "DU" "widespread dust" }
|
||||
{ "DZ" "drizzle" }
|
||||
{ "FC" "funnel clouds" }
|
||||
{ "FG" "fog" }
|
||||
{ "FU" "smoke" }
|
||||
{ "FZ" "freezing" }
|
||||
{ "GR" "hail" }
|
||||
{ "GS" "small hail and/or snow pellets" }
|
||||
{ "HZ" "haze" }
|
||||
{ "IC" "ice crystals" }
|
||||
{ "MI" "shallow" }
|
||||
{ "PL" "ice pellets" }
|
||||
{ "PO" "well-developed dust/sand whirls" }
|
||||
{ "PR" "partial" }
|
||||
{ "PY" "spray" }
|
||||
{ "RA" "rain" }
|
||||
{ "RE" "recent" }
|
||||
{ "SA" "sand" }
|
||||
{ "SG" "snow grains" }
|
||||
{ "SH" "showers" }
|
||||
{ "SN" "snow" }
|
||||
{ "SQ" "squalls" }
|
||||
{ "SS" "sandstorm" }
|
||||
{ "TS" "thuderstorm" }
|
||||
{ "UP" "unknown" }
|
||||
{ "VA" "volcanic ash" }
|
||||
}
|
||||
|
||||
MEMO: glossary ( -- assoc )
|
||||
"vocab:metar/glossary.txt" ascii file-lines
|
||||
[ "," split1 ] H{ } map>assoc ;
|
||||
|
||||
: parse-glossary ( str -- str' )
|
||||
"/" split [
|
||||
find-numbers [
|
||||
dup number?
|
||||
[ number>string ]
|
||||
[ glossary ?at drop ] if
|
||||
] map " " join
|
||||
] map "/" join ;
|
||||
|
||||
: parse-timestamp ( str -- str' )
|
||||
[ now [ year>> ] [ month>> ] bi ] dip
|
||||
2 cut 2 cut 2 cut drop [ string>number ] tri@
|
||||
0 instant <timestamp> timestamp>rfc822 ;
|
||||
|
||||
CONSTANT: compass-directions H{
|
||||
{ 0.0 "N" }
|
||||
{ 22.5 "NNE" }
|
||||
{ 45.0 "NE" }
|
||||
{ 67.5 "ENE" }
|
||||
{ 90.0 "E" }
|
||||
{ 112.5 "ESE" }
|
||||
{ 135.0 "SE" }
|
||||
{ 157.5 "SSE" }
|
||||
{ 180.0 "S" }
|
||||
{ 202.5 "SSW" }
|
||||
{ 225.0 "SW" }
|
||||
{ 247.5 "WSW" }
|
||||
{ 270.0 "W" }
|
||||
{ 292.5 "WNW" }
|
||||
{ 315.0 "NW" }
|
||||
{ 337.5 "NNW" }
|
||||
{ 360.0 "N" }
|
||||
}
|
||||
|
||||
: direction>compass ( direction -- compass )
|
||||
22.5 round-to-step compass-directions at ;
|
||||
|
||||
: parse-compass ( str -- str' )
|
||||
string>number [ direction>compass ] keep "%s (%s°)" sprintf ;
|
||||
|
||||
: parse-direction ( str -- str' )
|
||||
dup "VRB" = [ drop "variable" ] [
|
||||
parse-compass "from %s" sprintf
|
||||
] if ;
|
||||
|
||||
: kt>mph ( kt -- mph ) 1.15077945 * ;
|
||||
|
||||
: mph>kt ( mph -- kt ) 1.15077945 / ;
|
||||
|
||||
: parse-speed ( str -- str'/f )
|
||||
string>number [
|
||||
dup kt>mph "%s knots (%.1f mph)" sprintf
|
||||
] [ f ] if* ;
|
||||
|
||||
: parse-wind ( str -- str' )
|
||||
dup "00000KT" = [ drop "calm" ] [
|
||||
3 cut "KT" ?tail drop "G" split1
|
||||
[ parse-direction ] [ parse-speed ] [ parse-speed ] tri*
|
||||
[ "%s at %s with gusts to %s " sprintf ]
|
||||
[ "%s at %s" sprintf ] if*
|
||||
] if ;
|
||||
|
||||
: parse-wind-variable ( str -- str' )
|
||||
"V" split1 [ parse-compass ] bi@
|
||||
", variable from %s to %s" sprintf ;
|
||||
|
||||
: parse-visibility ( str -- str' )
|
||||
dup first {
|
||||
{ CHAR: M [ rest "less than " ] }
|
||||
{ CHAR: P [ rest "more than " ] }
|
||||
[ drop "" ]
|
||||
} case swap "SM" ?tail drop
|
||||
CHAR: / over index [ 1 > [ 1 cut "+" glue ] when ] when*
|
||||
string>number "%s%s statute miles" sprintf ;
|
||||
|
||||
: parse-rvr ( str -- str' )
|
||||
"R" ?head drop "/" split1 "FT" ?tail drop
|
||||
"V" split1 [
|
||||
[ string>number ] bi@
|
||||
"varying between %s and %s" sprintf
|
||||
] [
|
||||
string>number "of %s" sprintf
|
||||
] if* "runway %s visibility %s ft" sprintf ;
|
||||
|
||||
: (parse-weather) ( str -- str' )
|
||||
dup "+FC" = [ drop "tornadoes or waterspouts" ] [
|
||||
dup first {
|
||||
{ CHAR: + [ rest "heavy " ] }
|
||||
{ CHAR: - [ rest "light " ] }
|
||||
[ drop f ]
|
||||
} case [
|
||||
2 group dup [ weather key? ] all?
|
||||
[ [ weather at ] map " " join ]
|
||||
[ concat parse-glossary ] if
|
||||
] dip prepend
|
||||
] if ;
|
||||
|
||||
: parse-weather ( str -- str' )
|
||||
"VC" over subseq? [ "VC" "" replace t ] [ f ] if
|
||||
[ (parse-weather) ]
|
||||
[ [ " in the vicinity" append ] when ] bi* ;
|
||||
|
||||
: parse-altitude ( str -- str' )
|
||||
string>number " at %s00 ft" sprintf ;
|
||||
|
||||
CONSTANT: sky H{
|
||||
{ "BKN" "broken" }
|
||||
{ "FEW" "few" }
|
||||
{ "OVC" "overcast" }
|
||||
{ "SCT" "scattered" }
|
||||
{ "SKC" "clear sky" }
|
||||
{ "CLR" "clear sky" }
|
||||
{ "NSC" "clear sky" }
|
||||
|
||||
{ "ACC" "altocumulus castellanus" }
|
||||
{ "ACSL" "standing lenticular altocumulus" }
|
||||
{ "CCSL" "cirrocumulus standing lenticular cloud" }
|
||||
{ "CU" "cumulus" }
|
||||
{ "SC" "stratocumulus" }
|
||||
{ "SCSL" "stratocumulus standing lenticular cloud" }
|
||||
{ "TCU" "towering cumulus" }
|
||||
}
|
||||
|
||||
: parse-sky-condition ( str -- str' )
|
||||
sky ?at [
|
||||
3 cut 3 cut
|
||||
[ sky at ]
|
||||
[ parse-altitude ]
|
||||
[ sky at [ " (%s)" sprintf ] [ f ] if* ]
|
||||
tri* 3append
|
||||
] unless ;
|
||||
|
||||
: F>C ( F -- C ) 32 - 5/9 * ;
|
||||
|
||||
: C>F ( C -- F ) 9/5 * 32 + ;
|
||||
|
||||
: parse-temperature ( str -- temp dew-point )
|
||||
"/" split1 [
|
||||
[ f ] [
|
||||
"M" ?head [ string>number ] [ [ neg ] when ] bi*
|
||||
dup C>F "%d °C (%.1f °F)" sprintf
|
||||
] if-empty
|
||||
] bi@ ;
|
||||
|
||||
: parse-altimeter ( str -- str' )
|
||||
unclip [ string>number ] [ CHAR: A = ] bi*
|
||||
[ 100 /f "%.2f Hg" sprintf ] [ "%s hPa" sprintf ] if ;
|
||||
|
||||
CONSTANT: re-timestamp R! \d{6}Z!
|
||||
CONSTANT: re-station R! \w{4}!
|
||||
CONSTANT: re-temperature R! [M]?\d{2}/([M]?\d{2})?!
|
||||
CONSTANT: re-wind R! (VRB|\d{3})\d{2,3}(G\d{2,3})?KT!
|
||||
CONSTANT: re-wind-variable R! \d{3}V\d{3}!
|
||||
CONSTANT: re-visibility R! [MP]?\d+(/\d+)?SM!
|
||||
CONSTANT: re-rvr R! R\d{2}[RLC]?/\d{4}(V\d{4})?FT!
|
||||
CONSTANT: re-weather R! [+-]?(VC)?(\w{2}|\w{4})!
|
||||
CONSTANT: re-sky-condition R! (\w{2,3}\d{3}(\w+)?|\w{3}|CAVOK)!
|
||||
CONSTANT: re-altimeter R! [AQ]\d{4}!
|
||||
|
||||
: find-one ( seq quot: ( elt -- ? ) -- seq elt/f )
|
||||
dupd find drop [ tail unclip ] [ f ] if* ; inline
|
||||
|
||||
: find-all ( seq quot: ( elt -- ? ) -- seq elts )
|
||||
[ find-one swap ] keep '[
|
||||
dup [ f ] [ first @ ] if-empty
|
||||
] [ unclip ] produce rot [ prefix ] when* ; inline
|
||||
|
||||
: metar-body ( report seq -- report )
|
||||
|
||||
[ { "METAR" "SPECI" } member? ] find-one
|
||||
[ pick type<< ] when*
|
||||
|
||||
[ re-station matches? ] find-one
|
||||
[ pick station<< ] when*
|
||||
|
||||
[ re-timestamp matches? ] find-one
|
||||
[ parse-timestamp pick timestamp<< ] when*
|
||||
|
||||
[ { "AUTO" "COR" } member? ] find-one
|
||||
[ pick modifier<< ] when*
|
||||
|
||||
[ re-wind matches? ] find-one
|
||||
[ parse-wind pick wind<< ] when*
|
||||
|
||||
[ re-wind-variable matches? ] find-one
|
||||
[ parse-wind-variable pick wind>> prepend pick wind<< ] when*
|
||||
|
||||
[ re-visibility matches? ] find-one
|
||||
[ parse-visibility pick visibility<< ] when*
|
||||
|
||||
[ re-rvr matches? ] find-all " " join
|
||||
[ parse-rvr ] map ", " join pick rvr<<
|
||||
|
||||
[ re-weather matches? ] find-all
|
||||
[ parse-weather ] map ", " join pick weather<<
|
||||
|
||||
[ re-sky-condition matches? ] find-all
|
||||
[ parse-sky-condition ] map ", " join pick sky-condition<<
|
||||
|
||||
[ re-temperature matches? ] find-one
|
||||
[
|
||||
parse-temperature
|
||||
[ pick temperature<< ]
|
||||
[ pick dew-point<< ] bi*
|
||||
] when*
|
||||
|
||||
[ re-altimeter matches? ] find-one
|
||||
[ parse-altimeter pick altimeter<< ] when*
|
||||
|
||||
drop ;
|
||||
|
||||
: signed-number ( sign value -- n )
|
||||
[ string>number ] bi@ swap zero? [ neg ] unless 10.0 / ;
|
||||
|
||||
: single-value ( str -- str' )
|
||||
1 cut signed-number ;
|
||||
|
||||
: double-value ( str -- m n )
|
||||
1 cut 3 cut [ signed-number ] dip 1 cut signed-number ;
|
||||
|
||||
: parse-1hr-temp ( str -- str' )
|
||||
"T" ?head drop dup length 4 > [
|
||||
double-value
|
||||
[ dup C>F "%.1f °C (%.1f °F)" sprintf ] bi@
|
||||
"hourly temperature %s and dew point %s" sprintf
|
||||
] [
|
||||
single-value dup C>F
|
||||
"hourly temperature %.1f °C (%.1f °F)" sprintf
|
||||
] if ;
|
||||
|
||||
: parse-6hr-max-temp ( str -- str' )
|
||||
"1" ?head drop single-value dup C>F
|
||||
"6-hour maximum temperature %.1f °C (%.1f °F)" sprintf ;
|
||||
|
||||
: parse-6hr-min-temp ( str -- str' )
|
||||
"2" ?head drop single-value dup C>F
|
||||
"6-hour minimum temperature %.1f °C (%.1f °F)" sprintf ;
|
||||
|
||||
: parse-24hr-temp ( str -- str' )
|
||||
"4" ?head drop double-value
|
||||
[ dup C>F "%.1f °C (%.1f °F)" sprintf ] bi@
|
||||
"24-hour maximum temperature %s minimum temperature %s"
|
||||
sprintf ;
|
||||
|
||||
: parse-1hr-pressure ( str -- str' )
|
||||
"5" ?head drop 1 cut single-value [ pressure-tendency at ] dip
|
||||
"hourly pressure %s %s hPa" sprintf ;
|
||||
|
||||
: parse-snow-depth ( str -- str' )
|
||||
"4/" ?head drop string>number "snow depth %s inches" sprintf ;
|
||||
|
||||
CONSTANT: low-clouds H{
|
||||
{ 1 "cumulus (fair weather)" }
|
||||
{ 2 "cumulus (towering)" }
|
||||
{ 3 "cumulonimbus (no anvil)" }
|
||||
{ 4 "stratocumulus (from cumulus)" }
|
||||
{ 5 "stratocumuls (not cumulus)" }
|
||||
{ 6 "stratus or Fractostratus (fair)" }
|
||||
{ 7 "fractocumulus / fractostratus (bad weather)" }
|
||||
{ 8 "cumulus and stratocumulus" }
|
||||
{ 9 "cumulonimbus (thunderstorm)" }
|
||||
{ -1 "not valid" }
|
||||
}
|
||||
|
||||
CONSTANT: mid-clouds H{
|
||||
{ 1 "altostratus (thin)" }
|
||||
{ 2 "altostratus (thick)" }
|
||||
{ 3 "altocumulus (thin)" }
|
||||
{ 4 "altocumulus (patchy)" }
|
||||
{ 5 "altocumulus (thickening)" }
|
||||
{ 6 "altocumulus (from cumulus)" }
|
||||
{ 7 "altocumulus (with altocumulus, altostratus, nimbostratus)" }
|
||||
{ 8 "altocumulus (with turrets)" }
|
||||
{ 9 "altocumulus (chaotic)" }
|
||||
{ -1 "above overcast" }
|
||||
}
|
||||
|
||||
CONSTANT: high-clouds H{
|
||||
{ 1 "cirrus (filaments)" }
|
||||
{ 2 "cirrus (dense)" }
|
||||
{ 3 "cirrus (often with cumulonimbus)" }
|
||||
{ 4 "cirrus (thickening)" }
|
||||
{ 5 "cirrus / cirrostratus (low in sky)" }
|
||||
{ 6 "cirrus / cirrostratus (hi in sky)" }
|
||||
{ 7 "cirrostratus (entire sky)" }
|
||||
{ 8 "cirrostratus (partial)" }
|
||||
{ 9 "cirrocumulus or cirrocumulus / cirrus / cirrostratus" }
|
||||
{ -1 "above overcast" }
|
||||
}
|
||||
|
||||
: parse-cloud-cover ( str -- str' )
|
||||
"8/" ?head drop first3 [ CHAR: 0 - ] tri@
|
||||
[ [ f ] [ low-clouds at "low clouds are %s" sprintf ] if-zero ]
|
||||
[ [ f ] [ mid-clouds at "middle clouds are %s" sprintf ] if-zero ]
|
||||
[ [ f ] [ high-clouds at "high clouds are %s" sprintf ] if-zero ]
|
||||
tri* 3array " " join ;
|
||||
|
||||
: parse-inches ( str -- str' )
|
||||
dup [ CHAR: / = ] all? [ drop "unknown" ] [
|
||||
string>number
|
||||
[ "trace" ] [ 100 /f "%.2f inches" sprintf ] if-zero
|
||||
] if ;
|
||||
|
||||
: parse-1hr-precipitation ( str -- str' )
|
||||
"P" ?head drop parse-inches
|
||||
"%s precipitation in last hour" sprintf ;
|
||||
|
||||
: parse-6hr-precipitation ( str -- str' )
|
||||
"6" ?head drop parse-inches
|
||||
"%s precipitation in last 6 hours" sprintf ;
|
||||
|
||||
: parse-24hr-precipitation ( str -- str' )
|
||||
"7" ?head drop parse-inches
|
||||
"%s precipitation in last 24 hours" sprintf ;
|
||||
|
||||
! XXX: "on the hour" instead of "00 minutes past the hour" ?
|
||||
|
||||
: parse-recent-time ( str -- str' )
|
||||
dup length 2 >
|
||||
[ 2 cut ":" glue ]
|
||||
[ " minutes past the hour" append ] if ;
|
||||
|
||||
: parse-peak-wind ( str -- str' )
|
||||
"/" split1 [ parse-wind ] [ parse-recent-time ] bi*
|
||||
"%s occuring at %s" sprintf ;
|
||||
|
||||
: parse-sea-level-pressure ( str -- str' )
|
||||
"SLP" ?head drop string>number 10.0 /f 1000 +
|
||||
"sea-level pressure is %s hPa" sprintf ;
|
||||
|
||||
: parse-lightning ( str -- str' )
|
||||
"LTG" ?head drop 2 group [ lightning at ] map " " join ;
|
||||
|
||||
CONSTANT: re-recent-weather R! ((\w{2})?[BE]\d{2,4}((\w{2})?[BE]\d{2,4})?)+!
|
||||
|
||||
: parse-began/ended ( str -- str' )
|
||||
unclip swap
|
||||
[ CHAR: B = "began" "ended" ? ]
|
||||
[ parse-recent-time ] bi* "%s at %s" sprintf ;
|
||||
|
||||
: split-recent-weather ( str -- seq )
|
||||
[ dup empty? not ] [
|
||||
dup [ digit? ] find drop
|
||||
over [ digit? not ] find-from drop
|
||||
[ cut ] [ f ] if* swap
|
||||
] produce nip ;
|
||||
|
||||
: (parse-recent-weather) ( str -- str' )
|
||||
dup [ digit? ] find drop 2 > [
|
||||
2 cut [ weather at " " append ] dip
|
||||
] [ f swap ] if parse-began/ended "" append-as ;
|
||||
|
||||
: parse-recent-weather ( str -- str' )
|
||||
split-recent-weather
|
||||
[ (parse-recent-weather) ] map " " join ;
|
||||
|
||||
: parse-varying ( str -- str' )
|
||||
"V" split1 [ string>number ] bi@
|
||||
"varying between %s00 and %s00 ft" sprintf ;
|
||||
|
||||
: parse-from-to ( str -- str' )
|
||||
"-" split [ parse-glossary ] map " to " join ;
|
||||
|
||||
: parse-water-equivalent-snow ( str -- str' )
|
||||
"933" ?head drop parse-inches
|
||||
"%s water equivalent of snow on ground" sprintf ;
|
||||
|
||||
: parse-duration-of-sunshine ( str -- str' )
|
||||
"98" ?head drop string>number
|
||||
[ "no" ] [ "%s minutes of" sprintf ] if-zero
|
||||
"%s sunshine" sprintf ;
|
||||
|
||||
: parse-6hr-snowfall ( str -- str' )
|
||||
"931" ?head drop parse-inches
|
||||
"%s snowfall in last 6 hours" sprintf ;
|
||||
|
||||
: parse-probability ( str -- str' )
|
||||
"PROB" ?head drop string>number
|
||||
"probability of %d%%" sprintf ;
|
||||
|
||||
: parse-remark ( str -- str' )
|
||||
{
|
||||
{ [ dup glossary key? ] [ glossary at ] }
|
||||
{ [ dup R! 1\d{4}! matches? ] [ parse-6hr-max-temp ] }
|
||||
{ [ dup R! 2\d{4}! matches? ] [ parse-6hr-min-temp ] }
|
||||
{ [ dup R! 4\d{8}! matches? ] [ parse-24hr-temp ] }
|
||||
{ [ dup R! 4/\d{3}! matches? ] [ parse-snow-depth ] }
|
||||
{ [ dup R! 5\d{4}! matches? ] [ parse-1hr-pressure ] }
|
||||
{ [ dup R! 6[\d/]{4}! matches? ] [ parse-6hr-precipitation ] }
|
||||
{ [ dup R! 7\d{4}! matches? ] [ parse-24hr-precipitation ] }
|
||||
{ [ dup R! 8/\d{3}! matches? ] [ parse-cloud-cover ] }
|
||||
{ [ dup R! 931\d{3}! matches? ] [ parse-6hr-snowfall ] }
|
||||
{ [ dup R! 933\d{3}! matches? ] [ parse-water-equivalent-snow ] }
|
||||
{ [ dup R! 98\d{3}! matches? ] [ parse-duration-of-sunshine ] }
|
||||
{ [ dup R! T\d{4,8}! matches? ] [ parse-1hr-temp ] }
|
||||
{ [ dup R! \d{3}\d{2,3}/\d{2,4}! matches? ] [ parse-peak-wind ] }
|
||||
{ [ dup R! P\d{4}! matches? ] [ parse-1hr-precipitation ] }
|
||||
{ [ dup R! SLP\d{3}! matches? ] [ parse-sea-level-pressure ] }
|
||||
{ [ dup R! LTG\w+! matches? ] [ parse-lightning ] }
|
||||
{ [ dup R! PROB\d+! matches? ] [ parse-probability ] }
|
||||
{ [ dup R! \d{3}V\d{3}! matches? ] [ parse-varying ] }
|
||||
{ [ dup R! [^-]+(-[^-]+)+! matches? ] [ parse-from-to ] }
|
||||
{ [ dup R! [^/]+(/[^/]+)+! matches? ] [ ] }
|
||||
{ [ dup R! \d+.\d+! matches? ] [ ] }
|
||||
{ [ dup re-recent-weather matches? ] [ parse-recent-weather ] }
|
||||
{ [ dup re-weather matches? ] [ parse-weather ] }
|
||||
{ [ dup re-sky-condition matches? ] [ parse-sky-condition ] }
|
||||
[ parse-glossary ]
|
||||
} cond ;
|
||||
|
||||
: metar-remarks ( report seq -- report )
|
||||
[ parse-remark ] map " " join >>remarks ;
|
||||
|
||||
: <metar-report> ( metar -- report )
|
||||
[ metar-report new ] dip [ >>raw ] keep
|
||||
[ blank? ] split-when { "RMK" } split1
|
||||
[ metar-body ] [ metar-remarks ] bi* ;
|
||||
|
||||
: row. ( name quot -- )
|
||||
'[
|
||||
[ _ write ] with-cell
|
||||
[ @ [ 65 wrap-string write ] when* ] with-cell
|
||||
] with-row ; inline
|
||||
|
||||
: metar-report. ( report -- )
|
||||
standard-table-style [
|
||||
{
|
||||
[ "Station" [ station>> ] row. ]
|
||||
[ "Timestamp" [ timestamp>> ] row. ]
|
||||
[ "Wind" [ wind>> ] row. ]
|
||||
[ "Visibility" [ visibility>> ] row. ]
|
||||
[ "RVR" [ rvr>> ] row. ]
|
||||
[ "Weather" [ weather>> ] row. ]
|
||||
[ "Sky condition" [ sky-condition>> ] row. ]
|
||||
[ "Temperature" [ temperature>> ] row. ]
|
||||
[ "Dew point" [ dew-point>> ] row. ]
|
||||
[ "Altimeter" [ altimeter>> ] row. ]
|
||||
[ "Remarks" [ remarks>> ] row. ]
|
||||
[ "Raw Text" [ raw>> ] row. ]
|
||||
} cleave
|
||||
] tabular-output nl ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
GENERIC: metar ( station -- metar )
|
||||
|
||||
M: station metar cccc>> metar ;
|
||||
|
||||
M: string metar
|
||||
"http://weather.noaa.gov/pub/data/observations/metar/stations/%s.TXT"
|
||||
sprintf http-get nip ;
|
||||
|
||||
GENERIC: metar. ( station -- )
|
||||
|
||||
M: station metar. cccc>> metar. ;
|
||||
|
||||
M: string metar.
|
||||
[ metar <metar-report> metar-report. ]
|
||||
[ drop "%s METAR not found\n" printf ] recover ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: parse-wind-shear ( str -- str' )
|
||||
"WS" ?head drop "/" split1
|
||||
[ parse-altitude ] [ parse-wind ] bi* prepend
|
||||
"wind shear " prepend ;
|
||||
|
||||
CONSTANT: re-from-timestamp R! FM\d{6}!
|
||||
|
||||
: parse-from-timestamp ( str -- str' )
|
||||
"FM" ?head drop parse-timestamp ;
|
||||
|
||||
CONSTANT: re-valid-timestamp R! \d{4}\/\d{4}!
|
||||
|
||||
: parse-valid-timestamp ( str -- str' )
|
||||
"/" split1 [ "00" append parse-timestamp ] bi@ " to " glue ;
|
||||
|
||||
TUPLE: taf-report station timestamp valid-timestamp wind
|
||||
visibility rvr weather sky-condition partials raw ;
|
||||
|
||||
TUPLE: taf-partial from-timestamp wind visibility rvr weather
|
||||
sky-condition raw ;
|
||||
|
||||
: taf-body ( report str -- report )
|
||||
[ blank? ] split-when
|
||||
|
||||
[ { "AMD" "COR" "RTD" } member? ] find-one drop
|
||||
|
||||
[ re-station matches? ] find-one
|
||||
[ pick station<< ] when*
|
||||
|
||||
[ re-timestamp matches? ] find-one
|
||||
[ parse-timestamp pick timestamp<< ] when*
|
||||
|
||||
[ re-valid-timestamp matches? ] find-one
|
||||
[ parse-valid-timestamp pick valid-timestamp<< ] when*
|
||||
|
||||
[ re-wind matches? ] find-one
|
||||
[ parse-wind pick wind<< ] when*
|
||||
|
||||
[ re-wind-variable matches? ] find-one
|
||||
[ parse-wind-variable pick wind>> prepend pick wind<< ] when*
|
||||
|
||||
[ re-visibility matches? ] find-one
|
||||
[ parse-visibility pick visibility<< ] when*
|
||||
|
||||
[ re-rvr matches? ] find-all " " join
|
||||
[ parse-rvr ] map ", " join pick rvr<<
|
||||
|
||||
[ re-weather matches? ] find-all
|
||||
[ parse-weather ] map ", " join pick weather<<
|
||||
|
||||
[ re-sky-condition matches? ] find-all
|
||||
[ parse-sky-condition ] map ", " join pick sky-condition<<
|
||||
|
||||
drop ;
|
||||
|
||||
: <taf-partial> ( str -- partial )
|
||||
[ taf-partial new ] dip [ blank? ] split-when
|
||||
|
||||
[ re-from-timestamp matches? ] find-one
|
||||
[ parse-from-timestamp pick from-timestamp<< ] when*
|
||||
|
||||
[ re-wind matches? ] find-one
|
||||
[ parse-wind pick wind<< ] when*
|
||||
|
||||
[ re-wind-variable matches? ] find-one
|
||||
[ parse-wind-variable pick wind>> prepend pick wind<< ] when*
|
||||
|
||||
[ re-visibility matches? ] find-one
|
||||
[ parse-visibility pick visibility<< ] when*
|
||||
|
||||
[ re-rvr matches? ] find-all " " join
|
||||
[ parse-rvr ] map ", " join pick rvr<<
|
||||
|
||||
[ re-weather matches? ] find-all
|
||||
[ parse-weather ] map ", " join pick weather<<
|
||||
|
||||
[ re-sky-condition matches? ] find-all
|
||||
[ parse-sky-condition ] map ", " join pick sky-condition<<
|
||||
|
||||
drop ;
|
||||
|
||||
: taf-partials ( report seq -- report )
|
||||
[ <taf-partial> ] map >>partials ;
|
||||
|
||||
: <taf-report> ( taf -- report )
|
||||
[ taf-report new ] dip [ >>raw ] keep
|
||||
string-lines [ [ blank? ] trim ] map
|
||||
rest dup first "TAF" = [ rest ] when
|
||||
harvest unclip swap
|
||||
[ taf-body ] [ taf-partials ] bi* ;
|
||||
|
||||
: taf-report. ( report -- )
|
||||
[
|
||||
standard-table-style [
|
||||
{
|
||||
[ "Station" [ station>> ] row. ]
|
||||
[ "Timestamp" [ timestamp>> ] row. ]
|
||||
[ "Valid From" [ valid-timestamp>> ] row. ]
|
||||
[ "Wind" [ wind>> ] row. ]
|
||||
[ "Visibility" [ visibility>> ] row. ]
|
||||
[ "RVR" [ rvr>> ] row. ]
|
||||
[ "Weather" [ weather>> ] row. ]
|
||||
[ "Sky condition" [ sky-condition>> ] row. ]
|
||||
[ "Raw Text" [ raw>> ] row. ]
|
||||
} cleave
|
||||
] tabular-output nl
|
||||
] [
|
||||
partials>> [
|
||||
standard-table-style [
|
||||
{
|
||||
[ "From" [ from-timestamp>> ] row. ]
|
||||
[ "Wind" [ wind>> ] row. ]
|
||||
[ "Visibility" [ visibility>> ] row. ]
|
||||
[ "RVR" [ rvr>> ] row. ]
|
||||
[ "Weather" [ weather>> ] row. ]
|
||||
[ "Sky condition" [ sky-condition>> ] row. ]
|
||||
} cleave
|
||||
] tabular-output nl
|
||||
] each
|
||||
] bi ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
GENERIC: taf ( station -- taf )
|
||||
|
||||
M: station taf cccc>> taf ;
|
||||
|
||||
M: string taf
|
||||
"http://weather.noaa.gov/pub/data/forecasts/taf/stations/%s.TXT"
|
||||
sprintf http-get nip ;
|
||||
|
||||
GENERIC: taf. ( station -- )
|
||||
|
||||
M: station taf. cccc>> taf. ;
|
||||
|
||||
M: string taf.
|
||||
[ taf <taf-report> taf-report. ]
|
||||
[ drop "%s TAF not found\n" printf ] recover ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
METAR and TAF weather parsers
|
||||
Loading…
Reference in New Issue