{- |
This is the fourth assignment for IB016, semester spring 2015.
Name: Name Surname
UID: 123456

== Obtaining weather information from http://openweathermap.org

This time your task is to implement download and processing of weather data
from <http://openweathermap.org>. Following it partially filled program, which
already contains some data type definitions, 'main', argument parsing, and
dispatch functions to run your implementation. You should not change any of
already defined data types and functions, unless it is specifically allowed.

OpenWeatherMap provides JSON API for weather forecast (it also provides XML,
but we believe JSON is simpler to process), your task is:

* Download JSON data from serwer based on value of 'Query' (which was parsed
from commandline arguments). That is implement 'createUrl' and
'downloadResults'.

* Process JSON data in functions 'weatherNow', 'weatherDetailed',
'weatherDaily' and 'warmestDay'.

* Implement helper function 'prettyPrint'.

You will have to use some library for HTTP and for JSON, we recommend following
packages and modules @http@ (module @Network.HTTP@) and @hjson@ (module
@Text.HJson@) which provide simple and easy to use interface. Both of these
modules can be installed with @cabal@ (they are not part of standard
distribution). If you use @http@ module you will also need to decode UTF-8
manually, you can use @utf-string@ (module @Codec.Binary.UTF8.String@, function
'decodeString') for that. You can also use any other module which implements
given functionality, in that case you might need to replace 'Json' type in all
functions using it with appropriate type (this change is allowed). Furthermore,
'Rational' data type is used to represent numeric values in weather forecast,
this is to simplify parsing from Json, as @hjson@ uses it to represent numbers,
if you use another library you are allowed to replace Rational with another
type cabable of representing fractional values.

Documentation of OpenWeatherMap's current and forecast API can be found at
<http://openweathermap.org/current> and <http://openweathermap.org/forecast>
respectively, JSON reply format is also linked from appropriate function
documentation. Beware that JSON examples on OpenWeatherMap are not always
properly indented. Furthermore, as a simplification, you can expect that
weather field (which is JSON array in response) contains at least one entry and
you can use the data from the first entry and ignore all other entries.

You can expect that you will obtain a valid JSON from OpenWeatherMap.
If you detect an invalid JSON, you can kill the program using 'exitFailure' 
from @System.Exit@ .
However, you should expect that the obtained JSON does not contain all required
information (which might happen if you query an invalid city). For this reason all
JSON-parsing functions you should implement are returning type wrapped with
'WithError a' which is an alias to 'Either String String'. You should emit an
appropriate error message into 'Left' if any JSON field is missing. However, if
you don't feel like it, you can just omit error handling at all which will be
penalised with 5 points (in this case you should just wrap the result into 
'Right' to match type declaration).

=== Examples

@
$ ./Weather now --city=Brno
city:        Brno (lat = 49.2, lon = 16.61)
weather:     few clouds
temperature: 2.1 °C
pressure:    993.8 hPa

$ ./Weather detailed --city=Brno
city:        Brno (lat = 49.195, lon = 16.608)
date:        05-04-2015 15:00
weather:     scattered clouds
temperature: 2.1 °C
pressure:    992.4 hPa
date:        05-04-2015 18:00
weather:     few clouds
temperature: -0.2 °C
pressure:    993.8 hPa
date:        05-04-2015 21:00
weather:     light rain
temperature: -2.3 °C
pressure:    994.1 hPa
date:        06-04-2015 00:00
weather:     sky is clear
temperature: -3.5 °C
pressure:    993.7 hPa
date:        06-04-2015 03:00
weather:     sky is clear
temperature: -3.9 °C
pressure:    993.7 hPa
# ...

./Weather daily --city=Brno --count=2
city:        Brno (lat = 49.195, lon = 16.608)
date:        05-04-2015 10:00
weather:     scattered clouds
temperature: 2.1 °C
pressure:    992.4 hPa
date:        06-04-2015 10:00
weather:     light snow
temperature: 3.2 °C
pressure:    995.0 hPa

$ ./Weather warmest-day --city=Brno
city:        Brno (lat = 49.195, lon = 16.608)
date:        11-04-2015 10:00
weather:     sky is clear
temperature: 16.3 °C
pressure:    1006.6 hPa

$ ./Weather warmest-day --city=Brno --count=16
city:        Brno (lat = 49.195, lon = 16.608)
date:        20-04-2015 10:00
weather:     light rain
temperature: 19.8 °C
pressure:    988.2 hPa

$ ./Weather now --city="Žďár nad Sázavou"
city:        Žďár nad Sázavou (lat = 49.56, lon = 15.94)
weather:     scattered clouds
temperature: 0.0 °C
pressure:    977.4 hPa

$ ./Weather now --coord=49.56,15.94
city:        Zdar nad Sazavou (lat = 49.56, lon = 15.94)
weather:     scattered clouds
temperature: 0.0 °C
pressure:    977.4 hPa
@
 -}

module Main (
    -- * Executable entry
      main
    -- * Pre-defined types and functions
    , URL
    , Query (..)
    , QueryType (..)
    , Location (..)
    , parseQuery
    , PrettyPrint (..)
    , disp, disp'
    , City (..)
    , Weather (..)
    , Date (..)
    , valid
    , usage
    , WithError
    , processData
    -- * Required functions and types
    , createUrl
    , downloadResults
    , prettyPrint
    , weatherNow
    , weatherDetailed
    , weatherDaily
    , warmestDay
    ) where

-- for timestamp conversion
import Data.Time.Clock.POSIX
import Data.Time.Format
import System.Locale

import Control.Monad
import Control.Applicative

import Data.Monoid
import Data.Maybe
import Data.List
import Data.Map ( Map )
import qualified Data.Map as M
import Data.Function ( on )

import System.Environment
import System.Exit
import System.IO

import Network.HTTP

import Text.HJson
import Text.Read ( readMaybe )

import Codec.Binary.UTF8.String ( decodeString )

type URL = String

-- | City location specification
data Location = Name { locName :: String }
              | Coord { lat :: Double, lon :: Double }
              | NoLocation
              deriving ( Eq, Show, Read )

instance Monoid Location where
    mempty = NoLocation
    x `mappend` NoLocation = x
    _ `mappend` y          = y

-- | Type of query
data QueryType = Now | Detailed | Daily | WarmestDay | NotSet
               deriving ( Eq, Show, Read )

instance Monoid QueryType where
    mempty = NotSet
    x `mappend` NotSet = x
    _ `mappend` y      = y

-- | Type representing commandline parameters
data Query = Query { queryType :: QueryType
                   , city :: Location
                   , count :: Last Int
                   }
           deriving ( Eq, Show, Read )

instance Monoid Query where
    mempty = Query mempty mempty mempty
    x `mappend` y = Query { queryType = queryType x `mappend` queryType y
                          , city = city x `mappend` city y
                          , count = count x `mappend` count y
                          }

-- | Parses commandline arguments into 'Query' type
parseQuery :: [String] -> Query
parseQuery [] = mempty
parseQuery (qt:args) = mempty { queryType = qType } `mappend` mconcat (map fromArg args)
  where
    qType = case qt of
        "now"         -> Now
        "daily"       -> Daily
        "detailed"    -> Detailed
        "warmest-day" -> WarmestDay
        _             -> NotSet

    fromArg :: String -> Query
    fromArg arg = fromMaybe mempty $ do
        (k, '=':v) <- Just $ span (/= '=') arg -- if pattern fail we get Nothing from this do block
        case k of
            "--city"  -> Just $ mempty { city = Name v }
            "--coord" -> do
                (slat, ',':slon) <- Just $ span (/= ',') v
                lat <- readMaybe slat
                lon <- readMaybe slon
                Just $ mempty { city = Coord { lat = lat, lon = lon } }
            "--count" -> do
                cnt <- readMaybe v
                return $ mempty { count = Last (Just cnt) }
            _ -> Nothing

-- | A type class to facilitate pretty printing of tablular information.
class PrettyPrint a where
    -- | Format object into list of key-value pairs of string representation.
    -- This is later used by 'prettyPrint' to format data for output.
    ppKeyVal :: a -> [(String, String)]

instance (PrettyPrint a, PrettyPrint b) => PrettyPrint (a, b) where
    ppKeyVal (x, y) = ppKeyVal x ++ ppKeyVal y

instance (PrettyPrint a, PrettyPrint b, PrettyPrint c) => PrettyPrint (a, b, c) where
    ppKeyVal (x, y, z) = ppKeyVal x ++ ppKeyVal y ++ ppKeyVal z

instance PrettyPrint a => PrettyPrint [a] where
    ppKeyVal = concatMap ppKeyVal

-- | Should format data which can have key-value representation into well
-- readable tabular form. That is all the form key: value, with value indented
-- such that all values start at same offset. Key-value pairs should be obtained by
-- 'ppKeyVal' function from 'PrettyPrint' class.
--
-- >>> putStrLn $ prettyPrint (Date 0)
-- date: 01-01-1970 00:00
--
-- >>>  putStrLn $ prettyPrint (Date 0, Weather 0 0 "test")
-- date:        01-01-1970 00:00
-- weather:     test
-- temperature: -273.2 °C
-- pressure:    0.0 hPa
--
prettyPrint :: PrettyPrint a => a -> String
prettyPrint x = unlines $ map ppOne keyval
  where
    keyval = ppKeyVal x
    ppOne (key, val) = take keypad (key ++ ":" ++ repeat ' ') ++ val
    keypad = maximum (map (length . fst) keyval) + 2

-- | Show rational number rounded with given precision
--
-- >>> disp 1 1.007
-- "1.0"
--
-- >>> disp 2 1.007
-- "1.01"
--
-- >>> disp 3 2.2
-- "2.2"
disp :: Int -> Rational -> String
disp n = show . (/ 10^n) . fromIntegral . round . (* 10^n)

-- | Shortcut for @'disp' 1@.
disp' :: Rational -> String
disp' = disp 1

-- | Information about city and its location.
data City = City { cityName :: String
                 , cityLat  :: Rational
                 , cityLon  :: Rational
                 } deriving ( Eq, Show, Read )

instance PrettyPrint City where
    ppKeyVal c = [ ("city", cityName c ++ " (lat = " ++
                            disp 3 (cityLat c) ++ ", lon = " ++
                            disp 3 (cityLon c) ++ ")") ]

-- | Information about weather.
data Weather = Weather { temperature :: Rational
                       , pressure    :: Rational
                       , description :: String
                       } deriving ( Eq, Show, Read )

instance PrettyPrint Weather where
    ppKeyVal w = [ ("weather", description w)
                 , ("temperature", disp' (temperature w - 273.15) ++ " °C")
                 , ("pressure", disp' (pressure w) ++ " hPa")
                 ]

-- | Unix time wrapped so that it can be made instance of 'PrettyPrint'.
newtype Date = Date { timestamp :: Rational }
               deriving ( Eq, Show, Read )

instance PrettyPrint Date where
    ppKeyVal (Date d) = [ ("date", formatTime defaultTimeLocale "%d-%m-%Y %R" unixTime) ]
      where
        unixTime = posixSecondsToUTCTime (realToFrac d)

-- | Create URL from given query, that is add in all parameters necessary to
-- obtain weather data.
--
-- It must properly encode all parameters for example using functions from
-- @Network.HTTP.Base@.
--
-- >>> createUrl $ mempty {queryType = Now, city = Name "Brno" }
-- "http://api.openweathermap.org/data/2.5/weather?q=Brno"
--
-- >>>  createUrl $ mempty {queryType = Detailed, city = Name "Brno" }
-- "http://api.openweathermap.org/data/2.5/forecast?q=Brno"
--
-- >>> createUrl $ mempty {queryType = Daily, city = Name "Brno" }
-- "http://api.openweathermap.org/data/2.5/forecast/daily?q=Brno"
--
-- >>> createUrl $ mempty {queryType = WarmestDay, city = Name "Brno", count = Last (Just 5) }
-- "http://api.openweathermap.org/data/2.5/forecast/daily?q=Brno&cnt=5"
--
-- >>> createUrl $ mempty {queryType = Now, city = Name "Žďár nad Sázavou" }
-- "http://api.openweathermap.org/data/2.5/weather?q=%C5%BD%C4%8F%C3%A1r%20nad%20S%C3%A1zavou"
createUrl :: Query -> URL
-- createUrl = undefined
createUrl query = addOpts $ cityOpt ++ countOpt
  where
    addOpts = case queryType query of
                Now        -> withOpts currentPrefix
                Detailed   -> withOpts hourlyPrefix
                Daily      -> withOpts dailyPrefix
                WarmestDay -> withOpts dailyPrefix
                NotSet     -> error "invalid Query (no type)"
    cityOpt = case city query of
                NoLocation    -> error "invalid Query (missing location)"
                Name name     -> [ ("q", name) ]
                Coord lat lon -> [ ("lat", show lat), ("lon", show lon) ]
    countOpt = case (queryType query, getLast (count query)) of
                (Daily, Just cnt) -> [ ("cnt", show cnt) ]
                (WarmestDay, Just cnt) -> [ ("cnt", show cnt) ]
                _                 -> []

currentPrefix, hourlyPrefix, dailyPrefix :: URL
currentPrefix = "http://api.openweathermap.org/data/2.5/weather"
hourlyPrefix = "http://api.openweathermap.org/data/2.5/forecast"
dailyPrefix = "http://api.openweathermap.org/data/2.5/forecast/daily"

-- | An utility functions which adds encoded URL arguments to URL
withOpts :: URL -> [(String, String)] -> URL
withOpts url opts = url ++ "?" ++ urlEncodeVars opts

-- | Download requested URL and parse JSON out of it.
--
-- It is recommended to use functionality of @Network.HTTP@ for download
-- and @Text.HJson@ for JSON representation and parsing. If you use HTTP
-- library which does not handle unicode (such as @Network.HTTP@), you should
-- decode response manualy using 'decodeString' from @Codec.Binary.UTF8.String@.
downloadResults :: URL -> IO Json
-- downloadResults = undefined
downloadResults url = do
    respstr <- simpleHTTP (getRequest url) >>= (decodeString <$>) . getResponseBody
    case fromString respstr of
        Left error -> do
            hPrint stderr error
            exitFailure -- end program
        Right json -> return json

-- | Check validity of 'Query'.
valid :: Query -> Bool
valid q = queryType q /= NotSet && city q /= NoLocation

-- | Program usage.
usage :: String
usage = unlines [
    "Usage: Weather {now|detailed|daily|warmest-day}",
    "               {--city=CITY | --coord=LATITUDE,LONGITUDE} [--count=CNT]",
    "",
    "    --count  applies only to daily and warmest-day and specifies number of days"
    ]

-- | Alias to 'Either' to simplify types.
type WithError a = Either String a

-- | Safe lookup in Map, if it fails, it return key and map in which search failed
-- as Left value
look :: Show v => String -> Map String v -> WithError v
look k m = case M.lookup k m of
                Just x  -> Right x
                Nothing -> Left $ "could not find '" ++ k ++ "' in map '" ++ show m ++ "'"

-- | Lookup through several layers of maps, each element of list is index
-- to next map, if something else than Map is encountered Left is returned
index :: [String] -> Json -> WithError Json
index []     x           = Right x
index (k:ks) (JObject x) = look k x >>= index ks
index ks     x           = Left $ "expected object, found '"
                                ++ takeWhile (/= ' ') (show x)
                                ++ "' for keys '" ++ show ks ++ "'"

-- | Parse weather description string from Json object
weatherDesc :: Json -> WithError String
weatherDesc json = do
    -- if pattern-mathing in Either fails, Left will be returned
    JArray (weather:_) <- index ["weather"] json
    JString desc <- index ["description"] weather
    return desc

-- | Parse city informations from Json
getCity :: [String] -> Json -> WithError City
getCity ix json = do
    cityroot <- index ix json
    JString name <- index ["name"] cityroot
    JNumber lat <- index ["coord", "lat"] cityroot
    JNumber lon <- index ["coord", "lon"] cityroot
    return City { cityName = name, cityLat = lat, cityLon = lon }

-- | Parse current weather from JSON,
-- see <http://openweathermap.org/weather-data#current> for format description.
weatherNow :: Json -> WithError (City, Weather)
-- weatherNow = undefined
weatherNow json = do
    city <- getCity [] json

    JNumber temp <- index ["main", "temp"] json
    JNumber pressure <- index ["main", "pressure"] json
    desc <- weatherDesc json
    let weather = Weather { temperature = temp
                          , pressure = pressure
                          , description = desc
                          }

    return (city, weather)

-- | Since the structure looks different in different lookups we pass indices to
-- temparature and pressure elements here
getWeather :: [String] -> [String] -> Json -> WithError (Date, Weather)
getWeather tempix presix json = do
        JNumber dt <- index ["dt"] json
        JNumber temp <- index tempix json
        JNumber pressure <- index presix json
        desc <- weatherDesc json

        return (Date dt, Weather { temperature = temp
                                 , pressure = pressure
                                 , description = desc } )

-- | Parse detailed (5-day/3 hour) forecast from JSON,
-- see <http://openweathermap.org/weather-data#5days> for format specification.
weatherDetailed :: Json -> WithError (City, [(Date, Weather)])
weatherDetailed json = do
    city <- getCity ["city"] json

    JArray list <- index ["list"] json
    -- use monadic map (in Either) on list of values, if any value is
    -- malformed it will return Left
    wdata <- forM list (getWeather ["main", "temp"] ["main", "pressure"])
    return (city, wdata)

-- | Parse daily (16-day) forecast from JSON,
-- see <http://openweathermap.org/weather-data#16days> for format specification.
weatherDaily :: Json -> WithError (City, [(Date, Weather)])
weatherDaily json = do
    city <- getCity ["city"] json

    JArray list <- index ["list"] json
    wdata <- forM list (getWeather ["temp", "day"] ["pressure"])
    return (city, wdata)

-- | Parse daily forecast and get warmest day from it.
warmestDay :: Json -> WithError (City, Date, Weather)
warmestDay json = do
    -- let pattern fail if list in empty -> Left will be returned
    (city, weather@(_:_)) <- weatherDaily json
    let warmest = maximumBy (compare `on` (temperature . snd)) weather
    return (city, fst warmest, snd warmest)

-- | Dispatch parsing functionas based on 'QueryType' and handle errors.
processData :: QueryType -> Json -> String
processData qtype json = either handler id $ case qtype of
    Now        -> prettyPrint <$> weatherNow json
    Detailed   -> prettyPrint <$> weatherDetailed json
    Daily      -> prettyPrint <$> weatherDaily json
    WarmestDay -> prettyPrint <$> warmestDay json
    _          -> Left "invalid query"
  where
    handler msg = unlines [ "Error processing data, sorry", msg]

main :: IO ()
main = do
    query <- parseQuery <$> getArgs
    unless (valid query) $ do
        hPutStrLn stderr "Invalid options"
        hPutStrLn stderr usage
        exitFailure
    weather <- downloadResults (createUrl query)
    putStrLn $ processData (queryType query) weather