vision 0.0.2.3 → 0.0.2.4
raw patch · 28 files changed
+102/−109 lines, 28 filesdep ~xmms2-clientdep ~xmms2-client-glib
Dependency ranges changed: xmms2-client, xmms2-client-glib
Files
- Makefile.in +10/−2
- src/Collection/Control.hs +0/−3
- src/Collection/List/Model.hs +2/−3
- src/Collection/Model.hs +1/−1
- src/Collection/UI.hs +4/−4
- src/Collection/View.hs +3/−5
- src/Config.hs +1/−1
- src/Index.hs +1/−1
- src/Location/Control.hs +7/−8
- src/Location/Model.hs +4/−3
- src/Location/UI.hs +3/−4
- src/Medialib.hs +11/−14
- src/Playback.hs +3/−5
- src/Playlist/Format/Format.hs +2/−2
- src/Playlist/Index.hs +1/−1
- src/Playlist/UI.hs +2/−2
- src/Playlist/Update.hs +2/−4
- src/Playtime.hs +11/−15
- src/Properties/Editor/Model.hs +3/−2
- src/Properties/Editor/UI.hs +1/−1
- src/Properties/Editor/View.hs +1/−1
- src/Properties/Impex.hs +0/−2
- src/Properties/Manager.hs +1/−1
- src/Properties/Property.hs +5/−4
- src/Properties/View.hs +1/−2
- src/Utils.hs +6/−2
- src/Volume.hs +9/−10
- vision.cabal +7/−6
Makefile.in view
@@ -20,7 +20,12 @@ clean: ./Setup.hs clean -.PHONY: all-dev install build configure-dev clean+lint:+ rm -f hlint.out+ -find ./src/ -type f -name "*.hs" -exec hlint {} \; | \+ grep -v '^No suggestions$$' >> hlint.out++.PHONY: all-dev install build configure-dev clean lint else all-dev: $(MAKE) -C $(ABS_TOP_SRCDIR) $@@@ -28,5 +33,8 @@ clean: $(MAKE) -C $(ABS_TOP_SRCDIR) $@ -.PHONY: all-dev clean+lint:+ $(MAKE) -C $(ABS_TOP_SRCDIR) $@++.PHONY: all-dev clean lint endif
src/Collection/Control.hs view
@@ -81,7 +81,6 @@ liftIO $ do setCurColl coll name loadCurrent- return False setOrder order = do Model.setOrder True order@@ -104,7 +103,6 @@ updateWindowTitle populateModel ids widgetGrabFocus collView- return False browseSelected browse = browse =<< getSelectedCollection@@ -136,7 +134,6 @@ Just name -> collGet xmms name "Collections" >>* do coll <- result liftIO $ addCollection replace coll- return False addCollection replace coll = do when replace $ playlistClear xmms Nothing >> return ()
src/Collection/List/Model.hs view
@@ -51,8 +51,8 @@ change <- result when (namespace change == "Collections") $ -- TODO: use the change info instead of repopulating the model.- liftIO $ listCollections- return True+ liftIO listCollections+ persist listCollections else listStoreClear listStore@@ -71,4 +71,3 @@ listStoreClear listStore listStoreAppend listStore Nothing mapM_ (listStoreAppend listStore . Just) colls- return False
src/Collection/Model.hs view
@@ -87,7 +87,7 @@ withMVar state $ return . sCurName getCurColl =- withMVar state $ \s -> do+ withMVar state $ \s -> case sFilter s of [] -> return $ sCurColl s text -> do
src/Collection/UI.hs view
@@ -61,7 +61,7 @@ addUIFromFile "collection-browser" - onCollectionActivated $ loadSelected+ onCollectionActivated loadSelected onCollectionListMidClick $ browseSelected browse onCollectionListCR $ browseSelected browse @@ -98,7 +98,7 @@ ] onCollectionSelectionChanged $ do en <- isJust <$> getSelectedCollection- mapM_ (flip actionSetSensitive en) acts+ mapM_ (`actionSetSensitive` en) acts acts <- mapM (getAction srvAG) [ "add-to-playlist"@@ -107,7 +107,7 @@ let updatePA = liftIO $ do list <- widgetGetIsFocus listView coll <- widgetGetIsFocus collView- mapM_ (flip actionSetSensitive (list || coll)) acts+ mapM_ (`actionSetSensitive` (list || coll)) acts return False setupPA w = do w `on` focusInEvent $ updatePA@@ -120,7 +120,7 @@ ["copy", "edit-properties", "export-properties"] let updateE = do en <- (/= 0) <$> treeSelectionCountSelectedRows collSel- mapM_ (flip actionSetSensitive en) acts+ mapM_ (`actionSetSensitive` en) acts collSel `onSelectionChanged` updateE updateE
src/Collection/View.hs view
@@ -115,7 +115,7 @@ cellLayoutSetAttributeFunc column cell collStore $ \iter -> do maybeInfo <- getInfoIfNeeded iter let text = case maybeInfo of- Just info -> maybe "" id (lookup prop info)+ Just info -> fromMaybe "" $ lookup prop info Nothing -> "" cell `set` [ cellText := text ] @@ -157,9 +157,7 @@ search _ _ Nothing = False search _ [] _ = False search str (prop:props) (Just info) =- let ptext = map toLower $ maybe "" id $ lookup prop info in- if isInfixOf str ptext- then True- else search str props (Just info)+ let ptext = map toLower $ fromMaybe "" $ lookup prop info in+ str `isInfixOf` ptext || search str props (Just info)
src/Config.hs view
@@ -43,7 +43,7 @@ import Utils -config name defl = do+config name defl = withFile (configFileName name) ReadMode config' `catch` \_ -> return defl where config' h = do c <- hGetContents h
src/Index.hs view
@@ -73,7 +73,7 @@ updateIndex index ix id stamp info old list = if upd then do- ti <- (iConv index) info+ ti <- iConv index info mapM_ (touch index) list return $ IntMap.insert id (IEReady stamp info ti, list) ix else
src/Location/Control.hs view
@@ -57,10 +57,9 @@ Nothing -> return () -handleBrowse url = do+handleBrowse url = handleBrowse' `catch` \(_ :: XMMSException) -> liftIO $ putStrLn $ "error loading " ++ url- return False where handleBrowse' = do r <- result liftIO $ do@@ -68,9 +67,9 @@ widgetGrabFocus locationView makeURL url- | isInfixOf "://" url =+ | "://" `isInfixOf` url = url- | isPrefixOf "~/" url && isJust homeDir =+ | "~/" `isPrefixOf` url && isJust homeDir = "file://" ++ fromJust homeDir ++ tail url | otherwise = "file://" ++ url@@ -93,12 +92,12 @@ else do collIdlistFromPlaylistFile xmms path >>* ((do coll <- result- lift $ playlistAddIdlist xmms Nothing coll- return False)+ liftIO $ playlistAddIdlist xmms Nothing coll+ return ()) `catch` (\(_ :: XMMSException) -> do- lift $ playlistAddURL xmms Nothing path- return False))+ liftIO $ playlistAddURL xmms Nothing path+ return ())) return () updateWindowTitle = do
src/Location/Model.hs view
@@ -40,6 +40,7 @@ import Control.Applicative import Data.List+import Data.Ord import Graphics.UI.Gtk @@ -122,15 +123,15 @@ , iPath = path , iIsDir = entryIsDir x }- where name = last $ split $ path+ where name = last $ split path path = decodeURL $ entryPath x compareItems SortDescending a b- | iIsDir a == iIsDir b = compare (iName b) (iName a)+ | iIsDir a == iIsDir b = comparing iName b a | iIsDir a = LT | iIsDir b = GT compareItems SortAscending a b- | iIsDir a == iIsDir b = compare (iName a) (iName b)+ | iIsDir a == iIsDir b = comparing iName a b | iIsDir a = LT | iIsDir b = GT
src/Location/UI.hs view
@@ -57,8 +57,7 @@ toolbarInsert toolbar item 6 load <- getAction srvAG "load"- locationEntry `onEntryActivate` do- actionActivate load+ locationEntry `onEntryActivate` actionActivate load scroll <- scrolledWindowNew Nothing Nothing scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic@@ -82,8 +81,8 @@ return (True, iIsDir item) _ -> return (True, False)- mapM_ (flip actionSetSensitive enp) [addp, repp]- mapM_ (flip actionSetSensitive enn) [down, binw]+ mapM_ (`actionSetSensitive` enp) [addp, repp]+ mapM_ (`actionSetSensitive` enn) [down, binw] locationSel `onSelectionChanged` updateB updateB
src/Medialib.hs view
@@ -84,22 +84,20 @@ onServerConnectionAdd . ever $ \conn -> if conn- then do- broadcastMedialibEntryChanged xmms >>* do- id <- result- let id' = fromIntegral id- liftIO $ do- withMVar cache $ \cache ->- when (isJust . IntMap.lookup id' $ cEntries cache) $- medialibGetInfo xmms id >>* handleInfo id'- return True+ then broadcastMedialibEntryChanged xmms >>* do+ id <- result+ let id' = fromIntegral id+ liftIO $ withMVar cache $ \cache ->+ when (isJust . IntMap.lookup id' $ cEntries cache) $+ medialibGetInfo xmms id >>* handleInfo id'+ persist else modifyMVar_ cache $ \cache -> return cache { cEntries = IntMap.empty } return ?context -requestInfo id = do+requestInfo id = modifyMVar_ cache $ \cache -> let id' = fromIntegral id entries = cEntries cache in@@ -132,7 +130,6 @@ return (Cache { cEntries = IntMap.insert id entry entries , cNextStamp = succ stamp }, stamp) onMediaInfo $ invoke (fromIntegral id, stamp, info)- return False getInfo id = withMVar cache $ \cache ->@@ -149,12 +146,12 @@ hid <- onMediaInfo . add $ \(id, _, info) -> do (ctr, todo, ready) <- readIORef ref case todo of- (i:is) | i == id -> do+ (i:is) | i == id -> if null is- then do+ then do f . Right $ reverse ((id, info) : ready) return False- else do+ else do let ctr' = ctr + 1 when (step == 0 || ctr' `mod` step == 0) $ f . Left $ fromIntegral ctr' / fromIntegral len
src/Playback.hs view
@@ -81,11 +81,11 @@ then do broadcastPlaybackStatus xmms >>* do liftIO requestStatus- return True+ persist requestStatus broadcastPlaylistCurrentPos xmms >>* do- liftIO $ requestCurrentTrack- return True+ liftIO requestCurrentTrack+ persist requestCurrentTrack else resetState@@ -121,7 +121,6 @@ playbackStatus xmms >>* do status <- result liftIO . setStatus $ Just status- return False requestCurrentTrack = playlistCurrentPos xmms Nothing >>* do@@ -130,7 +129,6 @@ old <- modifyMVar state $ \state -> return (state { sCurrentTrack = new }, sCurrentTrack state) onCurrentTrack $ invoke old- return False startPlayback False = do playbackStart xmms
src/Playlist/Format/Format.hs view
@@ -43,7 +43,7 @@ cookFormat fmt = runErrorT (mapM f fmt) where f (FeP n) =- maybe (throwError "") (return . FeP) =<< (liftIO $ property n)+ maybe (throwError "") (return . FeP) =<< liftIO (property n) f (FeL s) = return $ FeL s f (FeO l) =@@ -52,6 +52,6 @@ formatMediaInfo [] _ = Nothing formatMediaInfo (fmt:fmts) m = execWriterT (mapM_ f fmt) `mplus` formatMediaInfo fmts m- where f (FeP p) = tell . escapeMarkup =<< (lift $ lookup p m)+ where f (FeP p) = tell . escapeMarkup =<< lift (lookup p m) f (FeL s) = tell s f (FeO l) = mapM_ f l `mplus` return ()
src/Playlist/Index.hs view
@@ -77,7 +77,7 @@ IntMap.fromList <$> mapM update (IntMap.toList ix) where update (i, (IEReady s m _, l)) = do t <- makeTrackInfo m- mapM touch l+ mapM_ touch l return (i, (IEReady s m t, l)) update other = return other
src/Playlist/UI.hs view
@@ -87,14 +87,14 @@ expp <- getAction srvAG "export-properties" let setupSel = do n <- treeSelectionCountSelectedRows playlistSel- mapM_ (flip actionSetSensitive (n /= 0))+ mapM_ (`actionSetSensitive` (n /= 0)) [cut, copy, delete, editp, expp] paste <- getAction srvAG "paste" append <- getAction srvAG "append" let setupPA = do en <- editCheckClipboard- mapM_ (flip actionSetSensitive en) [paste, append]+ mapM_ (`actionSetSensitive` en) [paste, append] onPlaybackStatus . add . ever . const $ setupPPS onCurrentTrack . add . ever . const $ setupPN
src/Playlist/Update.hs view
@@ -45,10 +45,9 @@ playlistCurrentActive xmms >>* do setupPlaylist liftIO $ broadcastPlaylistChanged xmms >>* handleChange- return False broadcastPlaylistLoaded xmms >>* do setupPlaylist- return True+ persist else do setPlaylistName Nothing updateWindowTitle@@ -96,7 +95,6 @@ mapM_ addToPlaylist ids requestCurrentTrack onPlaylistUpdated $ invoke ()- return False addToPlaylist id = do n <- listStoreAppend playlistStore id@@ -129,4 +127,4 @@ onPlaylistUpdated $ invoke () _ -> requestPlaylist name- return True+ persist
src/Playtime.hs view
@@ -69,10 +69,10 @@ onServerConnectionAdd . ever $ \conn -> if conn then do- playbackCurrentId xmms >>* handleCurrentId False- broadcastPlaybackCurrentId xmms >>* handleCurrentId True- playbackPlaytime xmms >>* handlePlaytime 0 False- signalPlaybackPlaytime xmms >>* handlePlaytime 1000 True+ playbackCurrentId xmms >>* handleCurrentId+ broadcastPlaybackCurrentId xmms >>* (handleCurrentId >> persist)+ playbackPlaytime xmms >>* handlePlaytime 0+ signalPlaybackPlaytime xmms >>* (handlePlaytime 1000 >> persist) else do resetState setValue 0@@ -104,7 +104,7 @@ resetState = modifyMVar_ state $ const $ return makeState -handleCurrentId ret = do+handleCurrentId = do cid <- result liftIO $ do setCurrentId $@@ -112,11 +112,10 @@ then Nothing else Just cid requestInfo cid- return ret handleInfo (id, _, info) = do cid <- getCurrentId- when (cid == Just id) $ do+ when (cid == Just id) $ case Map.lookup "duration" info of Just (PropInt32 d) -> setUpper $ fromIntegral d _ -> return ()@@ -126,9 +125,8 @@ seek pos = do putStrLn $ "seek to " ++ show pos eid <- disableUpdate- playbackSeekMs xmms (round pos) SeekSet >>* do- liftIO $ scheduleEnableUpdate eid- return False+ playbackSeekMs xmms (round pos) SeekSet >>*+ liftIO (scheduleEnableUpdate eid) return () data Update@@ -159,7 +157,7 @@ return stamp scheduleEnableUpdate stamp = do- eid <- (flip timeoutAdd) 500 $ do+ eid <- flip timeoutAdd 500 $ do stamp' <- uStamp <$> readIORef ?updateRef when (stamp == stamp') $ resetUpdate id return False@@ -172,7 +170,7 @@ withoutSeek = bracket_ (signalBlock cId) (signalUnblock cId) -handlePlaytime diff ret = do+handlePlaytime diff = do newPt <- catchResult 0 fromIntegral liftIO $ do en <- updateEnabled@@ -180,7 +178,6 @@ when (en && fromMaybe StatusStop ps /= StatusStop) $ do oldPt <- getValue when (abs (newPt - oldPt) >= diff) $ setValue newPt- return ret makeSeekControl = do view <- hScaleNew adj@@ -190,7 +187,6 @@ id <- onPlaybackStatusAdd . ever $ widgetSetSensitive view . (Just StatusPlay ==)- view `onDestroy` do- onPlaybackStatus $ remove id+ view `onDestroy` onPlaybackStatus (remove id) return view
src/Properties/Editor/Model.hs view
@@ -36,6 +36,7 @@ import Control.Concurrent.MVar import Control.Monad.State hiding (State, withState) import Control.Applicative+import Control.Arrow import Data.Maybe import Data.List hiding (lookup)@@ -204,7 +205,7 @@ } else let u = snd $ sCurrent s- e = Map.map (\(b, c) -> (b, Map.union u c)) $ sEntries s+ e = Map.map (second $ Map.union u) $ sEntries s c = e Map.! (sIds s ! sPos s) in s { sPerTrack = True , sEntries = e@@ -254,7 +255,7 @@ Map.insert (sIds s ! sPos s) c (sEntries s) False -> let u = snd c in- Map.map (\(b, c) -> (b, Map.union u c)) $ sEntries s+ Map.map (second $ Map.union u) $ sEntries s e' = Map.map (\(b, c) -> (Map.union c b, Map.empty)) e put s { sEntries = e' , sCurrent = (Map.union (snd c) (fst c), Map.empty)
src/Properties/Editor/UI.hs view
@@ -51,7 +51,7 @@ tryLock f = maybe (return False) (const $ f >> return True)- =<< (tryTakeMVar $ uLock context)+ =<< tryTakeMVar (uLock context) unlock = tryPutMVar (uLock context) () >> return () dialog = uDialog context
src/Properties/Editor/View.hs view
@@ -72,7 +72,7 @@ [ cellText :=> propertyText prop , cellTextEditable :=> do c <- connected- return $ c && (not $ propReadOnly prop)+ return $ c && not (propReadOnly prop) ] return ?context
src/Properties/Impex.hs view
@@ -135,8 +135,6 @@ id <- result unless (id == 0) $ liftIO $ setProps id props- return False- return False where enc = (encodeURL url') ++ args url' | isInfixOf "://" url = url | otherwise = "file://" ++ joinPath [base, url]
src/Properties/Manager.hs view
@@ -332,7 +332,7 @@ checkInsert str pos = do check- return $ (length str) + pos+ return $ length str + pos checkDelete _ _ = check
src/Properties/Property.hs view
@@ -34,6 +34,7 @@ import Control.Applicative import Control.Monad +import Data.Maybe import qualified Data.Map as Map import Text.Printf@@ -100,18 +101,18 @@ readValue p s = liftM Just read `catch` \_ -> return Nothing- where read = maybe rdef id (propReadValue p) $ s+ where read = fromMaybe rdef (propReadValue p) s rdef s = case (propType p) of PropertyInt -> X.PropInt32 <$> readIO s PropertyString -> return $ X.PropString s -showValue p v = maybe sdef id (propShowValue p) $ v+showValue p v = fromMaybe sdef (propShowValue p) v where sdef (X.PropInt32 n) = show n sdef (X.PropString s) = s lookup p m = do- res <- (showValue p) <$> Map.lookup (propKey p) m+ res <- showValue p <$> Map.lookup (propKey p) m when (null res) mzero return res @@ -165,7 +166,7 @@ showDuration (X.PropInt32 n) =- if h == 0 then mss else (show h) ++ (':' : mss)+ if h == 0 then mss else show h ++ (':' : mss) where d = n `div` 1000 h = d `div` 3600 m = (d - (h * 3600)) `div` 60
src/Properties/View.hs view
@@ -159,8 +159,7 @@ rows <- treeSelectionGetSelectedRows sel mapM_ (listStoreRemove store . head) $ reverse rows - setupDnDReorder propPosList store right $- mapM_ $ \(f, t) -> do+ setupDnDReorder propPosList store right . mapM_ $ \(f, t) -> do v <- listStoreGetValue store f listStoreRemove store f listStoreInsert store t v
src/Utils.hs view
@@ -90,7 +90,7 @@ decodeURL' (c : cs) = c : decodeURL' cs decodeByte (d1 : d0 : cs)- | isHexDigit d1 && isHexDigit d0 = (chr $ (digitToInt d1) * 16 + (digitToInt d0), cs)+ | isHexDigit d1 && isHexDigit d0 = (chr $ digitToInt d1 * 16 + digitToInt d0, cs) decodeByte _ = error "invalid URL" trd (_, _, c) = c@@ -110,7 +110,7 @@ let cond = case selMode of SelectionMultiple ->- (2 >) <$> (liftIO $ treeSelectionCountSelectedRows sel)+ (2 >) <$> liftIO (treeSelectionCountSelectedRows sel) SelectionNone -> return False _ ->@@ -175,3 +175,7 @@ putMVar m a' Nothing -> return ()+++deriving instance MonadCatchIO (ResultM c a)+
src/Volume.hs view
@@ -52,12 +52,13 @@ then do playbackVolumeGet xmms >>* do handleVolume- lift $ broadcastPlaybackVolumeChanged xmms >>* handleVolume- return False+ liftIO $ broadcastPlaybackVolumeChanged xmms >>* do+ handleVolume+ persist signalUnblock cId else do signalBlock cId- withoutVolumeChange $ adjustmentSetValue (adj) 0+ withoutVolumeChange $ adjustmentSetValue adj 0 return ?context @@ -72,13 +73,13 @@ makeVolumeControl = do- view <- hScaleNew $ adj+ view <- hScaleNew adj scaleSetDrawValue view False rangeSetUpdatePolicy view UpdateContinuous widgetSetCanFocus view False id <- onServerConnectionAdd . ever $ widgetSetSensitive view- view `onDestroy` do onServerConnection $ remove id+ view `onDestroy` onServerConnection (remove id) return view @@ -86,14 +87,12 @@ handleVolume = do vol <- catchResult 0 (maximum . Map.elems) liftIO $ withoutVolumeChange $- adjustmentSetValue (adj) $ fromIntegral vol- return True+ adjustmentSetValue adj $ fromIntegral vol setVolume vol = playbackVolumeGet xmms >>* do vols <- catchResult Map.empty id- lift $ mapM_ ((flip (playbackVolumeSet xmms)) vol) $ Map.keys vols- return False+ liftIO $ mapM_ (flip (playbackVolumeSet xmms) vol) $ Map.keys vols withoutVolumeChange =- bracket_ (signalBlock $ cId) (signalUnblock $ cId)+ bracket_ (signalBlock cId) (signalUnblock cId)
vision.cabal view
@@ -1,5 +1,5 @@ name: vision-version: 0.0.2.3+version: 0.0.2.4 author: Oleg Belozeorov maintainer: Oleg Belozeorov <upwawet@gmail.com>@@ -17,7 +17,7 @@ cabal-version: >= 1.6 build-type: Simple-extra-tmp-files: config.status, config.log, autom4te.cache+extra-tmp-files: config.status, config.log, autom4te.cache, hlint.out extra-source-files: configure.ac, configure, src/Properties/Makefile.in,@@ -94,15 +94,16 @@ Playlist.Format.Parser, Playlist.Format.Config hs-source-dirs: src- build-depends: base >= 4 && < 5, xmms2-client >= 0.0.3.6,- xmms2-client-glib >= 0.0.3.6,+ build-depends: base >= 4 && < 5, xmms2-client >= 0.0.4.0,+ xmms2-client-glib >= 0.0.4.0, gtk, containers, mtl, utf8-string, filepath, directory, glib, array, MonadCatchIO-mtl, json, parsec >= 3.0.1 extensions: ImplicitParams, NoMonomorphismRestriction, FlexibleContexts, FlexibleInstances, TypeFamilies, ScopedTypeVariables,- PatternGuards+ PatternGuards, StandaloneDeriving,+ GeneralizedNewtypeDeriving ghc-options: -W @@ -113,4 +114,4 @@ source-repository head type: git location: git://github.com/upwawet/vision.git- tag: v0.0.2.3+ tag: v0.0.2.4