module Web.Last.Parsing where

import qualified Web.Last.Types as Types

import Prelude hiding ((.),id)
import Control.Category
import Control.Applicative
import Control.Arrow
import Data.Partial
import Text.JSON.Combinators

token :: JSValTo Types.Token
token = objOf $ ll "token" strJS

ranked :: JSValTo a -> JSValTo (Types.Ranked a)
ranked pa = objOf (Types.Ranked <$> ll "rank" strJS) <*> pa

track :: JSValTo Types.Track
track = objOf $ do
    -- If they would just make up their minds...
    (artistName,artistMBID) <-
        (ll "artist" strJS &&& return Nothing)
        <|>
        (inObj "artist" $
            (ll "name" strJS <|> ll "#text" strJS)
            &&&
            optional (ll "mbid" strJS))
    return Types.Track
        <*> ll "name" strJS
        <*> ll "mbid" strJS
        <*> ll "url" strJS
        <*> return artistName
        <*> return artistMBID

trackInfo :: JSValTo Types.TrackInfo
trackInfo = objOf $
    return Types.TrackInfo
        <*> ll "playcount" strJS
        <*> optional (ll "streamable" streamProp)
        <*> ll "artist" artist
        <*> llArr "image" image

streamProp :: JSValTo Types.StreamProp
streamProp = objOf $
    return Types.StreamProp
        <*> ll "#text" strJS
        <*> ll "fulltrack" strJS

artist :: JSValTo Types.Artist
artist = objOf $
    return Types.Artist
        <*> ll "name" strJS
        <*> optional (ll "mbid" strJS)
        <*> ll "url" strJS

artistInfo :: JSValTo Types.ArtistInfo
artistInfo = objOf $
    return Types.ArtistInfo
        <*> llArr "image" image
        <*> inObj "similar" (llArr "artist" (artist &&& (objOf $ llArr "image" image)))
        <*> inObj "stats" (ll "listeners" strJS)
        <*> inObj "stats" (ll "playcount" strJS)
        <*> ll "bio" wiki

image :: JSValTo Types.Image
image = objOf $
    return Types.Image
        <*> ll "#text" strJS
        <*> ll "size" strJS

event :: JSValTo Types.Event
event = objOf $
    return Types.Event
        <*> ll "id" strJS
        <*> ll "title" strJS
        <*> inObj "artists" (ll "headliner" strJS)
        <*> inObj "artists" (llArr "artist" strJS)
        <*> ll "venue" venue
        <*> ll "startDate" strJS
        <*> optional (ll "startTime" strJS)
        <*> ll "description" strJS
        <*> llArr "image" image
        <*> ll "attendance" strJS
        <*> ll "reviews" strJS
        <*> ll "tag" strJS
        <*> ll "url" strJS

venue :: JSValTo Types.Venue
venue = objOf $
    return Types.Venue
        <*> ll "name" strJS
        <*> optional (ll "id" strJS)
        <*> ll "location" location
        <*> ll "url" strJS

location :: JSValTo Types.Location
location = objOf $
    return Types.Location
        <*> ll "geo:point" geoPoint
        <*> ll "country" strJS
        <*> ll "city" strJS
        <*> ll "street" strJS
        <*> ll "postalcode" strJS
        <*> optional (ll "timezone" strJS)

geoPoint :: JSValTo Types.GeoPoint
geoPoint = objOf $
    return Types.GeoPoint
        <*> ll "geo:lat" strJS
        <*> ll "geo:long" strJS

album :: JSValTo Types.Album
album = objOf $ do
    -- They dont seem to be able to make up their mind how to represent artists
    -- Probably due to the way xml attributes get translated into json
    (artistName,artistMBID) <-
            ((ll "artist" strJS) &&& (return Nothing))
            <|>
            (inObj "artist" $
                ((ll "#text" strJS) <|> (ll "name" strJS))
                &&&
                (optional (ll "mbid" strJS)))
    return Types.Album
        <*> ll "name" strJS
        <*> return artistName
        <*> return artistMBID
        <*> optional (ll "id" strJS)
        <*> optional (ll "mbid" strJS)
        <*> ll "url" strJS

albumInfo :: JSValTo Types.AlbumInfo
albumInfo = objOf $
    return Types.AlbumInfo
        <*> ll "releasedate" strJS
        <*> llArr "image" image
        <*> ll "listeners" strJS
        <*> ll "playcount" strJS
        <*> ll "toptags" strJS
        <*> optional (ll "wiki" wiki)

wiki :: JSValTo Types.Wiki
wiki = objOf $
    return Types.Wiki
        <*> ll "published" strJS
        <*> ll "summary" strJS
        <*> ll "content" strJS

query :: JSValTo Types.Query
query = objOf $
    return Types.Query
        <*> ll "#text" strJS
        <*> ll "role" strJS
        <*> ll "searchTerms" strJS
        <*> ll "startPage" strJS

shout :: JSValTo Types.Shout
shout = objOf $
    return Types.Shout
        <*> ll "body" strJS
        <*> ll "author" strJS
        <*> ll "date" strJS

user :: JSValTo Types.User
user = objOf $
    return Types.User
        <*> ll "name" strJS
        <*> optional (ll "realname" strJS)
        <*> ll "url" strJS

playlist :: JSValTo Types.Playlist
playlist = objOf $
    return Types.Playlist
        <*> ll "title" strJS
        <*> ll "annotation" strJS
        <*> ll "creator" strJS
        <*> ll "date" strJS
        <*> inObj "trackList" (llArr "track" playlistItem)

playlistItem :: JSValTo Types.PlaylistItem
playlistItem = objOf $
    return Types.PlaylistItem
        <*> ll "title" strJS
        <*> ll "identifier" strJS
        <*> ll "album" strJS
        <*> ll "creator" strJS
        <*> ll "duration" strJS
        <*> ll "info" strJS
        <*> optional (ll "image" strJS)

weighted :: JSValTo a -> JSValTo (Types.Weighted a)
weighted pa = objOf (Types.Weighted <$> ll "weight" strJS) <*> pa

tag :: JSValTo Types.Tag
tag = objOf $
    return Types.Tag
        <*> ll "name" strJS
        <*> ll "url" strJS

readInt a = read a :: Int
openSearchPages = objOf $
    inObj "results" $ do
        -- Need better validation in here
        total <- readInt <$> ll "opensearch:totalResults" strJS
        perPage <- readInt <$> ll "opensearch:itemsPerPage" strJS
        return (1 + (total `div` perPage))

lastFMError :: JSValTo Types.LastFMError
lastFMError = objOf $
    return Types.LastFMError
        <*> ll "error" valJS
        <*> ll "message" strJS