factor/extra/metar/metar.factor

! 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 taf-body taf-partials ;

: 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 ;