hum-0.2.0.0: src/Hum/Utils.hs
-- | Module : Hum.Utils
-- Copyright : (c) Itai Y. Efrat 2020-2021
-- License : GPLv2-or-later (see LICENSE)
-- Maintainer : Itai Y. Efrat <itai3397@gmail.com>
--
module Hum.Utils where
import Hum.Types
import Hum.Rebuild
import Brick.Types
import Brick.Widgets.List
import qualified Data.Vector as V
import qualified Data.Text as T
import qualified Data.ByteString as BS
import Network.MPD ( withMPD )
import qualified Network.MPD as MPD
import qualified Data.Map.Strict as Map
import Text.Printf ( printf )
import Control.Lens
import qualified Witherable as W
-- | A backwards function composition operator that I love with my whole heart.
infixl 8 ?
{-# INLINE (?) #-}
-- Make sure it has TWO args only on the left, so that it inlines
-- when applied to two functions, even if there is no final argument
(?) :: (a -> b) -> (b -> c) -> a -> c
(?) f g = \x -> g (f x)
-- | Get comma seperated metedata from tag.
meta :: Text -> MPD.Metadata -> MPD.Song -> Text
meta notFound tag song = maybe
notFound
(T.intercalate ",")
(MPD.toText <<$>> Map.lookup tag (MPD.sgTags song))
-- | Like 'meta', but returns a Maybe for future use.
mmeta :: MPD.Metadata -> MPD.Song -> Maybe Text
mmeta tag song =
T.intercalate "," <$> (MPD.toText <<$>> Map.lookup tag (MPD.sgTags song))
-- | Formats seconds to %M:%S.
secondsToTime :: Integer -> Text
secondsToTime sec =
let (minutes, seconds) = divMod sec 60
in toText (printf "%d:%02d" minutes seconds :: String)
-- | Deletes highlighted songs in list from queue, does not rebuild queue.
deleteHighlightedfromQ :: MPD.MonadMPD m => SongList -> m ()
deleteHighlightedfromQ ls =
let (hls :: SongList) = W.filter snd ls
in for_ hls (\s -> whenJust (MPD.sgId . fst $ s) MPD.deleteId)
>> whenJust
((MPD.sgId . fst . snd) =<< listSelectedElement ls)
MPD.deleteId
-- | Deletes list of songs from queue in MPD, does not rebuild queue.
deleteBulkfromQ :: MPD.MonadMPD m => SongList -> m ()
deleteBulkfromQ ls = for_ ls (\s -> whenJust (MPD.sgId . fst $ s) MPD.deleteId)
-- | Adds songs to queue under the selected item in it in MPD, does not rebuild queue.
pasteSongstoQ :: MPD.MonadMPD m => SongList -> SongList -> m () -- TODO refactor to act on HumState
pasteSongstoQ clip ls =
let pos = listSelected ls
indexedClip = V.indexed $ MPD.sgFilePath . fst <$> listElements clip
in for_ indexedClip (\(n, song) -> MPD.addId song $ (+ (n + 1)) <$> pos)
-- | Produce list of highligted elements (and selected element) in input list.
getHighlighted
:: (W.Filterable t, Traversable t)
=> GenericList n t (e, Highlight)
-> GenericList n t (e, Highlight)
getHighlighted ls = ls & listHighlightSelected ? W.filter snd ? listUnhighlightAll
-- | Paste one list into another under the selected item.
listPaste
:: (Splittable t, Semigroup (t e))
=> GenericList n t e -- ^ List pasted into
-> GenericList n t e -- ^ Pasted list
-> GenericList n t e
listPaste paste ls =
let es = listElements ls
pos = fromMaybe 0 (listSelected ls)
(es1, es2) = Brick.Widgets.List.splitAt (pos + 1) es
in ls { listElements = es1 <> listElements paste <> es2 }
-- | Delete highlighted element (and selected element) from list.
deleteHighlighted
:: HumState
-> Lens' HumState SongList -- ^ Lens that leads to list
-> HumState
deleteHighlighted st lns =
st & clipboardL . clSongsL .~ (st ^. lns & getHighlighted)
& lns %~ listHighlightSelected ? W.filter (not . snd)
-- | Copy highlighted element (and selected element) from list to 'Clipboard'.
yankHighlighted
:: HumState
-> Lens' HumState SongList -- ^ Lens that leads to list
-> HumState
yankHighlighted st lns =
st & clipboardL . clSongsL .~ (st ^. lns & getHighlighted)
-- | Toggle selected items highlight status.
listToggleHighlight :: Traversable t => GenericList n t (e,Highlight) -> GenericList n t (e,Highlight)
listToggleHighlight = listModify (second not)
-- | Highlight selcted item.
listHighlightSelected :: Traversable t => GenericList n t (e,Highlight) -> GenericList n t (e,Highlight)
listHighlightSelected = listModify (second (const True))
-- | Unhighlight selcted item.
listUnhighlightAll :: Traversable t => GenericList n t (e,Highlight) -> GenericList n t (e,Highlight)
listUnhighlightAll = fmap (second $ const False)
-- | Save list of songs to a stored playlist. If exists does nothing.
saveListToPl :: MPD.MonadMPD m =>
SongList
-> Text -- ^ Name of playlist to save to
-> m () -- TODO use unusedPlName
saveListToPl ls name =
let songpaths = MPD.sgFilePath . fst <$> listElements ls
name' = fromString . T.unpack $ name
in for_ songpaths (MPD.playlistAdd name')
-- | Overwrite stored playlist with new song list.
overwriteListToPl :: MPD.MonadMPD m => SongList -> Text -> m ()
overwriteListToPl ls name =
let songpaths = MPD.sgFilePath . fst <$> listElements ls
name' = fromString . T.unpack $ name
in MPD.playlistClear name' >>
for_ songpaths (MPD.playlistAdd name')
-- | Save edited playlist in Playlist view to disk.
saveEditedPl :: Bool -> HumState -> EventM n HumState
saveEditedPl bl st = if bl
then do
let plSongs = st ^. playlistsL . plSongsL
let plName = st ^. playlistsL . plListL & listSelectedElement ? maybe "unnamed" snd ? MPD.toText
_ <- liftIO . withMPD $ overwriteListToPl plSongs plName
reloadPlList st
else reloadPlList st
-- | Deletes selected playlist in Playlist view from disk.
deleteSelectedPl :: Bool -> HumState -> EventM n HumState
deleteSelectedPl bl st = if bl
then do
let plName = st ^. playlistsL . plListL & listSelectedElement <&> snd
_ <- liftIO . withMPD $ traverse MPD.rm plName
rebuildPl st
else pure st
-- | Appends smallest number possible to playlist name for it to not be taken.
-- Does nothing if name is untaken.
unusedPlName :: MPD.PlaylistName -> IO MPD.PlaylistName
unusedPlName prefix = do
plNames <- fromRight [] <$> (liftIO . withMPD $ MPD.listPlaylists)
let newPlName = viaNonEmpty head $ filter (`notElem` plNames) (prefix:(append' prefix . show <$> [2::Int ..]))
pure (fromMaybe "unnamed" newPlName) -- HACK
where
append' (MPD.PlaylistName x) (MPD.PlaylistName y) = MPD.PlaylistName (BS.append x y)
-- | Duplicates stored playlist on disk (with nonconflicting name).
duplicatePlaylist :: MPD.PlaylistName -> HumState -> EventM n HumState -- HACK
duplicatePlaylist pl st = do
songs <- V.fromList . fromRight [] <$> (liftIO . withMPD $ MPD.listPlaylistInfo pl)
newPlName <- liftIO $ unusedPlName pl
_ <- songBulkAddtoPl (MPD.toString newPlName) songs st
rebuildPl st
-- | Pastes playlist in clipboard to disk (with nonconflicting name).
pastePlaylist :: HumState -> EventM n HumState
pastePlaylist st = do
let plName = fromMaybe "<error>" (st ^. clipboardL . clPlNameL)
duplicatePlaylist plName st
-- | Adds list of songs to queue in MPD. Does not rebuild state.
songBulkAddtoQ
:: Bool -- ^ If true plays first song added
-> V.Vector MPD.Song
-> HumState
-> EventM n HumState
songBulkAddtoQ play songs s = do -- TODO don't need s? maybe should rebuild? overlap with system in Hum.UI
let songPaths = MPD.sgFilePath <$> songs
traverse_
(\sel -> liftIO
(withMPD $ MPD.addId sel Nothing >>= if play
then MPD.playId
else const pass
)
)
(V.take 1 songPaths)
traverse_ (\sel -> liftIO (withMPD $ MPD.addId sel Nothing))
(V.drop 1 songPaths)
pure s
-- | Adds list of songs to stored playlist in MPD. Does not rebuild state.
songBulkAddtoPl
:: String -- ^ Playlist Name
-> V.Vector MPD.Song -- ^ Songs to add
-> HumState
-> EventM n HumState
songBulkAddtoPl pl songs s = do
let songPaths = MPD.sgFilePath <$> songs
traverse_
(\sel -> liftIO
(withMPD $ MPD.playlistAdd (fromString pl) sel
)
)
songPaths
rebuildPl s