haskell rocks

mpdroutes.hs

-- | Execute any mpd action then redirect back to status page
actionRoute :: YesodMPC m => MPD.MPD () -> GHandler MPC m RepHtmlJson
actionRoute f = do
    authHelper
    _  <- withMPD f
    tm <- getRouteToMaster
    redirect RedirectTemporary $ tm StatusR

-- | Toggle any mpd setting then redirect back to status page
toggleRoute :: YesodMPC m => Toggle -> GHandler MPC m RepHtmlJson
toggleRoute Repeat    = helper MPD.stRepeat  (MPD.repeat  . not)
toggleRoute Random    = helper MPD.stRandom  (MPD.random  . not)
toggleRoute PlayPause = helper MPD.stState   flipPP
    where
        flipPP Playing = MPD.pause True
        flipPP _       = MPD.play  Nothing

helper :: YesodMPC m 
        => (MPD.Status -> a)  -- ^ how to get from state to current setting
        -> (a -> MPD.MPD ())  -- ^ how to set new setting based on current state
        -> GHandler MPC m RepHtmlJson
helper get set = go . fmap get =<< withMPD MPD.status
    where
        go (Right v) = actionRoute $ set v
        go _         = actionRoute $ return ()


-- with that in place, _lots_ of functionality ensues:

getPrevR :: YesodMPC m => GHandler MPC m RepHtmlJson
getPrevR = actionRoute MPD.previous

getNextR :: YesodMPC m => GHandler MPC m RepHtmlJson
getNextR = actionRoute MPD.next

getPlayR :: YesodMPC m => Int -> GHandler MPC m RepHtmlJson
getPlayR = actionRoute . MPD.playId

getDelR :: YesodMPC m => Int -> GHandler MPC m RepHtmlJson
getDelR = actionRoute . MPD.deleteId

getPauseR :: YesodMPC m => GHandler MPC m RepHtmlJson
getPauseR = toggleRoute PlayPause

getRepeatR :: YesodMPC m => GHandler MPC m RepHtmlJson
getRepeatR = toggleRoute Repeat

getRandomR :: YesodMPC m => GHandler MPC m RepHtmlJson
getRandomR = toggleRoute Random