;;;; xbmc-api.scm
;
;; A CHICKEN Scheme implementation of the JSON-RPC based API (v 6.0) for the XBMC media player.
;
; Copyright (c) 2013, Tim van der Linden
; All rights reserved.

; Redistribution and use in source and binary forms, with or without
; modification, are permitted provided that the following conditions are met:

; Redistributions of source code must retain the above copyright notice, this
; list of conditions and the following disclaimer. 
; Redistributions in binary form must reproduce the above copyright notice,
; this list of conditions and the following disclaimer in the documentation
; and/or other materials provided with the distribution. 
; Neither the name of the author nor the names of its contributors may be
; used to endorse or promote products derived from this software without
; specific prior written permission. 

; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE
; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
; POSSIBILITY OF SUCH DAMAGE.

(module xbmc-api
  (addon application audio-library files gui input json-rpc pvr player playlist xbmc-system video-library xbmc
   mute volume)

(import chicken scheme)
(use extras srfi-1 data-structures)

; Setup the custom signal raisers
;; Raise a signal is the action is not a symbol nor a string
(define (method-type-error action)
  (signal
   (make-property-condition
    'exn 'message
    (sprintf "The given method \"~A\" is of invalid type. Only symbols are allowed."
	     action))))

;; Raise a signal if the method does not exist
(define (invalid-method-error method)
  (signal
   (make-property-condition
    'exn 'message
    (sprintf "The given method \"~A\" does not exist."
	     method))))

;; Raise signal on general high level XBMC API errors
(define (high-level-error message)
  (signal
   (make-property-condition
    'exn 'message
    (sprintf "A general error occured: ~A."
	     message))))


; Procedure that does the actual communication with the XBMC box through JSON-RPC
;; - allowed-methods: local variable containing the allowed XBMC methods
;; - connection: The JSON-RPC connection over which to communicate
;; - method: The XBMC method to send
;; - parameters: The extra options for a given method which translate to a set of XBMC params
(define (send allowed-methods 
	      connection 
	      method
	      #!key
	      (parameters '()))
  (if (symbol? method) ; First check if the method is nothing other then a symbol
      (if (alist-ref method allowed-methods) ; Method exists? Then send it
	  (apply connection
		 (car (alist-ref method allowed-methods))
		 parameters)
	  (invalid-method-error method)) ; Method not found? Complain about it
  (method-type-error method))) ; Given method was something other then a symbol...not good


; Low Level functions
;
; These procedures hold the available methods from the upstream XBMC JSON-RPC API,
; grouped in the same way as can be found in the XBMC API documentation.

; Addon functions
(define (addon connection
	       method
	       #!key
	       (parameters '())
	       (version 6))
  (let ((allowed-methods '((execute-addon "Addons.ExecuteAddon")
			   (get-addon-details "Addons.GetAddonDetails")
			   (get-addons "Addons.GetAddons")
			   (toggle-addon "Addons.SetAddonEnabled"))))
    (send allowed-methods connection method parameters: parameters)))

; Application functions
(define (application connection 
		     method 
		     #!key
		     (parameters '())
		     (version 6))
  (let ((allowed-methods '((volume "Application.SetVolume")
			   (mute "Application.SetMute")
			   (properties "Application.GetProperties")
			   (quit "Application.Quit"))))
    (send allowed-methods connection method parameters: parameters)))

; Audio Library functions
(define (audio-library connection 
		       method 
		       #!key
		       (parameters '())
		       (version 6))
  (let ((allowed-methods '((clean "AudioLibrary.Clean")
			   (export "AudioLibrary.Export")
			   (get-album-details "AudioLibrary.GetAlbumDetails")
			   (get-alumbs "AudioLibrary.GetAlbums")
			   (get-artist-details "AudioLibrary.GetArtistDetails")
			   (get-artists "AudioLibrary.GetArtists")
			   (get-genres "AudioLibrary.GetGenres")
			   (get-recently-added-albums "AudioLibrary.GetRecentlyAddedAlbums")
			   (get-recently-added-songs "AudioLibrary.GetRecentlyAddedSongs")
			   (get-recently-played-albums "AudioLibrary.GetRecentlyPlayedAlbums")
			   (get-recently-played-songs "AudioLibrary.GetRecentlyPlayedSongs")
			   (get-song-details "AudioLibrary.GetSongDetails")
			   (get-songs "AudioLibrary.GetSongs")
			   (scan "AudioLibrary.Scan")
			   (set-album-details "AudioLibrary.SetAlbumDetails")
			   (set-artist-details "AudioLibrary.SetArtistDetails")
			   (set-song-details "AudioLibrary.SetSongDetails"))))
    (send allowed-methods connection method parameters: parameters)))

; Files functions
(define (files connection 
	       method 
	       #!key
	       (parameters '())
	       (version 6))
  (let ((allowed-methods '((download "Files.Download")
			   (get-directory "Files.GetDirectory")
			   (get-file-details "Files.GetFileDetails")
			   (get-sources "Files.GetSources")
			   (prepare-download "Files.PrepareDownload"))))
    (send allowed-methods connection method parameters: parameters)))

; GUI functions
(define (gui connection 
	     method 
	     #!key
	     (parameters '())
	     (version 6))
  (let ((allowed-methods '((activate-window "GUI.ActivateWindow")
			   (get-properties "GUI.GetProperties")
			   (set-full-screen "GUI.SetFullscreen")
			   (show-notification "GUI.ShowNotification"))))
    (send allowed-methods connection method parameters: parameters)))

; Input functions
(define (input connection 
	       method 
	       #!key
	       (parameters '())
	       (version 6))
  (let ((allowed-methods '((back "Input.Back")
			   (context-menu "Input.ContextMenu")
			   (down "Input.Down")
			   (execute-action "Input.ExecuteAction")
			   (home "Input.Home")
			   (info "Input.Info")
			   (left "Input.Left")
			   (right "Input.Right")
			   (select "Input.Select")
			   (send-text "Input.SendText")
			   (show-codec "Input.ShowCodec")
			   (show-osd "Input.ShowOSD")
			   (up "Input.Up"))))
    (send allowed-methods connection method parameters: parameters)))

; JSON-RPC functions
(define (json-rpc connection 
		  method 
		  #!key
		  (parameters '())
		  (version 6))
  (let ((allowed-methods '((get-configuration "JSONRPC.GetConfiguration")
			   (introspect "JSONRPC.Introspect")
			   (notify-all "JSONRPC.NotifyAll")
			   (permission "JSONRPC.Permission")
			   (ping "JSONRPC.Ping")
			   (set-configuration "JSONRPC.SetConfiguration")
			   (version "JSONRPC.Version"))))
    (send allowed-methods connection method parameters: parameters)))

; PVR functions
(define (pvr connection 
	     method 
	     #!key
	     (parameters '())
	     (version 6))
  (let ((allowed-methods '((get-channel-details "PVR.GetChannelDetails")
			   (get-channel-group-details "PVR.GetChannelGroupDetails")
			   (get-channel-groups "PVR.GetChannelGroups")
			   (get-channels "PVR.GetChannels")
			   (get-properties "PVR.GetProperties")
			   (get-record "PVR.Record")
			   (get-scan "PVR.Scan"))))
    (send allowed-methods connection method parameters: parameters)))

; Player functions
(define (player connection
		method
		#!key
		(parameters '())
		(version 6))
  (let ((allowed-methods '((playpause "Player.PlayPause")
			   (get-active-players "Player.GetActivePlayers")
			   (get-item "Player.GetItem")
			   (get-properties "Player.GetProperties")
			   (goto "Player.GoTo")
			   (move "Player.Move")
			   (open "Player.Open")
			   (rotate "Player.Rotate")
			   (seek "Player.Seek")
			   (set-audiostream "Player.SetAudioStream")
			   (set-partymode "Player.SetPartymode")
			   (set-repeat "Player.SetRepeat")
			   (set-shuffle "Player.SetShuffle")
			   (set-speed "Player.SetSpeed")
			   (set-subtitle "Player.SetSubtitle")
			   (stop "Player.Stop")
			   (zoom "Player.Zoom"))))
    (send allowed-methods connection method parameters: parameters)))

; Playlist functions
(define (playlist connection 
		  method 
		  #!key
		  (parameters '())
		  (version 6))
  (let ((allowed-methods '((add "Playlist.Add")
			   (clear "Playlist.Clear")
			   (get-items "Playlist.GetItems")
			   (get-playlists "Playlist.GetPlaylists")
			   (get-properties "Playlist.GetProperties")
			   (insert "Playlist.Insert")
			   (remove "Playlist.Remove")
			   (swap "Playlist.Swap"))))
    (send allowed-methods connection method parameters: parameters)))

; System functions
(define (xbmc-system connection 
		     method 
		     #!key
		     (parameters '())
		     (version 6))
  (let ((allowed-methods '((eject-optical-drive "System.EjectOpticalDrive")
			   (get-properties "System.GetProperties")
			   (hibernate "System.Hibernate")
			   (reboot "System.Reboot")
			   (shutdown "System.Shutdown")
			   (suspend "System.Suspend"))))
    (send allowed-methods connection method parameters: parameters)))

; Video library functions
(define (video-library connection 
		       method 
		       #!key
		       (parameters '())
		       (version 6))
  (let ((allowed-methods '((clean "VideoLibrary.Clean")
			   (export "VideoLibrary.Export")
			   (get-episode-details "VideoLibrary.GetEpisodeDetails")
			   (get-episodes "VideoLibrary.GetEpisodes")
			   (get-genres "VideoLibrary.GetGenres")
			   (get-movie-details "VideoLibrary.GetMovieDetails")
			   (get-movie-set-details "VideoLibrary.GetMovieSetDetails")
			   (get-movie-sets "VideoLibrary.GetMovieSets")
			   (get-movies "VideoLibrary.GetMovies")
			   (get-music-video-details "VideoLibrary.GetMusicVideoDetails")
			   (get-music-videos "VideoLibrary.GetMusicVideos")
			   (get-recently-added-episodes "VideoLibrary.GetRecentlyAddedEpisodes")
			   (get-recently-added-movies "VideoLibrary.GetRecentlyAddedMovies")
			   (get-recently-added-music-videos "VideoLibrary.GetRecentlyAddedMusicVideos")
			   (get-seasons "VideoLibrary.GetSeasons")
			   (get-tv-show-details "VideoLibrary.GetTVShowDetails")
			   (get-tv-shows "VideoLibrary.GetTVShows")
			   (remove-episode "VideoLibrary.RemoveEpisode")
			   (remove-movie "VideoLibrary.RemoveMovie")
			   (remove-music-video "VideoLibrary.RemoveMusicVideo")
			   (remove-tv-show "VideoLibrary.RemoveTVShow")
			   (scan "VideoLibrary.Scan")
			   (set-episode-details "VideoLibrary.SetEpisodeDetails")
			   (set-movie-details "VideoLibrary.SetMovieDetails")
			   (set-music-video-details "VideoLibrary.SetMusicVideoDetails")
			   (set-tv-show-details "VideoLibrary.SetTVShowDetails"))))
    (send allowed-methods connection method parameters: parameters)))

; XBMC functions
(define (xbmc connection 
	      method 
	      #!key
	      (parameters '())
	      (version 6))
  (let ((allowed-methods '((get-info-booleans "XBMC.GetInfoBooleans")
			   (get-info-labels "XBMC.GetInfoLabels"))))
    (send allowed-methods connection method parameters: parameters)))


; High Level functions
;
; Hand crafted abstractions that are meant to make your life easier when communicating
; with your XBMC box. Functionality not present in the original XBMC API is provided here.

; Application high level abstractions

;; Toggle mute on/off
(define (mute connection)
  (if (alist-ref 'muted (application connection 'properties parameters: '(properties: #("muted"))))
      (application connection 'mute parameters: '(mute: #f))
      (application connection 'mute parameters: '(mute: #t))))

;; Set volume directly
(define (volume connection volume)
  (cond ((not (integer? volume)) (high-level-error "Given volume is not an integer"))
	((or (< volume 0)
	     (> volume 100))
	 (high-level-error "Given volume is out of range, has to be between 0 and 100"))
	(else
	 (application connection 'volume parameters: `(volume: ,volume)))))

)