-- -*-haskell-*-
-- Vision (for the Voice): an XMMS2 client.
--
-- Author: Oleg Belozeorov
-- Created: 22 Feb. 2010
--
-- Copyright (C) 2009-2010 Oleg Belozeorov
--
-- This program is free software; you can redistribute it and/or
-- modify it under the terms of the GNU General Public License as
-- published by the Free Software Foundation; either version 3 of
-- the License, or (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- General Public License for more details.
--
{-# LANGUAGE TupleSections #-}
module Playlist.Format
( initFormat
, makeTrackInfo
, getFormatDefs
, putFormatDefs
, TrackInfo (..)
, trackInfoAttrs
, trackInfoText
, trackInfoDuration
, onFormatsChanged
) where
import Prelude hiding (lookup)
import Control.Applicative
import Control.Monad
import Data.IORef
import Data.Maybe
import Data.Either
import Data.Char (toLower)
import Graphics.UI.Gtk hiding (add)
import System.Glib.GError
import Medialib
import Properties
import Config
import Utils
import Context
import Handler
import Playlist.Format.Format
import Playlist.Format.Parser
data TrackInfo
= TrackInfo { tAttrs :: [AttrOp CellRendererText]
, tText :: String
, tDuration :: String }
trackInfoAttrs Nothing = [ cellTextMarkup := Just "" ]
trackInfoAttrs (Just i) = tAttrs i
trackInfoText Nothing = ""
trackInfoText (Just i) = tText i
trackInfoDuration Nothing = ""
trackInfoDuration (Just i) = tDuration i
data Format
= Format { fMakeInfoRef :: IORef (MediaInfo -> IO ([AttrOp CellRendererText], String))
, fFormatDefsRef :: IORef [String]
, fLookupDuration :: MediaInfo -> String
, fLookupURL :: MediaInfo -> String
, fOnFormatsChanged :: HandlerMVar ()
}
getMakeInfo = readIORef (fMakeInfoRef context)
putMakeInfo = writeIORef (fMakeInfoRef context)
getFormatDefs = readIORef (fFormatDefsRef context)
putFormatDefs' = writeIORef (fFormatDefsRef context)
putFormatDefs defs = do
putFormatDefs' defs
saveFormatDefs
updateFormats True
lookupDuration = fLookupDuration context
lookupURL = fLookupURL context
onFormatsChanged = onHandler $ fOnFormatsChanged context
initFormat = do
context <- initContext
let ?context = context
loadFormatDefs
onProperties . add . ever . const $
updateFormats True
return ?context
initContext = do
formatDefsRef <- newIORef []
makeInfoRef <- newIORef $ const $ return ([], "")
duration <- fromJust <$> property "Duration"
url <- fromJust <$> property "URL"
onFormatsChanged <- makeHandlerMVar
return $ augmentContext
Format { fMakeInfoRef = makeInfoRef
, fFormatDefsRef = formatDefsRef
, fLookupDuration = maybe "" escapeMarkup . lookup duration
, fLookupURL = maybe "" escapeMarkup . lookup url
, fOnFormatsChanged = onFormatsChanged
}
loadFormatDefs = do
putFormatDefs' . map trim =<< config "playlist-formats.conf" builtinFormats
updateFormats False
where builtinFormats =
[ "{Movement}[: {Title}]\n\
\{Composer} — {Work}[, {Catalog}]"
, "{Work}[, {Catalog}]\n\
\{Composer}"
, "{Movement}[: {Title}]\n\
\{Composer} — {Work}[, {Catalog}][\n\
\{Performer}][\n\
\[{Conductor}, ]{Orchestra}][\n\
\[{Chorus master}, ]{Chorus}]"
, "{Work}[, {Catalog}]\n\
\{Composer}[\n\
\{Performer}][\n\
\[{Conductor}, ]{Orchestra}][\n\
\[{Chorus master}, ]{Chorus}]"
, "[{Title}\n]\
\{Channel}"
, "[{Track} ]{Title}\n\
\{Artist} — {Album}" ]
saveFormatDefs = do
writeConfig "playlist-formats.conf" =<< getFormatDefs
return ()
getFormats = (rights . map parseFormat) <$> getFormatDefs
updateFormats notify = do
putMakeInfo =<< makeMakeInfo =<< getFormats
when notify $ onFormatsChanged $ invoke ()
makeTrackInfo info = do
makeInfo <- getMakeInfo
(attrs, text) <- makeInfo info
return TrackInfo { tAttrs = attrs
, tText = text
, tDuration = lookupDuration info }
makeMakeInfo fs = do
fs' <- rights <$> mapM cookFormat fs
return $ \pm -> do
let (text, ellipsize) =
maybe (lookupURL pm, EllipsizeMiddle) (, EllipsizeEnd) $
formatMediaInfo fs' pm
search <- map toLower <$> plain text
return ( [ cellTextMarkup := Just text
, cellTextEllipsize := ellipsize ]
, search )
where plain text =
(trd <$> parseMarkup text '\0') `catchGError` \_ -> return ""