hum-0.1.0.0: src/Hum/Utils.hs
-- |
module Hum.Utils where
import Hum.Types
import Hum.Rebuild
import Brick.Types
import Brick.Main
import Brick.Widgets.List
import qualified Data.Vector as V
import qualified Data.Text as T
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 Data.Witherable.Class as W
-- | A backwards function composition operator
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))
secondsToTime :: Integer -> Text
secondsToTime sec =
let (minutes, seconds) = divMod sec 60
in toText (printf "%d:%02d" minutes seconds :: String)
updateExtentMap :: EventM Name (Map Name (Maybe (Extent Name)))
updateExtentMap = do
queueE <- lookupExtent Queue
nowPlayingE <- lookupExtent NowPlaying
libLeftE <- lookupExtent LibraryLeft
libMidE <- lookupExtent LibraryMid
libRightE <- lookupExtent LibraryRight
playLeftE <- lookupExtent PlaylistLeft
playRightE <- lookupExtent PlaylistRight
let extentMap = Map.fromList
[ (Queue , queueE)
, (NowPlaying , nowPlayingE)
, (LibraryLeft , libLeftE)
, (LibraryMid , libMidE)
, (LibraryRight , libRightE)
, (PlaylistLeft , playLeftE)
, (PlaylistRight, playRightE)
]
pure extentMap
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
deleteAll :: MPD.MonadMPD m => SongList -> m ()
deleteAll ls = for_ ls (\s -> whenJust (MPD.sgId . fst $ s) MPD.deleteId)
pasteSongstoQ :: MPD.MonadMPD m => SongList -> SongList -> m ()
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)
getHighlighted
:: (Eq e, W.Filterable t, Foldable t, Splittable t)
=> GenericList n t (e, Highlight)
-> GenericList n t (e, Highlight)
getHighlighted ls = hls where
hls = W.filter
(\(el, hl) -> hl || Just (el, hl) == (snd <$> listSelectedElement ls))
ls
listPaste
:: (Splittable t, Semigroup (t e))
=> GenericList n t e
-> GenericList n t e
-> 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 }
deleteHighlighted :: HState
-> Lens' HState SongList
-> HState
deleteHighlighted st lns = st & clipboardL . clSongsL .~ (st ^. lns & listHighlight ? W.filter snd ? listUnhighlightAll)
& lns %~ listHighlight ? W.filter (not . snd)
-- | 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 status
listHighlight :: Traversable t => GenericList n t (e,Highlight) -> GenericList n t (e,Highlight)
listHighlight = listModify (second (const True))
listUnhighlightAll :: Traversable t => GenericList n t (e,Highlight) -> GenericList n t (e,Highlight)
listUnhighlightAll = fmap (second $ const False)
saveListToPl :: MPD.MonadMPD m => SongList -> Text -> m ()
saveListToPl ls name =
let songpaths = MPD.sgFilePath . fst <$> listElements ls
name' = fromString . T.unpack $ name
in for_ songpaths (MPD.playlistAdd name')
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')
saveEditedPl :: HState -> EventM n HState
saveEditedPl st = do
let plSongs = st ^. playlistsL . plSongsL
let plName = st ^. playlistsL . plListL & listSelectedElement ? maybe "unnamed" snd ? MPD.toText
_ <- liftIO . withMPD $ overwriteListToPl plSongs plName
pure st
deleteSelectedPl :: HState -> EventM n HState
deleteSelectedPl st = do
let plName = st ^. playlistsL . plListL & listSelectedElement <&> snd
_ <- liftIO . withMPD $ traverse MPD.rm plName
rebuildPl st
duplicatePlaylist :: MPD.PlaylistName -> HState -> EventM n HState
duplicatePlaylist pl st = do
songs <- V.fromList . fromRight [] <$> (liftIO . withMPD $ MPD.listPlaylistInfo pl)
plNames <- (MPD.toText <$>) . fromRight [] <$> (liftIO . withMPD $ MPD.listPlaylists)
let newPlName = viaNonEmpty head $ filter (`notElem` plNames) (map ((\tx num -> tx <> "-copy" <> show num) (MPD.toText pl)) [1::Int ..])
traverse_ (\pln -> songBulkAddtoPl pln songs st) (T.unpack <$> newPlName)
rebuildPl st
pastePlaylist :: HState -> EventM n HState
pastePlaylist st = do
let plName = fromMaybe "<error>" (st ^. clipboardL . clPlNameL)
duplicatePlaylist plName st
songBulkAddtoQ :: Bool -> V.Vector MPD.Song -> HState -> EventM n HState
songBulkAddtoQ play songs s = do
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)
song <- liftIO (withMPD MPD.currentSong)
pure s { currentSong = fromRight Nothing song, queue = queue s }
songBulkAddtoPl :: String -> V.Vector MPD.Song -> HState -> EventM n HState
songBulkAddtoPl pl songs s = do
let songPaths = MPD.sgFilePath <$> songs
traverse_
(\sel -> liftIO
(withMPD $ MPD.playlistAdd (fromString pl) sel
)
)
songPaths
rebuildPl s