open Unix;;

(*seventolist: string string string string string string string -> listofstrings *)

let seventolist a b c d e f g = 
    a :: b :: c :: d :: e :: f :: g :: [] ;;


(* let mylist = seventolist "1 " "2 " "3 " "4 " "5 " "6 " "7 ";; *)
(* should be val mylist : string list = ["1 "; "2 "; "3 "; "4 "; "5 "; "6 "; "7 "] *)

(* stringto_seven_list: string -> list of tokens *)

let stringto_seven_list string =
  try
    let buf = Scanf.Scanning.from_string string in
    Scanf.bscanf buf " %s %s %s %s %s %s %s " seventolist
  with
    _ -> Printf.eprintf "stringto_seven_list"; exit 0;;

(* let newlist = stringto_seven_list " a b c d e f g ";; *)
(* should be val newlist : string list = ["a"; "b"; "c"; "d"; "e"; "f"; "g"] *)
(* let testlist = stringto_seven_list "    TODAY   FRI     SAT  SUN       MON TUE    WED";; *)
(* should be val testlist : string list =  ["TODAY"; "FRI"; "SAT"; "SUN"; "MON"; "TUE"; "WED"] *)

type date = { month : string; day : int };;

(* mkdate: string int -> date *)

let mkdate m d = {month = m; day = d};;


(* mkdate "foo" 222;;  *)
(* should be - : date = {month = "foo"; day = 222} *)

(* string_stringintpairs_to_list: string (a b a b a b a b a b a b a b -> X list) (a b -> X) -> list of dates *)

let string_stringintpairs_to_list string lister constructor = 
  try
    let buf = Scanf.Scanning.from_string string in
    Scanf.bscanf buf " %s %d %s %d %s %d %s %d %s %d %s %d %s %d " lister constructor
  with
    _ -> Printf.eprintf "string_stringintpairs_to_list: scan"; exit 0;;


(* let mystringintpairlist = string_stringintpairs_to_list " Thu 29 Fri 30 Sat 31 Sun 1 Mon 2 Tue 3 Wed 4" tolist mkdate;; *)
(* should be *)
(* val mystringintpairlist : date list = *)
(*   [{month = "Thu"; day = 29}; {month = "Fri"; day = 30}; *)
(*    {month = "Sat"; day = 31}; {month = "Sun"; day = 1}; *)
(*    {month = "Mon"; day = 2}; {month = "Tue"; day = 3}; *)
(*    {month = "Wed"; day = 4}] *)

(* tolist a b a b a b a b a b a b a b (a b -> X) -> X list *)

let tolist s1 i1 s2 i2 s3 i3 s4 i4 s5 i5 s6 i6 s7 i7 constructor = 
  let p1 = constructor s1 i1 in
  let p2 = constructor s2 i2 in
  let p3 = constructor s3 i3 in
  let p4 = constructor s4 i4 in
  let p5 = constructor s5 i5 in
  let p6 = constructor s6 i6 in 
  let p7 = constructor s7 i7 in
  seventolist p1 p2 p3 p4 p5 p6 p7 ;;


(* let nextlist = tolist "a" 1 "b" 2 "c" 3 "d" 4 "e" 5 "f" 6 "g" 7 mkdate;; *)
(* should be *)
(*val nextlist : date list = *)
(*  [{month = "a"; day = 1}; {month = "b"; day = 2}; {month = "c"; day = 3}; *)
(*   {month = "d"; day = 4}; {month = "e"; day = 5}; {month = "f"; day = 6}; *)
(*   {month = "g"; day = 7}]                                                 *)
  
(* throw_away_first: a b -> b *)

let throw_away_first a b = b;;


(* throw_away_first "foo" 33;; *)
(* - : int = 33 *)

type temp = {high:int;low:int};;

(* mktemp: int int -> temp *)

let mktemp l h = {high = h; low = l};;

(* let mytemp = mktemp 1 2;; *)
(* should be  *)
(* val mytemp : temp = {high = 1; low = 2} *)

(* temptolist: int int int int int int int int int int int int int (int int -> X) -> list of X *)
(* slightly different than tolist above.  This always puts a zero in the first slot of the first *)
(* list element.  *)

let temptolist i1 s2 i2 s3 i3 s4 i4 s5 i5 s6 i6 s7 i7 constructor = 
  let p1 = constructor 0 i1 in
  let p2 = constructor s2 i2 in
  let p3 = constructor s3 i3 in
  let p4 = constructor s4 i4 in
  let p5 = constructor s5 i5 in
  let p6 = constructor s6 i6 in 
  let p7 = constructor s7 i7 in
  seventolist p1 p2 p3 p4 p5 p6 p7 ;;
    

(* let mynewlist = temptolist 1 2 3 4 5 6 7 8 9 10 11 12 13 throw_away_first;; *)
(* should be val mynewlist : int list = [1; 3; 5; 7; 9; 11; 13]                *)

(* parsetemps: string -> listoftuples *)

let parsetemps string = 
  try
    let buf = Scanf.Scanning.from_string string in
    Scanf.bscanf buf " /%d %d/%d %d/%d %d/%d %d/%d %d/%d %d/%d " temptolist mktemp
  with
    _ -> Printf.eprintf "parseteps\n"; exit 0;;

(*  parsetemps " /1 2/3 4/5 6/7 8/9 10/11 12/13";;  *)
(* should be :                                                        *)
(* - : temp list =                                                    *)
(* [{high = 0; low = 1}; {high = 2; low = 3}; {high = 4; low = 5};    *)
(*  {high = 6; low = 7}; {high = 8; low = 9}; {high = 10; low = 11};  *)
(*  {high = 12; low = 13}]                                            *)

type forecast = {
    dayofweek : string;
    numdate: date;
    fcst: string;
    temp_prediction: temp;
    pop: int 
  };;

(* mkforecast: string date string temp int -> forecast *)

let mkforecast d n f t p = 
  {
   dayofweek = d;
   numdate = n;
   fcst = f;
   temp_prediction = t;
   pop = p;
 };;


(* let mydate = mkdate "thu" 29;;                                               *)
(* should be val mydate : date = {month = "thu"; day = 29}                      *)
(* let mytemp = mktemp 45 32;;                                                  *)
(* should be val mytemp : temp = {high = 45; low = 32}                          *)
(*  let myforecast = mkforecast "Today" mydate "MOCLDY" mytemp 10;;             *)
(* should be                                                                    *)
(* val myforecast : forecast =                                                  *)
(*   {dayofweek = "Today"; numdate = {month = "thu"; day = 29}; fcst = "MOCLDY";*)
(*    temp_prediction = {high = 45; low = 32}; pop = 10}                        *)

(* mkfcstlst: stringlist datelist stringlist templist intlist -> forecastlist *)

let rec mkfcstlst days dates fcsts temps pop =
  match days with 
    [] -> []
  | _ -> mkforecast (List.hd days) (List.hd dates) (List.hd fcsts) (List.hd temps) (List.hd pop)
      :: mkfcstlst (List.tl days) (List.tl dates) (List.tl fcsts) (List.tl temps) (List.tl pop);;

(* let myfct = mkfcstlst ["Today";"tomorrow";"sometime";"never"]  *)
(*                         [mkdate "Thurs" 29; mkdate "Friday" 30; mkdate "maybe" 12; mkdate "forever" 100] *)
(*                         ["Beautiful"; "Wonderful"; "Marvelous"; "Fabulous"] *)
(*                         [mktemp 80 70; mktemp 80 70; mktemp 80 70; mktemp 80 70] *)
(*                         [0 ; 0 ; 0 ; 0];; *)
(* should be *)
(* val myfct : forecast list = *)
(*   [{dayofweek = "Today"; numdate = {month = "Thurs"; day = 29}; *)
(*     fcst = "Beautiful"; temp_prediction = {high = 80; low = 70}; pop = 0}; *)
(*    {dayofweek = "tomorrow"; numdate = {month = "Friday"; day = 30}; *)
(*     fcst = "Wonderful"; temp_prediction = {high = 80; low = 70}; pop = 0}; *)
(*    {dayofweek = "sometime"; numdate = {month = "maybe"; day = 12}; *)
(*     fcst = "Marvelous"; temp_prediction = {high = 80; low = 70}; pop = 0}; *)
(*    {dayofweek = "never"; numdate = {month = "forever"; day = 100}; *)
(*     fcst = "Fabulous"; temp_prediction = {high = 80; low = 70}; pop = 0}] *)

(* makeforecastlist: (string, string, string, string, string, string) -> list-of-forecasts *)
(* takes days, dates, area, forecast, low/high, pop -> list of lists having the parsed out forecast *)

let makeforecastlist days dates loc forecasts temps pop = 
  let daylist = stringto_seven_list days in
  let datelist = string_stringintpairs_to_list dates tolist mkdate in
  let flist = stringto_seven_list forecasts in
  let templist = parsetemps temps in
  let poplist = string_stringintpairs_to_list pop tolist throw_away_first in
  mkfcstlst daylist datelist flist templist poplist;;

(* let myft = makeforecastlist  " Today Tomorrow Sometime Never Past Present Future" *)
(*                                " Jan 20 Jan 21 Jan 22 Jan 23 Jan 24 Jan 25 Jan 26" *)
(*                                " Salt Lake City" *)
(*                                " Beautiful Marvelous Wonderful Fabulous Increadible Stupendous Fantastic" *)
(*                                " /78 68/78 69/77 70/79 71/76 70/77 69/78" *)
(*                                " POP 22 POP 88 POP 10000 POP 0 POP 222 POP 111 POP 333";; *)
(* should be *)
(*                     val myft : forecast list = *)
(*   [{dayofweek = "Today"; numdate = {month = "Jan"; day = 20}; *)
(*     fcst = "Beautiful"; temp_prediction = {high = 78; low = 0}; pop = 22}; *)
(*    {dayofweek = "Tomorrow"; numdate = {month = "Jan"; day = 21}; *)
(*     fcst = "Marvelous"; temp_prediction = {high = 78; low = 68}; pop = 88}; *)
(*    {dayofweek = "Sometime"; numdate = {month = "Jan"; day = 22}; *)
(*     fcst = "Wonderful"; temp_prediction = {high = 77; low = 69}; pop = 10000}; *)
(*    {dayofweek = "Never"; numdate = {month = "Jan"; day = 23}; *)
(*     fcst = "Fabulous"; temp_prediction = {high = 79; low = 70}; pop = 0}; *)
(*    {dayofweek = "Past"; numdate = {month = "Jan"; day = 24}; *)
(*     fcst = "Increadible"; temp_prediction = {high = 76; low = 71}; pop = 222}; *)
(*    {dayofweek = "Present"; numdate = {month = "Jan"; day = 25}; *)
(*     fcst = "Stupendous"; temp_prediction = {high = 77; low = 70}; pop = 111}; *)
(*    {dayofweek = "Future"; numdate = {month = "Jan"; day = 26}; *)
(*     fcst = "Fantastic"; temp_prediction = {high = 78; low = 69}; pop = 333}] *)

(* let mycst = makeforecastlist "    TODAY    FRI      SAT      SUN      MON      TUE      WED" *)
(*                                "    JAN 29   JAN 30   JAN 31   FEB 01   FEB 02   FEB 03   FEB 04" *)
(*                                "    SALT LAKE CITY" *)
(*                                "    MOCLDY   MOCLDY   MOCLDY   PTCLDY   PTCLDY   MOCLDY   PTCLDY" *)
(*                                "      /39    30/43    24/31    18/30    25/32    29/38    26/41" *)
(*                                "    POP 10   POP 10   POP 20   POP 0    POP 20   POP 30   POP 10";; *)
(* should be *)
(*   val mycst : forecast list = *)
(*   [{dayofweek = "TODAY"; numdate = {month = "JAN"; day = 29}; *)
(*     fcst = "MOCLDY"; temp_prediction = {high = 39; low = 0}; pop = 10}; *)
(*    {dayofweek = "FRI"; numdate = {month = "JAN"; day = 30}; fcst = "MOCLDY"; *)
(*     temp_prediction = {high = 43; low = 30}; pop = 10}; *)
(*    {dayofweek = "SAT"; numdate = {month = "JAN"; day = 31}; fcst = "MOCLDY"; *)
(*     temp_prediction = {high = 31; low = 24}; pop = 20}; *)
(*    {dayofweek = "SUN"; numdate = {month = "FEB"; day = 1}; fcst = "PTCLDY"; *)
(*     temp_prediction = {high = 30; low = 18}; pop = 0}; *)
(*    {dayofweek = "MON"; numdate = {month = "FEB"; day = 2}; fcst = "PTCLDY"; *)
(*     temp_prediction = {high = 32; low = 25}; pop = 20}; *)
(*    {dayofweek = "TUE"; numdate = {month = "FEB"; day = 3}; fcst = "MOCLDY"; *)
(*     temp_prediction = {high = 38; low = 29}; pop = 30}; *)
(*    {dayofweek = "WED"; numdate = {month = "FEB"; day = 4}; fcst = "PTCLDY"; *)
(*     temp_prediction = {high = 41; low = 26}; pop = 10}] *)


(* setupwebconnection: string string int -> in_chanel *)
(* takes host, command, port -> the channel to read the web page from *)

let setupwebconnection host command port = 
  let saddr = 
    try Unix.inet_addr_of_string host 
    with Failure("inet_addr_of_string") ->
      try (Unix.gethostbyname host).Unix.h_addr_list.(0)
      with Not_found -> Printf.eprintf "Bad server address: %s\n" host; exit 2
  in
  try
    let sock = Unix.ADDR_INET(saddr, port) in
    let inc,outc = Unix.open_connection sock in
    output_string outc command;
    flush outc;
    inc;
  with Failure("int_of_string")->Printf.eprintf "Bad port: %d\n" port; exit 2 ;;


(* findforecast: in_channel -> list_of_forecasts *)
(* finds the six interesting strings and combines them into a list *)

let rec findforecast inc  =
  let line = input_line inc in
  try 
    match line with "    FCST     FCST     FCST     FCST     FCST     FCST     FCST     " ->
      let days = input_line inc in 
      let dates = input_line inc in
      let f = input_line inc in
      let g = input_line inc in
      let loc = input_line inc in
      let forecasts = input_line inc in
      let temps = input_line inc in
      let pop = input_line inc in
      makeforecastlist days dates loc forecasts temps pop
    | "</html>
" -> Printf.eprintf "Failed. "; []
    | _ -> findforecast inc
  with
    End_of_file -> Printf.eprintf "End of file encountered before finding the forecast.\n"; raise End_of_file;;

(* let inf = open_in "ex.html";; *)
(* val inf : in_channel = <abstr> *)
(* # let mylist = findforecast inf;; *)
(* # mylist ;; *)
(* should be *)
(* - : forecast list = *)
(* [{dayofweek = "TODAY"; numdate = {month = "JAN"; day = 30}; fcst = "RNSNOW"; *)
(*   temp_prediction = {high = 46; low = 0}; pop = 50}; *)
(*  {dayofweek = "SAT"; numdate = {month = "JAN"; day = 31}; fcst = "SNOSHWR"; *)
(*   temp_prediction = {high = 30; low = 26}; pop = 50}; *)
(*  {dayofweek = "SUN"; numdate = {month = "FEB"; day = 1}; fcst = "SNOW"; *)
(*   temp_prediction = {high = 29; low = 19}; pop = 50}; *)
(*  {dayofweek = "MON"; numdate = {month = "FEB"; day = 2}; fcst = "PTCLDY"; *)
(*   temp_prediction = {high = 33; low = 22}; pop = 30}; *)
(*  {dayofweek = "TUE"; numdate = {month = "FEB"; day = 3}; fcst = "MOCLDY"; *)
(*   temp_prediction = {high = 32; low = 29}; pop = 40}; *)
(*  {dayofweek = "WED"; numdate = {month = "FEB"; day = 4}; fcst = "MOCLDY"; *)
(*   temp_prediction = {high = 33; low = 25}; pop = 30}; *)
(*  {dayofweek = "THU"; numdate = {month = "FEB"; day = 5}; fcst = "PTCLDY"; *)
(*   temp_prediction = {high = 35; low = 23}; pop = 0}] *)

(* writeforecasttodisk: string forecast-list-list -> unit *)

let writeforecasttodisk filename fcsts =
  try
    let outchan = open_out filename in
    Marshal.to_channel outchan fcsts [] ; flush outchan; close_out outchan
  with
    End_of_file -> Printf.eprintf "End of file in writeforecasttodisk"; raise End_of_file;;

(*   writeforecasttodisk "testlist.txt" mylist ;; *)
(* - : unit = () *)
(* should be *)
(* „•¦¾£1›“ Š%TODAY #JAN^&RNSNOW n@r Š#SAT #JAN_'SNOSHWR ^Zr Š#SUN #FEBA$SNOW ]Sr Š#MON #FEBB&PTCLDY aV^ Š#TUE #FEBC&MOCLDY `]h Š#WED #FEBD&MOCLDY aY^ Š#THU #FEBE&PTCLDY cW@@ *)
(* in the file "testlist.txt" *)



(* readforecastfromdisk: string -> list-of-forecast_lists *)

let readforecastfromdisk filename = 
  let inchan = open_in filename in
  (Marshal.from_channel inchan : forecast list list);;

(* let lll = readforecastfromdisk "testlist.txt";; *)
(* should be *)
(* val lll : forecast list = *)
(*   [{dayofweek = "TODAY"; numdate = {month = "JAN"; day = 30}; *)
(*     fcst = "RNSNOW"; temp_prediction = {high = 46; low = 0}; pop = 50}; *)
(*    {dayofweek = "SAT"; numdate = {month = "JAN"; day = 31}; fcst = "SNOSHWR"; *)
(*     temp_prediction = {high = 30; low = 26}; pop = 50}; *)
(*    {dayofweek = "SUN"; numdate = {month = "FEB"; day = 1}; fcst = "SNOW"; *)
(*     temp_prediction = {high = 29; low = 19}; pop = 50}; *)
(*    {dayofweek = "MON"; numdate = {month = "FEB"; day = 2}; fcst = "PTCLDY"; *)
(*     temp_prediction = {high = 33; low = 22}; pop = 30}; *)
(*    {dayofweek = "TUE"; numdate = {month = "FEB"; day = 3}; fcst = "MOCLDY"; *)
(*     temp_prediction = {high = 32; low = 29}; pop = 40}; *)
(*    {dayofweek = "WED"; numdate = {month = "FEB"; day = 4}; fcst = "MOCLDY"; *)
(*     temp_prediction = {high = 33; low = 25}; pop = 30}; *)
(*    {dayofweek = "THU"; numdate = {month = "FEB"; day = 5}; fcst = "PTCLDY"; *)
(*     temp_prediction = {high = 35; low = 23}; pop = 0}] *)

type observation = {
    weekday : string;
    dd : date;
    actualtemp : temp;
    precip : bool
  };;

(* mkobservation: string date string temp bool -> observation *)

let mkobservation d n a p = 
  {weekday = d; dd = n; actualtemp = a; precip = p};;

(* mkobservation "Today" (mkdate "Friday" 23) (mktemp 22 11) true;; *)
(* should be *)
(* - : observation = *)
(* {weekday = "Today"; dd = {month = "Friday"; day = 23};*)
(*  actualtemp = {high = 11; low = 22}; precip = true} *)


let dayfun a b c d e f g = match e with 
    "SUN" -> "SAT"
  | "MON" -> "SUN"
  | "TUE" -> "MON"
  | "WED" -> "TUE"
  | "THU" -> "WED"
  | "FRI" -> "THU"
  | "SAT" -> "FRI"
  | _ -> Printf.eprintf "Error dayfun\n"; exit 0;;

(* dayfun "foo" "bar" "ahh" "d" "TUE" "f" "g";; *)
(* should be *)
(* - : string = "MON" *)

let datefun a b c d e f g h i j = 
  let month = String.sub h 0 3 in
  let day = i in
  mkdate month day;;

(* datefun "hello" "world" "it's" "nice" "to" "meet" "you" "today" 21 "cellphones";; *)
(* should be *)
(* - : date = {month = "tod"; day = 21} *)


(* extractdaydate: in_chan -> day * date *)

let extractdaydate inc = 
  let repday = input_line inc in
  let blank = input_line inc in
  let dots = input_line inc in
  let blank2 = input_line inc in
  let dayof = input_line inc in
  let theday = Scanf.bscanf (Scanf.Scanning.from_string repday) " %d %s %s %s %s %d %d " dayfun in
  let thedate = Scanf.bscanf (Scanf.Scanning.from_string dayof)  "%s %s %s %s %s %s %s %s %d %s " datefun in
  (theday:string),(thedate:date);;

let tempfun a (b:int) c d e f g h i = b;;

let extracttemp inc =
  let yesterday = input_line inc in
  let max = input_line inc in
  let min = input_line inc in
  let (themax:int) = Scanf.bscanf (Scanf.Scanning.from_string max) " %s %d %d %s %d %d %d %d %d " tempfun in
  let (themin:int) = Scanf.bscanf (Scanf.Scanning.from_string min) " %s %d %d %s %d %d %d %d %d " tempfun in
  mktemp themax themin;;

let precipfun a b c d e f g = 
  b > 0.0;;
(* precipfun 1 2.3 3 4 5 6 7;; *)
(* should be *)
(* - : bool = true *)

let extractprecip inc = 
  let precip = input_line inc in
  Scanf.bscanf (Scanf.Scanning.from_string precip) " %s %f %f %d %f %f %f " precipfun;;

(* getobservationinfo: in_chan string (in_chan -> X) -> X *)

let rec getobservationinfo str = 
  try
    let line = input_line str in
    prerr_string line; prerr_newline (); prerr_string "foo"; prerr_newline ();
    match line with " NATIONAL WEATHER SERVICE SALT LAKE CITY UT                           " ->
      extractdaydate str
    | " TEMPERATURE (F)                                                     " ->
      extracttemp str
    | " PRECIPITATION (IN)                                                   " ->
      extractprecip str
    | "</html>
" -> 
	Printf.eprintf "Error found in getobservationinfo!\n"; exit 0
    | _ -> prerr_string line; prerr_newline (); getobservationinfo str 
  with
    End_of_file -> Printf.eprintf "EOF reached in getobservationinfo.\n"; raise End_of_file;;

(* findobservation: in_channel -> observation *)

let findobservation (inc:in_channel) = 
  let (day:string),(tdate:date) = getobservationinfo inc in
  let thetemp = getobservationinfo inc in
  let precip = getobservationinfo inc in
  mkobservation day tdate thetemp precip;;


(* compareday: forecast list-of-observations -> boolean *)


let getweatherinfo () = 
  try
    let inchan = setupwebconnection "www.wrh.noaa.gov" "GET /SaltLake/forecast/SFT.shtml\nhost: www.wrh.noaa.gov\r\n\r\n" 80 in
    let newlist = findforecast inchan in 
    let oldlist = readforecastfromdisk "forecasts.hw4" in 
    writeforecasttodisk "forecasts.hw4" [newlist::[] ; oldlist] 
  with 
    End_of_file -> exit 0;;

(* grows the file forecasts.hw4 with a copy of the list of forecasts from 5feb.shtml *)

(* getobservation: unit -> unit *)
(* connects to the observation web page and requests the page of interest *)

let readobsfromdisk filename = 
  try
    let inchan = open_in filename in
    (Marshal.from_channel inchan : observation list)
  with
    Failure("readobs") -> [];;

let getobservation () = 
  try
    let inchan = setupwebconnection "www.wrh.noaa.gov" "GET /Saltlake/climate/CLI.shtml  \nhost: www.wrh.noaa.gov\r\n\r\n" 80 in 
    let newobserv = findobservation inchan in
    let observationlist = readobsfromdisk "observations.hw4" in
    writeforecasttodisk "observations.hw4" (newobserv :: observationlist)
  with
    End_of_file -> exit 0;;