diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,20 @@ # Revision history for hum +## 0.2.0.0 - 2020-01-25 + +- Add to playlist prompt now updates for new playlists +- Playlists now sorted alphabetically +- List of playlists keeps cursor position after edit +- Library now shows track number on songs +- Library now uses album artist on left column +- Library now displays and sorts by album year by default +- `\`` toggles album sort order in library (between year and alphabetical) +- Help can now be scrolled and searched with case insensitive POSIX regex +- Fix add-to-playlist prompt not quitting when adding to old playlist +- Playlists can now be renamed + + ## 0.1.0.0 - 2020-12-12 - First version. Released on an unsuspecting world. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -35,7 +35,7 @@ - better documentation - tag info and editing -- mpdish file browser browser and more advanced search +- mpdish file browser and more advanced search - visualizer because why not - having a random mode when you can see what the next song is - making the UI nicer diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,3 +1,4 @@ + module Main where import Brick.Main @@ -13,7 +14,7 @@ import Network.MPD ( withMPD , idle ) - +-- | Calls functions from "Hum.UI", go there next. main :: IO () main = do chan <- BC.newBChan 10 @@ -25,11 +26,13 @@ _ <- customMain initialVty buildVty (Just chan) app initialState pass +-- | Channel that waits for mpd events. mpdListenForever :: BC.BChan HumEvent -> IO () mpdListenForever chan = forever $ do response <- withMPD $ idle [] BC.writeBChan chan (Right response) +-- | Channel that sends ticks every 0.1 seconds. tickTock :: BC.BChan HumEvent -> IO () tickTock chan = forever $ do BC.writeBChan chan (Left Tick) diff --git a/default.nix b/default.nix new file mode 100644 --- /dev/null +++ b/default.nix @@ -0,0 +1,29 @@ +{ mkDerivation, array, base, brick, bytestring, containers +, directory, filepath, lens, libmpd, mtl, regex-tdfa, relude +, stdenv, template-haskell, text, text-zipper, time, transformers +, vector, vty, witherable-class +}: +mkDerivation { + pname = "hum"; + version = "0.2.0.0"; + src = ./.; + isLibrary = true; + isExecutable = true; + libraryHaskellDepends = [ + array base brick bytestring containers directory filepath lens + libmpd mtl regex-tdfa relude template-haskell text text-zipper time + transformers vector vty witherable-class + ]; + executableHaskellDepends = [ + array base brick bytestring containers directory filepath lens + libmpd mtl regex-tdfa relude template-haskell text text-zipper time + transformers vector vty witherable-class + ]; + testHaskellDepends = [ + array base brick bytestring containers directory filepath lens + libmpd mtl regex-tdfa relude template-haskell text text-zipper time + transformers vector vty witherable-class + ]; + description = "A TUI MPD client, inspired by ncmpcpp"; + license = stdenv.lib.licenses.gpl2Plus; +} diff --git a/hum.cabal b/hum.cabal --- a/hum.cabal +++ b/hum.cabal @@ -12,7 +12,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.0.0 +version: 0.2.0.0 -- A short (one-line) description of the package. synopsis: A TUI MPD client, inspired by ncmpcpp @@ -42,12 +42,14 @@ category: Sound -tested-with: GHC == 8.10.2, GHC == 8.8.4, GHC == 8.6.5, GHC == 8.4.4 +tested-with: GHC == 8.10.3, GHC == 8.8.4, GHC == 8.6.5, GHC == 8.4.4 -- Extra files to be distributed with the package, such as examples or a -- README. extra-source-files: CHANGELOG.md README.md + default.nix + release.nix source-repository head type: git @@ -56,7 +58,7 @@ common deps build-depends: base >= 4.11 && < 4.15 - ,brick >= 0.57.1 && < 0.58 + ,brick >= 0.58 && < 0.59 ,bytestring >= 0.10.10 && < 0.11 ,containers >= 0.6.2 && < 0.7 ,text >= 1.2.3 && < 1.3 @@ -64,15 +66,17 @@ ,transformers >= 0.5.6.2 && < 0.6 ,template-haskell >= 2.13.0 && < 2.17 ,filepath >= 1.4.2 && < 1.5 - ,directory >= 1.3.6.1 && < 1.4 - ,time >= 1.9.3 && < 1.10 + ,directory >= 1.3.6.0 && < 1.3.6.1 + ,time >= 1.9.3 && < 1.11 ,lens >= 4.19.2 && < 4.20 - ,text-zipper >= 0.10.1 && < 0.11 + ,text-zipper >= 0.10.1 && < 0.12 ,vector >= 0.12.1 && < 0.13 ,vty >= 5.32 && < 5.33 - ,libmpd >= 0.9.2 && < 0.10 + ,libmpd >= 0.10 && < 0.11 ,relude >= 0.7.0 && < 0.8 - ,witherable-class + ,regex-tdfa >= 1.3.1.0 && < 1.4 + ,array >= 0.5.4.0 && < 0.6 + ,witherable >= 0.4 && < 0.5 mixins: base hiding (Prelude) @@ -116,7 +120,6 @@ exposed-modules: Hum.UI , Hum.Types - , Hum.BChan , Hum.Attributes , Hum.Views , Hum.Views.Common @@ -129,8 +132,10 @@ , Hum.Modes.ExMode , Hum.Modes.PromptMode , Hum.Rebuild + , Hum.Orphans + , Brick.Widgets.Search -- Modules included in this library but not exported. - other-modules: Brick.Widgets.List + -- other-modules: -- Other library packages from which modules are imported. -- Directories containing source files. diff --git a/release.nix b/release.nix new file mode 100644 --- /dev/null +++ b/release.nix @@ -0,0 +1,4 @@ + let + pkgs = import { }; + in + pkgs.haskellPackages.callPackage ./default.nix { } diff --git a/src/Brick/Widgets/List.hs b/src/Brick/Widgets/List.hs deleted file mode 100644 --- a/src/Brick/Widgets/List.hs +++ /dev/null @@ -1,648 +0,0 @@ -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveFoldable#-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DeriveGeneric #-} --- | This module provides a scrollable list type and functions for --- manipulating and rendering it. --- --- Note that lenses are provided for direct manipulation purposes, but --- lenses are *not* safe and should be used with care. (For example, --- 'listElementsL' permits direct manipulation of the list container --- without performing bounds checking on the selected index.) If you --- need a safe API, consider one of the various functions for list --- manipulation. For example, instead of 'listElementsL', consider --- 'listReplace'. -module Brick.Widgets.List - ( GenericList - , List - - -- * Constructing a list - , list - - -- * Rendering a list - , renderList - , renderListWithIndex - - -- * Handling events - , handleListEvent - , handleListEventVi - - -- * Lenses - , listElementsL - , listSelectedL - , listNameL - , listItemHeightL - - -- * Accessors - , listElements - , listName - , listSelectedElement - , listSelected - , listItemHeight - - -- * Manipulating a list - , listMoveBy - , listMoveTo - , listMoveToElement - , listFindBy - , listFindByOld - , listMoveUp - , listMoveDown - , listMoveByPages - , listMovePageUp - , listMovePageDown - , listInsert - , listRemove - , listReplace - , listClear - , listReverse - , listModify - - -- * Attributes - , listAttr - , listSelectedAttr - , listSelectedFocusedAttr - - -- * Classes - , Splittable(..) - , Reversible(..) - ) -where - -import Prelude hiding (reverse, splitAt, filter) - - -import Control.Lens ((^.), (^?), (.~), (%~), _2, _head, set) -import qualified Data.Sequence as Seq -import Graphics.Vty (Event(..), Key(..), Modifier(..)) -import qualified Data.Vector as V -import qualified Data.Witherable.Class as W - -import Brick.Types -import Brick.Main (lookupViewport) -import Brick.Widgets.Core -import Brick.Util (clamp) -import Brick.AttrMap - --- | List state. Lists have a container @t@ of element type @e@ that is --- the data stored by the list. Internally, Lists handle the following --- events by default: --- --- * Up/down arrow keys: move cursor of selected item --- * Page up / page down keys: move cursor of selected item by one page --- at a time (based on the number of items shown) --- * Home/end keys: move cursor of selected item to beginning or end of --- list --- --- The 'List' type synonym fixes @t@ to 'V.Vector' for compatibility --- with previous versions of this library. --- --- For a container type to be usable with 'GenericList', it must have --- instances of 'Traversable' and 'Splittable'. The following functions --- impose further constraints: --- --- * 'listInsert': 'Applicative' and 'Semigroup' --- * 'listRemove': 'Semigroup' --- * 'listClear': 'Monoid' --- * 'listReverse': 'Reversible' --- -data GenericList n t e = - List { listElements :: !(t e) - -- ^ The list's sequence of elements. - , listSelected :: !(Maybe Int) - -- ^ The list's selected element index, if any. - , listName :: n - -- ^ The list's name. - , listItemHeight :: Int - -- ^ The height of an individual item in the list. - } deriving (Functor, Foldable, Traversable, Show, Generic) - -suffixLenses ''GenericList - --- | An alias for 'GenericList' specialized to use a 'Vector' as its --- container type. -type List n e = GenericList n V.Vector e - -instance Named (GenericList n t e) n where - getName = listName - --- | Ordered container types that can be split at a given index. An --- instance of this class is required for a container type to be usable --- with 'GenericList'. -class Splittable t where - {-# MINIMAL splitAt #-} - - -- | Split at the given index. Equivalent to @(take n xs, drop n xs)@ - -- and therefore total. - splitAt :: Int -> t a -> (t a, t a) - - -- | Slice the structure. Equivalent to @(take n . drop i) xs@ and - -- therefore total. - -- - -- The default implementation applies 'splitAt' two times: first to - -- drop elements leading up to the slice, and again to drop elements - -- after the slice. - slice :: Int {- ^ start index -} -> Int {- ^ length -} -> t a -> t a - slice i n = fst . splitAt n . snd . splitAt i - --- | /O(1)/ 'splitAt'. -instance Splittable V.Vector where - splitAt = V.splitAt - --- | /O(log(min(i,n-i)))/ 'splitAt'. -instance Splittable Seq.Seq where - splitAt = Seq.splitAt - --- | Ordered container types where the order of elements can be --- reversed. Only required if you want to use 'listReverse'. -class Reversible t where - {-# MINIMAL reverse #-} - reverse :: t a -> t a - --- | /O(n)/ 'reverse' -instance Reversible V.Vector where - reverse = V.reverse - --- | /O(n)/ 'reverse' -instance Reversible Seq.Seq where - reverse = Seq.reverse - --- | Handle events for list cursor movement. Events handled are: --- --- * Up (up arrow key) --- * Down (down arrow key) --- * Page Up (PgUp) --- * Page Down (PgDown) --- * Go to first element (Home) --- * Go to last element (End) -handleListEvent :: (Foldable t, Splittable t, Ord n) - => Event - -> GenericList n t e - -> EventM n (GenericList n t e) -handleListEvent e theList = - case e of - EvKey KUp [] -> return $ listMoveUp theList - EvKey KDown [] -> return $ listMoveDown theList - EvKey KHome [] -> return $ listMoveTo 0 theList - EvKey KEnd [] -> return $ listMoveTo (length $ listElements theList) theList - EvKey KPageDown [] -> listMovePageDown theList - EvKey KPageUp [] -> listMovePageUp theList - _ -> return theList - --- | Enable list movement with the vi keys with a fallback handler if --- none match. Use 'handleListEventVi' 'handleListEvent' in place of --- 'handleListEvent' to add the vi keys bindings to the standard ones. --- Movements handled include: --- --- * Up (k) --- * Down (j) --- * Page Up (Ctrl-b) --- * Page Down (Ctrl-f) --- * Half Page Up (Ctrl-u) --- * Half Page Down (Ctrl-d) --- * Go to first element (g) --- * Go to last element (G) -handleListEventVi :: (Foldable t, Splittable t, Ord n) - => (Event -> GenericList n t e -> EventM n (GenericList n t e)) - -- ^ Fallback event handler to use if none of the vi keys - -- match. - -> Event - -> GenericList n t e - -> EventM n (GenericList n t e) -handleListEventVi fallback e theList = - case e of - EvKey (KChar 'k') [] -> return $ listMoveUp theList - EvKey (KChar 'j') [] -> return $ listMoveDown theList - EvKey (KChar 'g') [] -> return $ listMoveTo 0 theList - EvKey (KChar 'G') [] -> return $ listMoveTo (length $ listElements theList) theList - EvKey (KChar 'f') [MCtrl] -> listMovePageDown theList - EvKey (KChar 'b') [MCtrl] -> listMovePageUp theList - EvKey (KChar 'd') [MCtrl] -> listMoveByPages (0.5::Double) theList - EvKey (KChar 'u') [MCtrl] -> listMoveByPages (-0.5::Double) theList - _ -> fallback e theList - --- | The top-level attribute used for the entire list. -listAttr :: AttrName -listAttr = "list" - --- | The attribute used only for the currently-selected list item when --- the list does not have focus. Extends 'listAttr'. -listSelectedAttr :: AttrName -listSelectedAttr = listAttr <> "selected" - --- | The attribute used only for the currently-selected list item when --- the list has focus. Extends 'listSelectedAttr'. -listSelectedFocusedAttr :: AttrName -listSelectedFocusedAttr = listSelectedAttr <> "focused" - --- | Construct a list in terms of container 't' with element type 'e'. -list :: (Foldable t) - => n - -- ^ The list name (must be unique) - -> t e - -- ^ The initial list contents - -> Int - -- ^ The list item height in rows (all list item widgets must be - -- this high). - -> GenericList n t e -list name es h = - let selIndex = if null es then Nothing else Just 0 - safeHeight = max 1 h - in List es selIndex name safeHeight - --- | Render a list using the specified item drawing function. --- --- Evaluates the underlying container up to, and a bit beyond, the --- selected element. The exact amount depends on available height --- for drawing and 'listItemHeight'. At most, it will evaluate up to --- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the --- available height. --- --- Note that this function renders the list with the 'listAttr' as --- the default attribute and then uses 'listSelectedAttr' as the --- default attribute for the selected item if the list is not focused --- or 'listSelectedFocusedAttr' otherwise. This is provided as a --- convenience so that the item rendering function doesn't have to be --- concerned with attributes, but if those attributes are undesirable --- for your purposes, 'forceAttr' can always be used by the item --- rendering function to ensure that another attribute is used instead. -renderList :: (Traversable t, Splittable t, Ord n, Show n) - => (Bool -> e -> Widget n) - -- ^ Rendering function, True for the selected element - -> Bool - -- ^ Whether the list has focus - -> GenericList n t e - -- ^ The List to be rendered - -> Widget n - -- ^ rendered widget -renderList drawElem = renderListWithIndex $ const drawElem - --- | Like 'renderList', except the render function is also provided with --- the index of each element. --- --- Has the same evaluation characteristics as 'renderList'. -renderListWithIndex :: (Traversable t, Splittable t, Ord n, Show n) - => (Int -> Bool -> e -> Widget n) - -- ^ Rendering function, taking index, and True for - -- the selected element - -> Bool - -- ^ Whether the list has focus - -> GenericList n t e - -- ^ The List to be rendered - -> Widget n - -- ^ rendered widget -renderListWithIndex drawElem foc l = - withDefAttr listAttr $ - drawListElements foc l drawElem - -imap :: (Traversable t) => (Int -> a -> b) -> t a -> t b -imap f xs = - let act = traverse (\a -> get >>= \i -> put (i + 1) $> f i a) xs - in evalState act 0 - --- | Draws the list elements. --- --- Evaluates the underlying container up to, and a bit beyond, the --- selected element. The exact amount depends on available height --- for drawing and 'listItemHeight'. At most, it will evaluate up to --- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the --- available height. -drawListElements :: (Traversable t, Splittable t, Ord n, Show n) - => Bool - -> GenericList n t e - -> (Int -> Bool -> e -> Widget n) - -> Widget n -drawListElements foc l drawElem = - Widget Greedy Greedy $ do - c <- getContext - - -- Take (numPerHeight * 2) elements, or whatever is left - let es = slice start (numPerHeight * 2) (l^.listElementsL) - - idx = fromMaybe 0 (l^.listSelectedL) - - start = max 0 $ idx - numPerHeight + 1 - - -- The number of items to show is the available height - -- divided by the item height... - initialNumPerHeight = (c^.availHeightL) `div` (l^.listItemHeightL) - -- ... but if the available height leaves a remainder of - -- an item height then we need to ensure that we render an - -- extra item to show a partial item at the top or bottom to - -- give the expected result when an item is more than one - -- row high. (Example: 5 rows available with item height - -- of 3 yields two items: one fully rendered, the other - -- rendered with only its top 2 or bottom 2 rows visible, - -- depending on how the viewport state changes.) - numPerHeight = initialNumPerHeight + - if initialNumPerHeight * (l^.listItemHeightL) == c^.availHeightL - then 0 - else 1 - - off = start * (l^.listItemHeightL) - - drawnElements = flip imap es $ \i e -> - let j = i + start - isSelected = Just j == l^.listSelectedL - elemWidget = drawElem j isSelected e - selItemAttr = if foc - then withDefAttr listSelectedFocusedAttr - else withDefAttr listSelectedAttr - makeVisible = if isSelected - then visible . selItemAttr - else id - in makeVisible elemWidget - - render $ viewport (l^.listNameL) Vertical $ - translateBy (Location (0, off)) $ - vBox $ toList drawnElements - --- | Insert an item into a list at the specified position. --- --- Complexity: the worse of 'splitAt' and `<>` for the container type. --- --- @ --- listInsert for 'List': O(n) --- listInsert for 'Seq.Seq': O(log(min(i, length n - i))) --- @ -listInsert :: (Splittable t, Applicative t, Semigroup (t e)) - => Int - -- ^ The position at which to insert (0 <= i <= size) - -> e - -- ^ The element to insert - -> GenericList n t e - -> GenericList n t e -listInsert pos e l = - let es = l^.listElementsL - newSel = case l^.listSelectedL of - Nothing -> 0 - Just s -> if pos <= s - then s + 1 - else s - (front, back) = splitAt pos es - in l & listSelectedL .~ Just newSel - & listElementsL .~ sconcat (front :| [pure e, back]) - --- | Remove an element from a list at the specified position. --- --- Applies 'splitAt' two times: first to split the structure at the --- given position, and again to remove the first element from the tail. --- Consider the asymptotics of `splitAt` for the container type when --- using this function. --- --- Complexity: the worse of 'splitAt' and `<>` for the container type. --- --- @ --- listRemove for 'List': O(n) --- listRemove for 'Seq.Seq': O(log(min(i, n - i))) --- @ -listRemove :: (Splittable t, Foldable t, Semigroup (t e)) - => Int - -- ^ The position at which to remove an element (0 <= i < - -- size) - -> GenericList n t e - -> GenericList n t e -listRemove pos l | null l = l - | pos /= splitClamp l pos = l - | otherwise = - let newSel = case l^.listSelectedL of - Nothing -> 0 - Just s | pos == 0 -> 0 - | pos == s -> pos - 1 - | pos < s -> s - 1 - | otherwise -> s - (front, rest) = splitAt pos es - (_, back) = splitAt 1 rest - es' = front <> back - es = l^.listElementsL - in l & listSelectedL .~ (if null es' then Nothing else Just newSel) - & listElementsL .~ es' - --- | Replace the contents of a list with a new set of elements and --- update the new selected index. If the list is empty, empty selection --- is used instead. Otherwise, if the specified selected index (via --- 'Just') is not in the list bounds, zero is used instead. --- --- Complexity: same as 'splitAt' for the container type. -listReplace :: (Foldable t, Splittable t) - => t e - -> Maybe Int - -> GenericList n t e - -> GenericList n t e -listReplace es idx l = - let l' = l & listElementsL .~ es - newSel = if null es then Nothing else inBoundsOrZero <$> idx - inBoundsOrZero i - | i == splitClamp l' i = i - | otherwise = 0 - in l' & listSelectedL .~ newSel - --- | Move the list selected index up by one. (Moves the cursor up, --- subtracts one from the index.) -listMoveUp :: (Foldable t, Splittable t) - => GenericList n t e - -> GenericList n t e -listMoveUp = listMoveBy (-1) - --- | Move the list selected index up by one page. -listMovePageUp :: (Foldable t, Splittable t, Ord n) - => GenericList n t e - -> EventM n (GenericList n t e) -listMovePageUp = listMoveByPages (-1::Double) - --- | Move the list selected index down by one. (Moves the cursor down, --- adds one to the index.) -listMoveDown :: (Foldable t, Splittable t) - => GenericList n t e - -> GenericList n t e -listMoveDown = listMoveBy 1 - --- | Move the list selected index down by one page. -listMovePageDown :: (Foldable t, Splittable t, Ord n) - => GenericList n t e - -> EventM n (GenericList n t e) -listMovePageDown = listMoveByPages (1::Double) - --- | Move the list selected index by some (fractional) number of pages. -listMoveByPages :: (Foldable t, Splittable t, Ord n, RealFrac m) - => m - -> GenericList n t e - -> EventM n (GenericList n t e) -listMoveByPages pages theList = do - v <- lookupViewport (theList^.listNameL) - case v of - Nothing -> return theList - Just vp -> do - let nElems = round $ pages * fromIntegral (vp^.vpSize._2) / - fromIntegral (theList^.listItemHeightL) - return $ listMoveBy nElems theList - --- | Move the list selected index. --- --- If the current selection is @Just x@, the selection is adjusted by --- the specified amount. The value is clamped to the extents of the list --- (i.e. the selection does not "wrap"). --- --- If the current selection is @Nothing@ (i.e. there is no selection) --- and the direction is positive, set to @Just 0@ (first element), --- otherwise set to @Just (length - 1)@ (last element). --- --- Complexity: same as 'splitAt' for the container type. --- --- @ --- listMoveBy for 'List': O(1) --- listMoveBy for 'Seq.Seq': O(log(min(i,n-i))) --- @ -listMoveBy :: (Foldable t, Splittable t) - => Int - -> GenericList n t e - -> GenericList n t e -listMoveBy amt l = - let target = case l ^. listSelectedL of - Nothing - | amt > 0 -> 0 - | otherwise -> length l - 1 - Just i -> max 0 (amt + i) -- don't be negative - in listMoveTo target l - --- | Set the selected index for a list to the specified index, subject --- to validation. --- --- If @pos >= 0@, indexes from the start of the list (which gets --- evaluated up to the target index) --- --- If @pos < 0@, indexes from the end of the list (which evalutes --- 'length' of the list). --- --- Complexity: same as 'splitAt' for the container type. --- --- @ --- listMoveTo for 'List': O(1) --- listMoveTo for 'Seq.Seq': O(log(min(i,n-i))) --- @ -listMoveTo :: (Foldable t, Splittable t) - => Int - -> GenericList n t e - -> GenericList n t e -listMoveTo pos l = - let len = length l - i = if pos < 0 then len - pos else pos - newSel = splitClamp l i - in l & listSelectedL .~ if null l then Nothing else Just newSel - --- | Split-based clamp that avoids evaluating 'length' of the structure --- (unless the structure is already fully evaluated). -splitClamp :: (Foldable t, Splittable t) => GenericList n t e -> Int -> Int -splitClamp l i = - let (_, t) = splitAt i (l ^. listElementsL) -- split at i - in - -- If the tail is empty, then the requested index is not in the - -- list. And because we have already seen the end of the list, - -- using 'length' will not force unwanted computation. - -- - -- Otherwise if tail is not empty, then we already know that i - -- is in the list, so we don't need to know the length - clamp 0 (if null t then length l - 1 else i) i - --- | Set the selected index for a list to the index of the first --- occurrence of the specified element if it is in the list, or leave --- the list unmodified otherwise. --- --- /O(n)/. Only evaluates as much of the container as needed. -listMoveToElement :: (Eq e, Foldable t, Splittable t) - => e - -> GenericList n t e - -> GenericList n t e -listMoveToElement e = listFindBy (== e) . set listSelectedL Nothing - --- | Set the selected index to the next element matching the --- predicate. If there is no selected element, the search starts at --- the beginning. If no matching element is found, leave the list --- unmodified. --- --- /O(n)/. Only evaluates as much of the container as needed. -listFindBy :: (Foldable t, Splittable t) - => (e -> Bool) - -> GenericList n t e - -> GenericList n t e -listFindBy test l = - let start = maybe 0 (+1) (l ^. listSelectedL) - (right,left) = splitAt start (l ^. listElementsL) - resultLeft = find (test . snd) . zip [0..] . toList $ left - resultRight = find (test . snd) . zip [0..] . toList $ right - in maybe (maybe id (set listSelectedL . Just . fst) resultRight) - (set listSelectedL . Just . (start +) . fst) resultLeft l - -listFindByOld :: (Foldable t, Splittable t) - => (e -> Bool) - -> GenericList n t e - -> GenericList n t e -listFindByOld test l = - let start = maybe 0 (+1) (l ^. listSelectedL) - (_, t) = splitAt start (l ^. listElementsL) - result = find (test . snd) . zip [0..] . toList $ t - in maybe id (set listSelectedL . Just . (start +) . fst) result l - --- | Return a list's selected element, if any. --- --- Only evaluates as much of the container as needed. --- --- Complexity: same as 'splitAt' for the container type. --- --- @ --- listSelectedElement for 'List': O(1) --- listSelectedElement for 'Seq.Seq': O(log(min(i, n - i))) --- @ -listSelectedElement :: (Splittable t, Foldable t) - => GenericList n t e - -> Maybe (Int, e) -listSelectedElement l = do - sel <- l^.listSelectedL - let (_, xs) = splitAt sel (l ^. listElementsL) - (sel,) <$> toList xs ^? _head - --- | Remove all elements from the list and clear the selection. --- --- /O(1)/ -listClear :: (Monoid (t e)) => GenericList n t e -> GenericList n t e -listClear l = l & listElementsL .~ mempty & listSelectedL .~ Nothing - --- | Reverse the list. The element selected before the reversal will --- again be the selected one. --- --- Complexity: same as 'reverse' for the container type. --- --- @ --- listReverse for 'List': O(n) --- listReverse for 'Seq.Seq': O(n) --- @ -listReverse :: (Reversible t, Foldable t) - => GenericList n t e - -> GenericList n t e -listReverse l = - l & listElementsL %~ reverse - & listSelectedL %~ fmap (length l - 1 -) - --- | Apply a function to the selected element. If no element is selected --- the list is not modified. --- --- Complexity: same as 'traverse' for the container type (typically --- /O(n)/). -listModify :: (Traversable t) - => (e -> e) - -> GenericList n t e - -> GenericList n t e -listModify f l = - case l ^. listSelectedL of - Nothing -> l - Just j -> l & listElementsL %~ imap (\i e -> if i == j then f e else e) - -instance W.Filterable t => W.Filterable (GenericList n t) where - catMaybes l = l & listElementsL %~ W.catMaybes - -instance (Traversable t, W.Filterable t) => W.Witherable (GenericList n t) where diff --git a/src/Brick/Widgets/Search.hs b/src/Brick/Widgets/Search.hs new file mode 100644 --- /dev/null +++ b/src/Brick/Widgets/Search.hs @@ -0,0 +1,83 @@ +-- | + +module Brick.Widgets.Search where + +import Text.Regex.TDFA +import qualified Data.Text as T +import Hum.Attributes +import Brick.Types +import Brick.Widgets.Core +import qualified Data.Array as A + +searchW :: Int -> Text -> Text -> Widget n +searchW highlight term contents = + let splits = T.splitOn term <$> lines contents + numMatches = sum $ (\ls -> max 0 (length ls - 1)) <$> splits + mkLine :: [Text] -> State Int (Widget n) + mkLine [] = pure emptyWidget + mkLine [""] = pure $ txt " " + mkLine [t] = pure $ txt t + mkLine (t:ts) = do + num <- get + let hl = (num - highlight) `mod` numMatches == 0 + modify (+1) + let (rest,numFinal) = runState (mkLine ts) (num+1) + put numFinal + pure $ txt t + <+> ((if hl then + visible . withAttr searchFocusedAttr + else withAttr searchAttr) $ txt term) + <+> rest + mkWidget :: [[Text]] -> State Int (Widget n) + mkWidget [] = pure emptyWidget + mkWidget [t] = join . pure $ mkLine t + mkWidget (t:ts) = do + num <- get + let (line,numLine) = runState (mkLine t) num + let (rest,numFinal) = runState (mkWidget ts) numLine + put numFinal + pure $ line <=> rest + in evalState (mkWidget splits) 0 + +splitRegex :: Regex -> Text -> [[(Text, Text)]] +splitRegex rg source = go [] rg <$> lines source + where + go :: [(Text, Text)] -> Regex -> Text -> [(Text, Text)] + go prev rg' rest = + let matches = matchOnceText rg' rest + in case matches of + Nothing -> prev ++ [(rest, "")] + Just (pre, mt, post) -> go + (prev ++ [(pre, maybe "" fst $ viaNonEmpty head (A.elems mt))]) + rg + post + +regexW :: Int -> Regex -> Text -> Widget n +regexW highlight term contents = + let splits = splitRegex term contents + numMatches = sum $ (\ls -> max 0 (length ls - 1)) <$> splits + mkLine :: [(Text,Text)] -> State Int (Widget n) + mkLine [] = pure emptyWidget + mkLine [("",_)] = pure $ txt " " + mkLine [(tx,_)] = pure $ txt tx + mkLine ((tx,mtch):ts) = do + num <- get + let hl = (num - highlight) `mod` numMatches == 0 + modify (+1) + let (rest,numFinal) = runState (mkLine ts) (num+1) + put numFinal + pure $ txt tx + <+> ((if hl then + visible . withAttr searchFocusedAttr + else withAttr searchAttr) $ txt mtch) + <+> rest + mkWidget :: [[(Text,Text)]] -> State Int (Widget n) + mkWidget [] = pure emptyWidget + mkWidget [t] = join . pure $ mkLine t + mkWidget (t:ts) = do + num <- get + let (line,numLine) = runState (mkLine t) num + let (rest,numFinal) = runState (mkWidget ts) numLine + put numFinal + pure $ line <=> rest + in evalState (mkWidget splits) 0 diff --git a/src/Hum/Attributes.hs b/src/Hum/Attributes.hs --- a/src/Hum/Attributes.hs +++ b/src/Hum/Attributes.hs @@ -1,5 +1,11 @@ --- | +-- | Module : Hum.Attributes +-- Copyright : (c) Itai Y. Efrat 2020-2021 +-- License : GPLv2-or-later (see LICENSE) +-- Maintainer : Itai Y. Efrat +-- +-- Brick/Vty color attributes. + module Hum.Attributes where import Brick.AttrMap @@ -13,7 +19,6 @@ import Graphics.Vty ( defAttr ) import qualified Graphics.Vty as Vty - humAttrMap :: AttrMap humAttrMap = attrMap defAttr @@ -22,31 +27,32 @@ , (listSelectedFocusedAttr, Vty.withStyle defAttr Vty.reverseVideo) , (listHighlightedAttr , BU.fg Vty.yellow) , (headerAttr , Vty.withStyle defAttr Vty.underline) - , (queueAlbumAttr , BU.fg Vty.red) - , (queueTrackAttr , BU.fg Vty.magenta) - , (queueTitleAttr , BU.fg Vty.cyan) - , (queueArtistAttr , BU.fg Vty.green) - , (queueTimeAttr , BU.fg Vty.blue) - , (queueDateAttr , BU.fg Vty.yellow) - , ( queueNowPlayingAttr - , Vty.withStyle (Vty.withStyle defAttr Vty.bold) Vty.underline - ) - , (queueTitleBoldAttr, Vty.withStyle defAttr Vty.bold) - , (editorAttr , BU.bg Vty.black) + , (albumAttr , BU.fg Vty.red) + , (trackAttr , BU.fg Vty.magenta) + , (titleAttr , BU.fg Vty.cyan) + , (artistAttr , BU.fg Vty.green) + , (timeAttr , BU.fg Vty.blue) + , (dateAttr , BU.fg Vty.yellow) + , ( queueNowPlayingAttr , Vty.withStyle + (Vty.withStyle defAttr Vty.bold) Vty.underline) + , (titleBoldAttr , Vty.withStyle defAttr Vty.bold) + , (editorAttr , BU.bg Vty.black) + , (searchAttr , Vty.withStyle defAttr Vty.reverseVideo) + , (searchFocusedAttr , BU.fg Vty.red) ] wobAttr :: Vty.Attr wobAttr = BU.fg Vty.white -queueAttr, queueAlbumAttr, queueTitleAttr, queueTrackAttr, queueArtistAttr, queueTimeAttr, queueDateAttr +queueAttr, albumAttr, titleAttr, trackAttr, artistAttr, timeAttr, dateAttr :: AttrName queueAttr = "queue" -queueAlbumAttr = queueAttr <> "album" -queueTitleAttr = queueAttr <> "title" -queueTrackAttr = queueAttr <> "track" -queueArtistAttr = queueAttr <> "artist" -queueTimeAttr = queueAttr <> "time" -queueDateAttr = queueAttr <> "date" +albumAttr = queueAttr <> "album" +titleAttr = queueAttr <> "title" +trackAttr = queueAttr <> "track" +artistAttr = queueAttr <> "artist" +timeAttr = queueAttr <> "time" +dateAttr = queueAttr <> "date" headerAttr :: AttrName headerAttr = "header" @@ -56,22 +62,26 @@ queueNowPlayingAttr :: AttrName queueNowPlayingAttr = queueAttr <> "now playing" -queueTitleBoldAttr :: AttrName -queueTitleBoldAttr = queueTitleAttr <> "bold" - +titleBoldAttr :: AttrName +titleBoldAttr = titleAttr <> "bold" editorAttr :: AttrName editorAttr = "editor" -highlightOverQueueAttrs :: Widget n -> Widget n -highlightOverQueueAttrs = updateAttrMap +searchAttr, searchFocusedAttr :: AttrName +searchAttr = "search" +searchFocusedAttr = searchAttr <> "focus" + +-- | Overwrites attributes for item to be highlighted. +highlightOverAttrs :: Widget n -> Widget n -- HACK? +highlightOverAttrs = updateAttrMap (mapAttrNames ( (listHighlightedAttr, ) - <$> [ queueAlbumAttr - , queueTrackAttr - , queueTitleAttr - , queueArtistAttr - , queueTimeAttr + <$> [ albumAttr + , trackAttr + , titleAttr + , artistAttr + , timeAttr ] ) ) diff --git a/src/Hum/BChan.hs b/src/Hum/BChan.hs deleted file mode 100644 --- a/src/Hum/BChan.hs +++ /dev/null @@ -1,6 +0,0 @@ --- | -module Hum.BChan where ---import Network.MPD ---import Hum.Types - --- put stuff dealing with Types here later diff --git a/src/Hum/Modes/ExMode.hs b/src/Hum/Modes/ExMode.hs --- a/src/Hum/Modes/ExMode.hs +++ b/src/Hum/Modes/ExMode.hs @@ -1,5 +1,11 @@ --- | +-- | Module : Hum.Modes.ExMode +-- Copyright : (c) Itai Y. Efrat 2020-2021 +-- License : GPLv2-or-later (see LICENSE) +-- Maintainer : Itai Y. Efrat +-- +-- Functions for the ex mode style prompt. + module Hum.Modes.ExMode where import Brick.Widgets.Edit hiding ( decodeUtf8 ) @@ -7,15 +13,17 @@ import Brick.Main import Hum.Types import Hum.Views -import Hum.Utils import Hum.Rebuild import Graphics.Vty.Input.Events import qualified Data.Text.Zipper as Z - hiding ( textZipper ) +import qualified Data.Text as T import Control.Lens hiding (uncons) import qualified Network.MPD as MPD +import Hum.Utils -exEnd :: HState -> EventM Name (Next HState) +-- | Executed after pressing enter in the ex mode prompt. +-- Either executes the command, or updates the search state for n/N to work. +exEnd :: HumState -> EventM Name (Next HumState) exEnd s = let searched = (s ^. exL . exEditorL . editContentsL & Z.currentLine) s'= s & exL . exEditorL .~ editorText ExEditor (Just 1) "" @@ -28,27 +36,36 @@ QueueView -> continue =<< queueSearch (srch == FSearch) s'' LibraryView -> continue =<< librarySearch (srch == FSearch) s'' PlaylistsView -> continue =<< playlistsSearch (srch == FSearch) s'' - HelpView -> continue s' + HelpView -> continue =<< helpSearch (srch == FSearch) s'' where s''= s' & exL . searchHistoryL %~ (searched :) + +-- | Handle key inputs for ex mode. handleExEvent - :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState) + :: HumState -> BrickEvent Name HumEvent -> EventM Name (Next HumState) handleExEvent s e = case e of + VtyEvent (EvKey KEsc []) -> + continue $ s & exL . exEditorL .~ editorText ExEditor (Just 1) "" + & modeL .~ NormalMode + & focusL . focExL .~ False VtyEvent (EvKey KEnter []) -> exEnd s VtyEvent vtye -> continue =<< handleEventLensed s (exL . exEditorL) handleEditorEvent vtye _ -> continue s +-- | Prefix of ex mode prompt. exPrefixTxt :: ExSubMode -> Text exPrefixTxt Cmd = ":" exPrefixTxt FSearch= "/" exPrefixTxt BSearch = "?" -exCmdExecute :: [Text] -> HState -> EventM Name (Next HState) +-- | Executes ex mode command. +exCmdExecute :: [Text] -> HumState -> EventM Name (Next HumState) exCmdExecute ("help":_) s = continue s { hview = HelpView } exCmdExecute ("q":_) s = halt s -exCmdExecute ("save":name) s = do - let songs = queue s - let name' = maybe "unnamed" fst (uncons name) - _ <- liftIO $ MPD.withMPD $ saveListToPl songs name' - continue =<< rebuildPl s +exCmdExecute ("save":name) s = + let name' = if null name then "unnamed" else unwords name in + do + name'' <- liftIO $ unusedPlName (fromString . T.unpack $ name') + _ <- liftIO $ MPD.withMPD $ MPD.save name'' + continue =<< rebuildPl s exCmdExecute _ s = continue s diff --git a/src/Hum/Modes/PromptMode.hs b/src/Hum/Modes/PromptMode.hs --- a/src/Hum/Modes/PromptMode.hs +++ b/src/Hum/Modes/PromptMode.hs @@ -1,8 +1,16 @@ --- | +-- | Module : Hum.Modes.PromptMode +-- Copyright : (c) Itai Y. Efrat 2020-2021 +-- License : GPLv2-or-later (see LICENSE) +-- Maintainer : Itai Y. Efrat +-- +-- Functions for prompts. + + module Hum.Modes.PromptMode where import Brick.Widgets.Edit hiding ( decodeUtf8 ) +import Brick.Widgets.List import Brick.Types import Brick.Main import Hum.Types @@ -13,22 +21,24 @@ import Control.Lens import qualified Network.MPD as MPD import qualified Data.Vector as V -import Brick.Widgets.List - +-- | Prompt key event dispatch. handlePromptEvent - :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState) + :: HumState -> BrickEvent Name HumEvent -> EventM Name (Next HumState) handlePromptEvent s e = case s ^. promptsL . currentPromptL of PlSelectPrompt -> handlePlSelectPromptEvent s e TextPrompt -> handleTextPromptEvent s e YNPrompt -> handleYNPromptEvent s e +-- | Handles key events for playlist select prompt. handlePlSelectPromptEvent - :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState) + :: HumState -> BrickEvent Name HumEvent -> EventM Name (Next HumState) handlePlSelectPromptEvent s e = case e of VtyEvent vtye -> case vtye of - EvKey KEsc [] -> continue $ s & modeL .~ NormalMode - EvKey (KChar 'q') [] -> continue $ s & modeL .~ NormalMode + EvKey KEsc [] -> continue + =<< (s ^. promptsL . exitPromptFuncL) False (s & modeL .~ NormalMode) + EvKey (KChar 'q') [] -> continue + =<< (s ^. promptsL . exitPromptFuncL) False (s & modeL .~ NormalMode) EvKey (KChar 'j') [] -> do continue $ s & promptsL . plSelectPromptL %~ listMoveDown EvKey (KChar 'k') [] -> do @@ -37,40 +47,56 @@ let songs = s ^. queueL & getHighlighted <&> fst & listElements case s ^. promptsL . plSelectPromptL & listSelectedElement <&> snd & join of Nothing -> continue $ s & promptsL . currentPromptL .~ TextPrompt - & promptsL . exitPromptL .~ songBulkAddtoNewPl songs - Just plname -> continue =<< songBulkAddtoPl (MPD.toString plname) songs s + & promptsL . exitPromptFuncL .~ songBulkAddtoNewPl songs + Just plname -> continue + =<< songBulkAddtoPl (MPD.toString plname) songs (s & modeL .~ NormalMode) EvKey KEnter [] -> do -- HACK find a way to unduplucate this let songs = s ^. queueL & getHighlighted <&> fst & listElements case s ^. promptsL . plSelectPromptL & listSelectedElement <&> snd & join of Nothing -> continue $ s & promptsL . currentPromptL .~ TextPrompt - & promptsL . exitPromptL .~ songBulkAddtoNewPl songs - Just plname -> continue =<< songBulkAddtoPl (MPD.toString plname) songs s + & promptsL . exitPromptFuncL .~ songBulkAddtoNewPl songs + Just plname -> continue + =<< songBulkAddtoPl (MPD.toString plname) songs (s & modeL .~ NormalMode) _ -> continue s _ -> continue s -songBulkAddtoNewPl :: V.Vector MPD.Song -> HState -> EventM n HState -songBulkAddtoNewPl songs st = songBulkAddtoPl - (toString $ st ^. promptsL . textPromptL . editContentsL & Z.currentLine) - songs - st +-- | Add given songs to new playlist entered in prompt. +songBulkAddtoNewPl + :: V.Vector MPD.Song -> Bool -> HumState -> EventM n HumState +songBulkAddtoNewPl songs bl st = if bl + then songBulkAddtoPl + (toString $ st ^. promptsL . textPromptL . editContentsL & Z.currentLine) + songs + st + else pure st +-- | Handles key events for generic text prompt. handleTextPromptEvent - :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState) + :: HumState -> BrickEvent Name HumEvent -> EventM Name (Next HumState) handleTextPromptEvent s e = case e of - VtyEvent (EvKey KEsc []) -> continue (s & modeL .~ NormalMode) - VtyEvent (EvKey KEnter []) -> - continue =<< (s ^. promptsL . exitPromptL) (s & modeL .~ NormalMode) + VtyEvent (EvKey KEsc []) -> continue + =<< (s ^. promptsL . exitPromptFuncL) False (s & modeL .~ NormalMode) + VtyEvent (EvKey KEnter []) -> continue + =<< (s ^. promptsL . exitPromptFuncL) True (s & modeL .~ NormalMode) VtyEvent vtye -> continue =<< handleEventLensed s (promptsL . textPromptL) handleEditorEvent vtye _ -> continue s +-- | Handles key events for generic yes/no prompt. handleYNPromptEvent - :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState) + :: HumState -> BrickEvent Name HumEvent -> EventM Name (Next HumState) handleYNPromptEvent s e = case e of - VtyEvent (EvKey KEsc []) -> continue (s & modeL .~ NormalMode) + VtyEvent (EvKey KEsc []) -> + continue + =<< (s ^. promptsL . exitPromptFuncL) False (s & modeL .~ NormalMode) VtyEvent (EvKey (KChar 'y') []) -> - continue =<< (s ^. promptsL . exitPromptL) (s & modeL .~ NormalMode) - VtyEvent (EvKey (KChar 'n') []) -> continue (s & modeL .~ NormalMode) - VtyEvent (EvKey (KChar 'q') []) -> continue (s & modeL .~ NormalMode) + continue + =<< (s ^. promptsL . exitPromptFuncL) True (s & modeL .~ NormalMode) + VtyEvent (EvKey (KChar 'n') []) -> + continue + =<< (s ^. promptsL . exitPromptFuncL) False (s & modeL .~ NormalMode) + VtyEvent (EvKey (KChar 'q') []) -> + continue + =<< (s ^. promptsL . exitPromptFuncL) False (s & modeL .~ NormalMode) _ -> continue s diff --git a/src/Hum/Orphans.hs b/src/Hum/Orphans.hs new file mode 100644 --- /dev/null +++ b/src/Hum/Orphans.hs @@ -0,0 +1,19 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +-- | Module : Hum.Orphans +-- Copyright : (c) Itai Y. Efrat 2020-2021 +-- License : GPLv2-or-later (see LICENSE) +-- Maintainer : Itai Y. Efrat +-- + +module Hum.Orphans where + +import qualified Witherable as W +import Brick.Widgets.List +import Control.Lens + +-- | There isn't one obvious implementation fo this, so it can't be upstreamed. +instance W.Filterable t => W.Filterable (GenericList n t) where + catMaybes l = l & listElementsL %~ W.catMaybes + +instance (Traversable t, W.Filterable t) => W.Witherable (GenericList n t) where diff --git a/src/Hum/Rebuild.hs b/src/Hum/Rebuild.hs --- a/src/Hum/Rebuild.hs +++ b/src/Hum/Rebuild.hs @@ -1,62 +1,121 @@ --- | +-- | Module : Hum.Rebuild +-- Copyright : (c) Itai Y. Efrat 2020-2021 +-- License : GPLv2-or-later (see LICENSE) +-- Maintainer : Itai Y. Efrat +-- +-- Functions that rebuild the state after changes that require it, +-- Or that have to be here to avoid dependency loops. module Hum.Rebuild where import Hum.Types import Control.Lens +import Data.Foldable import Brick.Widgets.List import Network.MPD ( withMPD ) import qualified Network.MPD as MPD import qualified Data.Vector as V --- in which we have funcitons to rebuild the state when it changes. -songsOfArtist :: Maybe MPD.Value -> IO (V.Vector MPD.Song) -songsOfArtist martist = V.fromList . fromRight [] <$> withMPD - (MPD.find (MPD.AlbumArtist MPD.=? fromMaybe "" martist)) +-- | All songs of a given artist +songsOfArtist :: MPD.Value -> IO (V.Vector MPD.Song) +songsOfArtist artist' = + (V.fromList . fromRight [] <$>) + . withMPD + . MPD.find $ (MPD.AlbumArtist MPD.=? artist') -songsOfAlbum :: Maybe MPD.Value -> IO (V.Vector MPD.Song) -songsOfAlbum malbum = V.fromList . fromRight [] <$> withMPD - (MPD.find (MPD.Album MPD.=? fromMaybe "" malbum)) -albumsOfArtist :: Maybe MPD.Value -> IO (V.Vector MPD.Value) -albumsOfArtist martist = - V.fromList . fromRight [] <$> withMPD (MPD.list MPD.Album martist) +-- | All songs in a given album +songsOfAlbum ::MPD.Value -> IO (V.Vector MPD.Song) +songsOfAlbum album' = + (V.fromList . fromRight [] <$>) + . withMPD + . MPD.find $ (MPD.Album MPD.=? album') +-- | All albums of a given artist +albumsOfArtist :: MPD.Value -> IO (V.Vector MPD.Value) +albumsOfArtist artist' = + V.fromList . fromRight [] <$> withMPD (MPD.list MPD.Album (MPD.AlbumArtist MPD.=? artist')) -rebuildLib :: MonadIO m => HState -> m HState +-- | All year-album pairs of a given artist +yalbumsOfArtist :: Bool -> MPD.Value -> IO (V.Vector (MPD.Value,MPD.Value)) +yalbumsOfArtist bl artist' = let srt = (if bl then fst else snd) + in do + albums' <- fromRight [] <$> withMPD (MPD.list MPD.Album (MPD.AlbumArtist MPD.=? artist')) + yalbums' <- liftIO . sequence $ (\x -> (,x) <$> yearOfAlbum x) <$> albums' + pure $ V.fromList (sortBy (\x y -> compare (srt x) (srt y)) yalbums') + +-- | Earliest year of any song in the given album +yearOfAlbum :: MPD.Value -> IO MPD.Value +yearOfAlbum album' = fromRight "????" <$> (minYear <<$>> withMPD (MPD.list MPD.Date (MPD.Album MPD.=? album'))) + where minYear :: [MPD.Value] -> MPD.Value + minYear [] = "????" + minYear vals = minimum vals + +-- | Rebuild entire library state, keeping the index of the left column if possible. +rebuildLib :: MonadIO m => HumState -> m HumState rebuildLib s = do + let mi = s ^. libraryL . artistsL & listSelected artistsVec <- liftIO (V.fromList . fromRight [] <$> withMPD - (MPD.list MPD.AlbumArtist Nothing)) - let artists' = list ArtistsList artistsVec 1 - albumsVec <- liftIO $ albumsOfArtist (snd <$> listSelectedElement artists') + (MPD.list MPD.AlbumArtist mempty)) + let artists' = maybe id listMoveTo mi $ list ArtistsList artistsVec 1 + albumsVec <- liftIO $ maybe (pure empty) albumsOfArtist (snd <$> listSelectedElement artists') let albums' = list AlbumsList albumsVec 1 - songsVec <- liftIO $ songsOfAlbum (snd <$> listSelectedElement albums') + yalbumsVec <- liftIO $ maybe (pure empty) (yalbumsOfArtist (s ^. libraryL . yalbumSortL)) (snd <$> listSelectedElement artists') + let yalbums' = list YalbumsList yalbumsVec 1 + songsVec <- liftIO $ maybe (pure empty) songsOfAlbum (snd <$> listSelectedElement albums') let songs' = list SongsList songsVec 1 pure $ s & libraryL . artistsL .~ artists' - & libraryL . albumsL .~ albums' + & libraryL . yalbumsL .~ yalbums' & libraryL . songsL .~ songs' -rebuildLibArtists :: MonadIO m => HState -> m HState +-- | Rebuild library state from selected artist. +rebuildLibArtists :: MonadIO m => HumState -> m HumState rebuildLibArtists s = do let artists' = s ^. libraryL . artistsL - albumsVec <- liftIO $ albumsOfArtist (snd <$> listSelectedElement artists') - let albums' = list AlbumsList albumsVec 1 - songsVec <- liftIO $ songsOfAlbum (snd <$> listSelectedElement albums') + yalbumsVec <- liftIO $ maybe (pure empty) (yalbumsOfArtist (s ^. libraryL . yalbumSortL)) (snd <$> listSelectedElement artists') + let yalbums' = list YalbumsList yalbumsVec 1 + songsVec <- liftIO $ maybe (pure empty) songsOfAlbum (snd . snd <$> listSelectedElement yalbums') let songs' = list SongsList songsVec 1 - pure $ s & libraryL . artistsL .~ artists' - & libraryL . albumsL .~ albums' + pure $ s & libraryL . yalbumsL .~ yalbums' & libraryL . songsL .~ songs' -rebuildLibAlbums :: MonadIO m => HState -> m HState +-- | Rebuild library state from selected artist. +reloadLibArtists :: MonadIO m => HumState -> m HumState +reloadLibArtists s = do + let mi = s ^. libraryL . yalbumsL & listSelected + let mj = s ^. libraryL . songsL & listSelected + let artists' = s ^. libraryL . artistsL + yalbumsVec <- liftIO $ maybe (pure empty) (yalbumsOfArtist (s ^. libraryL . yalbumSortL)) (snd <$> listSelectedElement artists') + let yalbums' = maybe id listMoveTo mi $ list YalbumsList yalbumsVec 1 + songsVec <- liftIO $ maybe (pure empty) songsOfAlbum (snd . snd <$> listSelectedElement yalbums') + let songs' = maybe id listMoveTo mj $ list SongsList songsVec 1 + pure $ s & libraryL . yalbumsL .~ yalbums' + & libraryL . songsL .~ songs' + + +-- | Rebuild library state from selected album. +rebuildLibAlbums :: MonadIO m => HumState -> m HumState rebuildLibAlbums s = do - let albums' = s ^. libraryL . albumsL - songsVec <- liftIO $ songsOfAlbum (snd <$> listSelectedElement albums') + let yalbums' = s ^. libraryL . yalbumsL + songsVec <- liftIO $ maybe (pure empty) songsOfAlbum (snd . snd <$> listSelectedElement yalbums') let songs' = list SongsList songsVec 1 - pure $ s & libraryL . albumsL .~ albums' & libraryL . songsL .~ songs' + pure $ s & libraryL . songsL .~ songs' -rebuildPl :: MonadIO m => HState -> m HState +-- | Rebuild library state from selected album, keeping the selected song index if possible. +reloadLibAlbums :: MonadIO m => HumState -> m HumState +reloadLibAlbums s = do + let mi = s ^. libraryL . songsL & listSelected + let yalbums' = s ^. libraryL . yalbumsL + songsVec <- liftIO $ maybe (pure empty) songsOfAlbum (snd . snd <$> listSelectedElement yalbums') + let songs' = maybe id listMoveTo mi $ list SongsList songsVec 1 + pure $ s & libraryL . songsL .~ songs' + + +-- | Rebuild entire stored playlists state, keeping the index of the left column if possible. +rebuildPl :: MonadIO m => HumState -> m HumState rebuildPl s = do - plListVec <- liftIO $ V.fromList . fromRight [] <$> withMPD MPD.listPlaylists - let plList' = list PlaylistList plListVec 1 + let mi = s ^. playlistsL . plListL & listSelected + plListVec <- liftIO $ V.fromList . sort . fromRight [] <$> withMPD MPD.listPlaylists + let plList' = maybe id listMoveTo mi $ list PlaylistList plListVec 1 plSongsVec <- liftIO $ V.fromList . fromRight [] <$> withMPD (MPD.listPlaylistInfo (maybe "" snd (listSelectedElement plList')) @@ -65,7 +124,8 @@ pure $ s & playlistsL . plListL .~ plList' & playlistsL . plSongsL .~ plSongs' -rebuildPlList :: MonadIO m => HState -> m HState +-- | Rebuild stored playlists state from selected playlist. +rebuildPlList :: MonadIO m => HumState -> m HumState rebuildPlList s = do let plList' = s ^. playlistsL . plListL plSongsVec <- liftIO @@ -75,11 +135,35 @@ ) ) let plSongs' = (, False) <$> list PlaylistSongs plSongsVec 1 - pure $ s & playlistsL . plListL .~ plList' - & playlistsL . plSongsL .~ plSongs' + pure $ s & playlistsL . plSongsL .~ plSongs' -rebuildQueue :: MonadIO m => HState -> m HState +-- | Rebuild stored playlists state from selected playlist, keeping the selected song index if possible. +reloadPlList :: MonadIO m => HumState -> m HumState +reloadPlList s = do + let mi = s ^. playlistsL . plSongsL & listSelected + let plList' = s ^. playlistsL . plListL + plSongsVec <- liftIO + (V.fromList . fromRight [] <$> withMPD + (MPD.listPlaylistInfo + (maybe "" snd (listSelectedElement plList')) + ) + ) + let plSongs' = maybe id listMoveTo mi $ (, False) <$> list PlaylistSongs plSongsVec 1 + pure $ s & playlistsL . plSongsL .~ plSongs' + + +-- | Rebuild queue state, keeping the index of the left column if possible. +rebuildQueue :: MonadIO m => HumState -> m HumState rebuildQueue s = do + let mi = s ^. queueL & listSelected queueVec <- liftIO $ V.fromList . fromRight [] <$> withMPD (MPD.playlistInfo Nothing) - let queue' = (, False) <$> list QueueList queueVec 1 + let queue' = maybe id listMoveTo mi $ (, False) <$> list QueueList queueVec 1 pure $ s & queueL .~ queue' + +-- | Rebuild status and current song state. +rebuildStatus :: MonadIO m => HumState -> m HumState +rebuildStatus s = do + currentSong' <- liftIO (fromRight Nothing <$> withMPD MPD.currentSong) + status' <- liftIO (fromRight Nothing <$> (Just <<$>> withMPD MPD.status)) + pure $ s & currentSongL .~ currentSong' + & statusL .~ status' diff --git a/src/Hum/Types.hs b/src/Hum/Types.hs --- a/src/Hum/Types.hs +++ b/src/Hum/Types.hs @@ -1,89 +1,109 @@ --- | +-- | Module : Hum.Types +-- Copyright : (c) Itai Y. Efrat 2020-2021 +-- License : GPLv2-or-later (see LICENSE) +-- Maintainer : Itai Y. Efrat +-- +-- Types! module Hum.Types where -import Network.MPD as MPD -import qualified Brick.BChan as BC +import Network.MPD +import Brick.BChan import Brick.Types import Brick.Widgets.Edit import Brick.Widgets.List - +import Hum.Orphans ( ) -data HState = HState - { chan :: !(BC.BChan HumEvent) - , hview :: !View - , status :: !(Maybe MPD.Status) - , mode :: !Mode - , ex :: !ExState - , currentSong :: !(Maybe MPD.Song) - , queue :: !SongList +-- | Describes the state of the app. +data HumState = HumState + { chan :: !(BChan HumEvent) -- ^ The channel for MPD and time events + , hview :: !View -- ^ The current view: Queue, Library, etc. + , status :: !(Maybe Status) -- ^ MPD's status + , mode :: !Mode -- ^ Input mode + , ex :: !ExState -- ^ The state of the ex mode style prompt at the bottom + , currentSong :: !(Maybe Song) + , queue :: !SongList -- ^ Also called the playlist in MPD , library :: !LibraryState , playlists :: !PlaylistsState - , extentMap :: !(Map Name (Maybe (Extent Name))) , clipboard :: !Clipboard - , focus :: !Focus - , editable :: !Bool + , focus :: !Focus -- ^ The current focus in each view + , editable :: !Bool -- ^ Whether the selected stored playlist is editable , prompts :: !Prompts - , helpScreen :: !Int --HACK + , help :: !HelpState -- ^ Help View } --- deriving (Show) --, Eq) + data LibraryState = LibraryState - { artists :: !(List Name MPD.Value) - , albums :: !(List Name MPD.Value) - , songs :: !(List Name Song) + { artists :: !(List Name Value) -- ^ All album artists + , yalbums :: !(List Name (Value,Value)) -- ^ Year-Album pairs of the selected artist + , yalbumSort :: !Bool -- ^ Toggle sort of yalbums between years and alphabeitcal order + , songs :: !(List Name Song) -- ^ Songs in selected album } +-- | Stored playlists data PlaylistsState = PlaylistsState - { plList :: !(List Name PlaylistName) - , plSongs :: !SongList + { plList :: !(List Name PlaylistName) -- ^ List of stored playlists + , plSongs :: !SongList -- ^ Songs in selected playlist } - -data ExSubMode = Cmd | FSearch | BSearch +data HelpState = HelpState + { helpText :: !Text -- ^ Contents of help screen + , helpSearchInt :: !Int -- ^ number of focused search match + } +-- | Specific mode in the bottom prompt +data ExSubMode = + Cmd -- ^ Function commands + | FSearch -- ^ Forward search + | BSearch -- ^ Backwards search deriving (Show, Eq, Ord) data ExState = ExState { exPrefix :: !ExSubMode , exEditor :: !(Editor Text Name) - , searchDirection :: !Bool + , searchDirection :: !Bool -- ^ Search direction of last search , searchHistory :: ![Text] , cmdHistory :: ![Text] } data Prompts = Prompts - { currentPrompt :: !PromptType - , promptTitle :: Text - , plSelectPrompt :: !(List Name (Maybe PlaylistName)) - , textPrompt :: !(Editor Text Name) - , exitPrompt :: HState -> EventM Name HState + { currentPrompt :: !PromptType + , promptTitle :: Text + , plSelectPrompt :: !(List Name (Maybe PlaylistName)) -- ^ List to select playlist from + , textPrompt :: !(Editor Text Name) -- ^ Editor if needed + , exitPromptFunc :: Bool -> HumState -> EventM Name HumState -- ^ Executes on exit from prompt, True for execute and False for quit. } -data PromptType = PlSelectPrompt | YNPrompt | TextPrompt +data PromptType = + PlSelectPrompt -- ^ Select playlist to add songs to + | YNPrompt -- ^ General yes/no prompt + | TextPrompt -- ^ General enter text and do stuff prompt deriving (Show,Eq) -data Clipboard = Clipboard { clSongs :: !SongList - , clPlName :: !(Maybe PlaylistName)} - -data Mode = NormalMode | ExMode | PromptMode +data Clipboard = Clipboard { clSongs :: !SongList -- ^ Last list of songs copied + , clPlName :: !(Maybe PlaylistName) -- ^ Last playlist name copied + } +-- | General input mode +data Mode = + NormalMode -- ^ Vim normal mode style movement + | ExMode -- ^ Type ex style commands or search + | PromptMode -- ^ Interact with a prompt deriving (Show,Eq) +type Highlight = Bool + type SongList = List Name (Song, Highlight) type HumEvent = Either Tick (Response [Subsystem]) -data Name = NowPlaying | ClSongs +-- | Brick widget names +data Name = + NowPlaying | ClSongs | Queue | QueueList - | Library | ArtistsList | LibraryLeft | AlbumsList | LibraryMid | SongsList | LibraryRight + | Library | ArtistsList | LibraryLeft | AlbumsList | YalbumsList | LibraryMid | SongsList | LibraryRight | PlaylistList | PlaylistLeft | PlaylistSongs | PlaylistRight + | Help | ExEditor | TextPromptEditor deriving (Show, Eq, Ord) -data FocQueue = FocQueue - deriving (Show, Eq, Ord) -data FocLib = FocArtists | FocAlbums | FocSongs - deriving(Show,Eq,Ord,Enum) -data FocPlay = FocPlaylists | FocPSongs - deriving(Show,Eq,Ord,Enum) data Focus = Focus { focQueue :: FocQueue , focLib :: FocLib @@ -92,17 +112,25 @@ } deriving (Show, Eq, Ord) +data FocQueue = FocQueue + deriving (Show, Eq, Ord) + +data FocLib = FocArtists | FocAlbums | FocSongs + deriving(Show,Eq,Ord,Enum) + +data FocPlay = FocPlaylists | FocPSongs + deriving(Show,Eq,Ord,Enum) + data View = QueueView | LibraryView | PlaylistsView | HelpView deriving (Show,Eq,Ord) -type Highlight = Bool - data Tick = Tick -suffixLenses ''HState +suffixLenses ''HumState suffixLenses ''Focus suffixLenses ''LibraryState suffixLenses ''PlaylistsState +suffixLenses ''HelpState suffixLenses ''ExState suffixLenses ''Prompts suffixLenses ''Clipboard diff --git a/src/Hum/UI.hs b/src/Hum/UI.hs --- a/src/Hum/UI.hs +++ b/src/Hum/UI.hs @@ -1,4 +1,12 @@ -{-# LANGUAGE LambdaCase #-} + +-- | Module : Hum.UI +-- Copyright : (c) Itai Y. Efrat 2020-2021 +-- License : GPLv2-or-later (see LICENSE) +-- Maintainer : Itai Y. Efrat +-- +-- The starting point of Hum's logic. Contains things like building the initial +-- state, shared keypresses, and the UI drawing function. + module Hum.UI where @@ -17,14 +25,12 @@ import Hum.Attributes import Hum.Views import Hum.Modes -import Hum.Utils import Hum.Rebuild -import qualified Data.Map.Strict as Map import Control.Lens import System.Directory -app :: App HState HumEvent Name - +-- | The brick app record for Hum. +app :: App HumState HumEvent Name app = App { appDraw = drawUI , appChooseCursor = chooseCursor , appHandleEvent = handleEvent @@ -32,7 +38,8 @@ , appAttrMap = const humAttrMap } -drawUI :: HState -> [Widget Name] +-- | Draws shared UI elements and dispatches for view specific ones. +drawUI :: HumState -> [Widget Name] drawUI st = [if st ^. modeL == PromptMode then drawPrompt st else emptyWidget, drawNowPlaying st @@ -50,7 +57,8 @@ else txt " " ] -chooseCursor :: HState -> [CursorLocation Name] -> Maybe (CursorLocation Name) +-- | Make sure cursor is displayed when editing text. +chooseCursor :: HumState -> [CursorLocation Name] -> Maybe (CursorLocation Name) chooseCursor st ls | st ^. focusL . focExL = find (isCurrent ExEditor) ls | st ^. promptsL . currentPromptL == TextPrompt = find (isCurrent TextPromptEditor) ls @@ -58,7 +66,9 @@ where isCurrent n cl = cl ^. cursorLocationNameL == Just n -buildInitialState :: BC.BChan HumEvent -> IO HState +-- | builds ''HumState' for the first time. A lot of overlap with functions from +-- | "Hum.Rebuild", but they are hard to reuse because 'HumState' is strict. +buildInitialState :: BC.BChan HumEvent -> IO HumState buildInitialState chan = do configDir <- getXdgDirectory XdgConfig "hum" _ <- createDirectoryIfMissing True configDir @@ -72,7 +82,6 @@ currentSong <- fromRight Nothing <$> withMPD MPD.currentSong status <- fromRight Nothing <$> (Just <<$>> withMPD MPD.status) let hview = QueueView - let extentMap = Map.empty let focus = Focus { focQueue = FocQueue , focLib = FocArtists , focPlay = FocPlaylists @@ -82,21 +91,21 @@ , clPlName = Nothing} queueVec <- V.fromList . fromRight [] <$> withMPD (MPD.playlistInfo Nothing) let queue = (, False) <$> list QueueList queueVec 1 - artistsVec <- V.fromList . fromRight [] <$> withMPD - (MPD.list MPD.AlbumArtist Nothing) + artistsVec <- V.fromList . fromRight [] <$> withMPD (MPD.list MPD.AlbumArtist mempty) let artists = list ArtistsList artistsVec 1 - albumsVec <- albumsOfArtist (snd <$> listSelectedElement artists) - let albums = list AlbumsList albumsVec 1 - songsVec <- songsOfAlbum (snd <$> listSelectedElement albums) + let yalbumSort = True + yalbumsVec <- maybe (pure empty) (yalbumsOfArtist yalbumSort) (snd <$> listSelectedElement artists) + let yalbums = list YalbumsList yalbumsVec 1 + songsVec <- maybe (pure empty) songsOfAlbum (snd . snd <$> listSelectedElement yalbums) let songs = list SongsList songsVec 1 - plListVec <- V.fromList . fromRight [] <$> withMPD MPD.listPlaylists + let library = LibraryState { artists, yalbums, yalbumSort, songs } + plListVec <- V.fromList . sort . fromRight [] <$> withMPD MPD.listPlaylists let plList = list PlaylistList plListVec 1 plSongsVec <- V.fromList . fromRight [] <$> withMPD ( MPD.listPlaylistInfo $ maybe "" snd (listSelectedElement plList) ) let plSongs = (, False) <$> list PlaylistSongs plSongsVec 1 - let library = LibraryState { artists, albums, songs } let playlists = PlaylistsState { plList, plSongs } let editable = False let prompts = Prompts @@ -104,42 +113,36 @@ , promptTitle = "" , textPrompt = editorText TextPromptEditor (Just 1) "" , plSelectPrompt = listInsert 0 Nothing (Just <$> plList) - , exitPrompt = \s -> pure $ s & modeL .~ NormalMode + , exitPromptFunc = \_ s -> pure $ s & modeL .~ NormalMode } - let helpScreen = 0 - pure HState { chan + let help = HelpState + { helpText = helpText' + , helpSearchInt = 0 + } + pure HumState { chan , hview , mode , ex , status , currentSong , queue - , extentMap , clipboard , library , playlists + , help , focus , editable , prompts - , helpScreen } -humStartEvent :: HState -> EventM Name HState +-- | Initial event. +humStartEvent :: HumState -> EventM Name HumState humStartEvent = pure -hBoxPad :: Padding -> [Widget n] -> Widget n -hBoxPad _ [] = emptyWidget -hBoxPad _ [w ] = w -hBoxPad p (w : ws) = padRight p w <+> hBoxPad p ws - -seekCurEventM :: MPD.FractionalSeconds -> HState -> EventM Name HState -seekCurEventM i s = do - _ <- liftIO (withMPD $ MPD.seekCur False i) - status <- liftIO (fromRight Nothing <$> (Just <<$>> withMPD MPD.status)) - song <- liftIO (withMPD MPD.currentSong) - pure s { currentSong = fromRight Nothing song, status } - -handleEvent :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState) +-- | handles keypresses shared between views, and nonkeypress events from the +-- channels (ticks every 0.1 seconds and mpd events). Dispatches for view +-- specific keypresses. +handleEvent :: HumState -> BrickEvent Name HumEvent -> EventM Name (Next HumState) handleEvent s e = case e of VtyEvent vtye -> case s ^. modeL of ExMode -> handleExEvent s e @@ -149,24 +152,20 @@ EvKey (KChar 't') [] -> do st <- liftIO ((MPD.stState <$>) <$> withMPD MPD.status) _ <- case st of - Left _ -> liftIO (withMPD $ MPD.pause True) - Right MPD.Paused -> liftIO (withMPD $ MPD.play Nothing) - Right MPD.Stopped -> liftIO (withMPD $ MPD.play Nothing) - Right MPD.Playing -> liftIO (withMPD $ MPD.pause True) + Left _ -> liftIO (withMPD $ MPD.pause True) + Right _ -> liftIO (withMPD $ MPD.toggle) continue s EvKey (KChar 's') [] -> do _ <- liftIO (withMPD $ MPD.single (maybe False (not . MPD.stSingle) (status s))) - status <- liftIO (fromRight Nothing <$> (Just <<$>> withMPD MPD.status)) - continue s { status } + continue =<< rebuildStatus s EvKey (KChar 'c') [] -> do _ <- liftIO ( withMPD $ MPD.consume (maybe False (not . MPD.stConsume) (status s)) ) - status <- liftIO (fromRight Nothing <$> (Just <<$>> withMPD MPD.status)) - continue s { status } + continue =<< rebuildStatus s EvKey (KChar 'x') [] -> do _ <- liftIO (withMPD $ MPD.crossfade @@ -176,19 +175,16 @@ ) $ maybe 0 MPD.stXFadeWidth (status s) ) - ) -- TODO - status <- liftIO (fromRight Nothing <$> (Just <<$>> withMPD MPD.status)) - continue s { status } + ) + continue =<< rebuildStatus s EvKey (KChar 'r') [] -> do _ <- liftIO (withMPD $ MPD.repeat (maybe False (not . MPD.stRepeat) (status s))) - status <- liftIO (fromRight Nothing <$> (Just <<$>> withMPD MPD.status)) - continue s { status } + continue =<< rebuildStatus s EvKey (KChar 'z') [] -> do _ <- liftIO (withMPD $ MPD.random (maybe False (not . MPD.stRandom) (status s))) - status <- liftIO (fromRight Nothing <$> (Just <<$>> withMPD MPD.status)) - continue s { status } + continue =<< rebuildStatus s EvKey (KChar '/') [] -> continue $ s & modeL .~ ExMode & exL . exPrefixL .~ FSearch @@ -205,16 +201,22 @@ & focusL . focExL .~ True EvKey (KChar '.') [] -> do _ <- liftIO (withMPD MPD.next) - song <- liftIO (withMPD MPD.currentSong) - continue s { currentSong = fromRight Nothing song } + continue =<< rebuildStatus s EvKey (KChar ',') [] -> do _ <- liftIO (withMPD MPD.previous) - song <- liftIO (withMPD MPD.currentSong) - continue s { currentSong = fromRight Nothing song } - EvKey (KChar ']') [] -> continue =<< seekCurEventM 5 s - EvKey (KChar '[') [] -> continue =<< seekCurEventM (-5) s - EvKey (KChar '}') [] -> continue =<< seekCurEventM 30 s - EvKey (KChar '{') [] -> continue =<< seekCurEventM (-30) s + continue =<< rebuildStatus s + EvKey (KChar ']') [] -> do + _ <- liftIO (withMPD $ MPD.seekCur False 5) + continue =<< rebuildStatus s + EvKey (KChar '[') [] -> do + _ <- liftIO (withMPD $ MPD.seekCur False (-5)) + continue =<< rebuildStatus s + EvKey (KChar '}') [] -> do + _ <- liftIO (withMPD $ MPD.seekCur False 30) + continue =<< rebuildStatus s + EvKey (KChar '{') [] -> do + _ <- liftIO (withMPD $ MPD.seekCur False (-30)) + continue =<< rebuildStatus s EvKey (KChar '1') [] -> do _ <- liftIO (BC.writeBChan (chan s) (Left Tick)) continue $ s & editableL .~ False @@ -227,26 +229,14 @@ _ <- liftIO (BC.writeBChan (chan s) (Left Tick)) continue $ s & editableL .~ False & hviewL .~ PlaylistsView - EvResize _ _ -> do - extentMap <- updateExtentMap - continue s { extentMap } + EvResize _ _ -> continue s _ -> case hview s of QueueView -> handleEventQueue s e LibraryView -> handleEventLibrary s e PlaylistsView -> handleEventPlaylists s e HelpView -> handleEventHelp s e - (AppEvent (Left Tick)) -> do - extentMap <- updateExtentMap - status <- liftIO (fromRight Nothing <$> (Just <<$>> withMPD MPD.status)) - continue s { status, extentMap } - (AppEvent (Right (Right _))) -> do - currentSong <- liftIO (fromRight Nothing <$> withMPD MPD.currentSong) - status <- liftIO (fromRight Nothing <$> (Just <<$>> withMPD MPD.status)) - queueVec <- liftIO - (V.fromList . fromRight [] <$> withMPD (MPD.playlistInfo Nothing)) - let queueUnmoved = (, False) <$> list QueueList queueVec 1 - let queueNew = case listSelected (queue s) of - Nothing -> queueUnmoved - Just i -> listMoveTo i queueUnmoved - continue s { currentSong, status, queue = queueNew } + (AppEvent (Left Tick)) -> continue =<< rebuildStatus s + (AppEvent (Right (Right subs))) + | MPD.PlaylistS `elem` subs -> continue =<< rebuildStatus =<< rebuildQueue s + | otherwise -> continue =<< rebuildStatus s _ -> continue s diff --git a/src/Hum/Utils.hs b/src/Hum/Utils.hs --- a/src/Hum/Utils.hs +++ b/src/Hum/Utils.hs @@ -1,21 +1,27 @@ --- | +-- | Module : Hum.Utils +-- Copyright : (c) Itai Y. Efrat 2020-2021 +-- License : GPLv2-or-later (see LICENSE) +-- Maintainer : Itai Y. Efrat +-- + + 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 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 Data.Witherable.Class as W +import qualified Witherable as W --- | A backwards function composition operator +-- | 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 @@ -23,44 +29,25 @@ (?) :: (a -> b) -> (b -> c) -> a -> c (?) f g = \x -> g (f x) --- | Get comma seperated metedata from tag +-- | 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 +-- | 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) -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 - +-- | 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 @@ -69,28 +56,29 @@ ((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) +-- | 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) -pasteSongstoQ :: MPD.MonadMPD m => SongList -> SongList -> m () +-- | 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 - :: (Eq e, W.Filterable t, Foldable t, Splittable t) + :: (W.Filterable t, Traversable 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 +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 - -> GenericList n 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 @@ -98,30 +86,47 @@ (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) +-- | 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) --- | toggle selected items highlight status +-- | 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 status -listHighlight :: Traversable t => GenericList n t (e,Highlight) -> GenericList n t (e,Highlight) -listHighlight = listModify (second (const True)) +-- | 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) -saveListToPl :: MPD.MonadMPD m => SongList -> Text -> m () +-- | 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 @@ -129,34 +134,56 @@ 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 +-- | 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 -deleteSelectedPl :: HState -> EventM n HState -deleteSelectedPl st = do - let plName = st ^. playlistsL . plListL & listSelectedElement <&> snd - _ <- liftIO . withMPD $ traverse MPD.rm plName - rebuildPl 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 -duplicatePlaylist :: MPD.PlaylistName -> HState -> EventM n HState +-- | 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) - 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) + newPlName <- liftIO $ unusedPlName pl + _ <- songBulkAddtoPl (MPD.toString newPlName) songs st rebuildPl st -pastePlaylist :: HState -> EventM n HState +-- | Pastes playlist in clipboard to disk (with nonconflicting name). +pastePlaylist :: HumState -> EventM n HumState pastePlaylist st = do let plName = fromMaybe "" (st ^. clipboardL . clPlNameL) duplicatePlaylist plName st -songBulkAddtoQ :: Bool -> V.Vector MPD.Song -> HState -> EventM n HState -songBulkAddtoQ play songs s = do +-- | 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 @@ -168,10 +195,14 @@ (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 } + pure s -songBulkAddtoPl :: String -> V.Vector MPD.Song -> HState -> EventM n HState +-- | 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_ diff --git a/src/Hum/Views/Common.hs b/src/Hum/Views/Common.hs --- a/src/Hum/Views/Common.hs +++ b/src/Hum/Views/Common.hs @@ -1,6 +1,11 @@ -{-# LANGUAGE LambdaCase #-} --- | +-- | Module : Hum.Views.Library +-- Copyright : (c) Itai Y. Efrat 2020-2021 +-- License : GPLv2-or-later (see LICENSE) +-- Maintainer : Itai Y. Efrat +-- +-- Functions for the Help view. + module Hum.Views.Common where import Hum.Types import Brick.Types @@ -11,12 +16,12 @@ import Hum.Attributes import Hum.Utils import qualified Network.MPD as MPD -import qualified Data.Map.Strict as Map import qualified Data.Text as T import Brick.Widgets.List import Control.Lens -drawNowPlaying :: HState -> Widget Name +-- | Draw Now Playing box. +drawNowPlaying :: HumState -> Widget Name drawNowPlaying st = reportExtent NowPlaying $ vLimit 5 . center $ maybe (txt "nothing.") nowPlaying @@ -29,14 +34,14 @@ <=> progbar <=> (padRight Max playing <+> padLeft Max mode) where - title = withAttr queueTitleAttr $ txt $ meta "" MPD.Title song + title = withAttr titleAttr $ txt $ meta "" MPD.Title song album = - withAttr queueAlbumAttr (txt $ meta "" MPD.Album song) + withAttr albumAttr (txt $ meta "" MPD.Album song) <+> txt " (" - <+> withAttr queueDateAttr (txt $ meta "????" MPD.Date song) + <+> withAttr dateAttr (txt $ meta "????" MPD.Date song) <+> txt ")" - artist = withAttr queueArtistAttr $ txt $ meta "" MPD.Artist song - progbar = withAttr queueTimeAttr $ drawProgressBar st + artist = withAttr artistAttr $ txt $ meta "" MPD.Artist song + progbar = withAttr timeAttr $ drawProgressBar st playing = txt $ maybe "[ ]" ((\t -> "[" <> t <> "]") . T.toLower . show . MPD.stState) @@ -58,51 +63,61 @@ mode = txt $ "[" <> repeatmpd <> random <> single <> consume <> crossfade <> "]" -drawProgressBar :: HState -> Widget Name -drawProgressBar st = case width of - 0 -> txt $ Prelude.toText timeText - _ -> bar +-- | Draw progress bar for song time. +drawProgressBar :: HumState -> Widget Name +drawProgressBar st = + Widget Fixed Fixed $ do + ctx <- getContext + let width = ctx ^. windowWidthL + render $ bar width where - width = - maybe 0 (fst . extentSize) (join (Map.lookup NowPlaying $ extentMap st)) songTime = fromMaybe (0, 1) (MPD.stTime =<< status st) timeText = toString . (\(i, j) -> secondsToTime (round i) <> "/" <> secondsToTime (round j)) $ songTime - completed = (\w (i, j) -> round ((i / j) * fromIntegral w)) width songTime - bar = str + completed width = (\w (i, j) -> round ((i / j) * fromIntegral w)) width songTime + bar width = str (zipWith (\a b -> if a `elem` ("1234567890/:" :: String) then a else b) (replicate (-5 + div width 2) ' ' ++ timeText ++ replicate (-3 + div width 2) ' ' ) - (replicate completed '=' ++ replicate (width - completed) ' ') + (replicate (completed width) '=' ++ replicate (width - (completed width)) ' ') ) ---drawEx :: HState -> Widget Name ---drawEx st = +-- | Either a number or a percent. To be used for widget horizontal size. +data PerCol = + Per Int -- ^ percent size + | Col Int -- ^ column number size -data PerCol = Per Int | Col Int -column :: Maybe PerCol -> Padding -> Padding -> Widget n -> Widget n +-- | Helper function for drawing column rows. +column + :: Maybe PerCol -- ^ Maximum width, greedy if Nothing. + -> Padding -- ^ Left padding + -> Padding -- ^ Right padding + -> Widget n + -> Widget n column maxWidth left right w = case maxWidth of Nothing -> wpad Just (Per m) -> hLimitPercent m wpad Just (Col m) -> hLimit m wpad where wpad = padLeft left . padRight right $ w +-- | Returns True if text is substring of one of the given tags of the given song. songSearch :: Text -> [MPD.Metadata] -> MPD.Song -> Bool songSearch text metadata song = let mtags = (T.toLower <$>) . (`mmeta` song) <$> metadata in or $ fromMaybe False <$> (T.isInfixOf (T.toLower text) <<$>> mtags) - +-- | Returns True if text is substring of the given strings. stringySearch :: MPD.ToString a => Text -> a -> Bool stringySearch text value = T.isInfixOf (T.toLower text) (T.toLower . MPD.toText $ value) -drawPrompt :: HState -> Widget Name +-- | Draws a prompt. +drawPrompt :: HumState -> Widget Name drawPrompt st = case st ^. promptsL . currentPromptL of PlSelectPrompt -> centerLayer @@ -111,7 +126,7 @@ . center $ (hCenter . txt $ st ^. promptsL . promptTitleL) <=> hBorder - <=> renderListWithIndex choosePlRow + <=> renderListWithIndex drawPlSelectRow True (st ^. promptsL . plSelectPromptL) TextPrompt -> @@ -130,8 +145,8 @@ $ (hCenter . txt $ st ^. promptsL . promptTitleL) <=> (hCenter . txt $ "[y/n]") - -choosePlRow :: Int -> Bool -> Maybe MPD.PlaylistName -> Widget n -choosePlRow i _ pl = if i==0 then +-- | Draw row in playlist select prompt. +drawPlSelectRow :: Int -> Bool -> Maybe MPD.PlaylistName -> Widget n +drawPlSelectRow i _ pl = if i==0 then str "New Playlist" <=> modifyDefAttr (const wobAttr) hBorder else str (MPD.toString $ fromMaybe "" pl) diff --git a/src/Hum/Views/Help.hs b/src/Hum/Views/Help.hs --- a/src/Hum/Views/Help.hs +++ b/src/Hum/Views/Help.hs @@ -1,6 +1,12 @@ -{-#LANGUAGE RankNTypes#-} --- | +-- | Module : Hum.Views.Help +-- Copyright : (c) Itai Y. Efrat 2020-2021 +-- License : GPLv2-or-later (see LICENSE) +-- Maintainer : Itai Y. Efrat +-- +-- Shared functions for views. + + module Hum.Views.Help where import Prelude hiding ( Down ) import Hum.Types @@ -8,22 +14,44 @@ import Graphics.Vty.Input.Events import Brick.Main import Brick.Widgets.Core -import Brick.Widgets.Center +import Brick.Widgets.Search import Control.Lens +import Text.Regex.TDFA.Text +import Text.Regex.TDFA +-- | Draws help. +drawViewHelp :: HumState -> Widget Name +drawViewHelp st = viewport Help Vertical (helpW st) -drawViewHelp :: HState -> Widget Name -drawViewHelp st = center ((hCenter . txt $ "j/k cycle between help screens.") <=> txt (helpText st)) +-- | Help widget. Parses the last search as a case insensitive POSIX regex. +helpW :: HumState -> Widget Name +helpW st = + let htx = st ^. helpL . helpTextL + hi = st ^. helpL . helpSearchIntL + mterm = viaNonEmpty head (st ^. exL . searchHistoryL) + mterm' = if mterm == Just "" then Nothing else mterm + eterm = maybe (Left "empty") (compile defaultCompOpt{caseSensitive = False} defaultExecOpt) mterm' + in either (\_ -> txt htx) (\term -> regexW hi term htx) eterm -helpText :: HState -> Text -helpText st = unlines $ case st^.helpScreenL of - 0 -> [ +-- | Help widget. Parses the last search as an exact match. +helpW' :: HumState -> Widget Name +helpW' st = + let htx = st ^. helpL . helpTextL + hi = st ^. helpL . helpSearchIntL + mterm = viaNonEmpty head (st ^. exL . searchHistoryL) + mterm' = if mterm == Just "" then Nothing else mterm + in maybe (txt htx) (\term -> searchW hi term htx) mterm' + +-- | Helper function that keeps "Hum.UI" tidy. +helpText' :: Text +helpText' = unlines + [ "Change views:" , " 1 - queue" , " 2 - library" , " 3 - playlists" , "" - , "General Bindings:" + , "General bindings:" , " t - play/pause toggle" , " , - previous song" , " . - next song" @@ -38,9 +66,9 @@ , " c - toggle consume mode in mpd" , " x - toggle crossfade mode in mpd" , " r - toggle repeat mode in mpd" - , " z - toggle random mode in mpd"] - 1 -> [ - "Queue keybindings:" + , " z - toggle random mode in mpd" + , "" + , "Queue keybindings:" , " SPC - select song" , " y and d - yank and delete the selected songs" , " p - paste selected song" @@ -49,31 +77,43 @@ , "Library and Playlists keybindigns:" , " SPC - add song/song collection to queue" , " RET - add song/song collection to queue, and start playing the first one" + , " ` - toggle sort of the album column between release order and alphabetical order" , "" , "Playlists keybindigns:" - , " on playlist conents:" + , " On playlist contents:" , " e - make playlist editable, press again to get save prompt." , " editing a playlist is the same as editing the queue" - , " on list of playlists:" + , "" + , " On list of playlists:" + , " e - rename playlist" , " y and p - copy and paste playlists (with -copy added to the name)" , " d - delete playlist (with prompt)" , "" - , "Commands:" + , "commands:" , ":help - gets you this" , ":q - quits" , ":save $name - saves the queue to a playlist called $name" ] - _ -> ["something went wrong."] +-- | Updates which mathc is focused in the help buffer. +helpSearch + :: Bool -- ^ Search direction, True for forward. + -> HumState + -> EventM Name HumState +helpSearch dir st = + pure $ if dir + then st & helpL . helpSearchIntL %~ (\x->x+1) + else st & helpL . helpSearchIntL %~ (\x->x-1) +-- | handle key events in help view. handleEventHelp - :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState) + :: HumState -> BrickEvent Name HumEvent -> EventM Name (Next HumState) handleEventHelp s e = case e of VtyEvent vtye -> case vtye of - EvKey (KChar 'j') [] -> continue $ s & helpScreenL %~ (\x -> if x==1 then 0 else x+1) - EvKey (KChar 'k') [] -> continue $ s & helpScreenL %~ (\x -> if x==0 then 1 else x-1) - EvKey (KChar 'n') [] -> continue s - EvKey (KChar 'N') [] -> continue s + EvKey (KChar 'j') [] -> vScrollBy (viewportScroll Help) 1 >> continue s + EvKey (KChar 'k') [] -> vScrollBy (viewportScroll Help) (-1) >> continue s + EvKey (KChar 'n') [] -> continue =<< helpSearch (s ^. exL . searchDirectionL) s + EvKey (KChar 'N') [] -> continue =<< helpSearch (s ^. exL . searchDirectionL & not) s EvKey (KChar 'G') [] -> continue s EvKey (KChar 'g') [] -> continue s _ -> continue s diff --git a/src/Hum/Views/Library.hs b/src/Hum/Views/Library.hs --- a/src/Hum/Views/Library.hs +++ b/src/Hum/Views/Library.hs @@ -1,8 +1,12 @@ -{-#LANGUAGE RankNTypes#-} --- | +-- | Module : Hum.Views.Library +-- Copyright : (c) Itai Y. Efrat 2020-2021 +-- License : GPLv2-or-later (see LICENSE) +-- Maintainer : Itai Y. Efrat +-- +-- Functions for the Library view. + module Hum.Views.Library where -import Prelude hiding ( Down ) import Hum.Types import Brick.Types import Graphics.Vty.Input.Events @@ -16,21 +20,18 @@ import Hum.Views.Common import Hum.Rebuild import qualified Data.Text as T -import Network.MPD ( withMPD ) +import qualified Data.Vector as V import qualified Network.MPD as MPD -import qualified Data.Map.Strict as Map import Hum.Utils - - -drawLibraryLeft :: HState -> Widget Name -drawLibraryLeft st = - let vsize = case join $ Map.lookup LibraryLeft $ extentMap st of - Just e -> snd . extentSize $ e - Nothing -> 20 - in reportExtent LibraryLeft $ hCenter - ( viewport LibraryLeft Vertical - . visible +-- | Draw left column in Library view. +drawLibraryLeft :: HumState -> Widget Name +drawLibraryLeft st = reportExtent LibraryLeft $ + Widget Greedy Greedy $ do + ctx <- getContext + let vsize = ctx ^. windowHeightL - 6 -- HACK Don't hardcode nowplaying size? + render $ hCenter + ( visible . vLimit vsize . center $ hBorder @@ -40,33 +41,33 @@ (MPD.toText <$> st ^. libraryL . artistsL) ) ) -drawLibraryMid :: HState -> Widget Name -drawLibraryMid st = - let vsize = case join $ Map.lookup LibraryMid $ extentMap st of - Just e -> snd . extentSize $ e - Nothing -> 20 - in reportExtent LibraryMid $ hCenter - ( viewport LibraryMid Vertical - . visible + +-- | Draw middle column in Library view. +drawLibraryMid :: HumState -> Widget Name +drawLibraryMid st = reportExtent LibraryMid $ + Widget Greedy Greedy $ do + ctx <- getContext + let vsize = ctx ^. windowHeightL - 6 -- HACK Don't hardcode nowplaying size? + render $ hCenter + ( visible . vLimit vsize . center $ hBorder <=> hCenter - (renderList (const $ libraryRow st LibraryMid) + (renderList (const $ libraryAlbumRow) ((focLib . focus $ st) == FocAlbums) - (MPD.toText <$> st ^. libraryL . albumsL) + (st ^. libraryL . yalbumsL) ) ) - -drawLibraryRight :: HState -> Widget Name -drawLibraryRight st = - let vsize = case join $ Map.lookup LibraryRight $ extentMap st of - Just e -> snd . extentSize $ e - Nothing -> 20 - in reportExtent LibraryRight $ hCenter - ( viewport LibraryRight Vertical - . visible +-- | Draw right column in Library view. +drawLibraryRight :: HumState -> Widget Name +drawLibraryRight st = reportExtent LibraryRight $ + Widget Greedy Greedy $ do + ctx <- getContext + let vsize = ctx ^. windowHeightL - 6 -- HACK Don't hardcode nowplaying size? + render $ hCenter + ( visible . vLimit vsize . center $ hBorder @@ -77,87 +78,101 @@ ) ) - -libraryRow :: HState -> Name -> T.Text -> Widget n +-- | Draw generic column row in Library view. +libraryRow :: HumState -> Name -> T.Text -> Widget n -- TODO refactor? libraryRow _ name val = withAttr (case name of - LibraryLeft -> queueArtistAttr - LibraryMid -> queueAlbumAttr + LibraryLeft -> artistAttr + LibraryMid -> albumAttr _ -> listAttr ) $ column Nothing (Pad 1) Max $ txt val -librarySongRow :: HState -> MPD.Song -> Widget n +-- | Draw row in album column in Library view. +libraryAlbumRow :: (MPD.Value,MPD.Value) -> Widget n +libraryAlbumRow (yr,al) = + let year = MPD.toText yr + album = MPD.toText al + yearW = withAttr dateAttr $ column (Just (Col 7)) Max Max $ + if T.null year + then txt " " + else txt "(" <+> txt (T.take 4 year) <+> txt ")" + albumW = withAttr albumAttr $ column Nothing Max Max $ txt album + in yearW <+> albumW + +-- | Draw row in song column in Library view. +librarySongRow :: HumState -> MPD.Song -> Widget n librarySongRow st song = let pathsInQueue = (MPD.sgFilePath <$>) . (fst <$>) . listElements . queue $ st - in withAttr - (if MPD.sgFilePath song `elem` pathsInQueue - then queueTitleBoldAttr - else queueTitleAttr + title = meta (MPD.toText . MPD.sgFilePath $ song) MPD.Title song + titleW = withAttr titleAttr $ column Nothing Max Max $ txt title + track = meta "-" MPD.Track song + trackW = withAttr trackAttr $ column (Just (Col 3)) Max (Pad 1) $ txt track + in (if MPD.sgFilePath song `elem` pathsInQueue + then withAttr titleBoldAttr + else id ) - $ column Nothing (Pad 1) Max - $ txt (meta (MPD.toText . MPD.sgFilePath $ song) MPD.Title song) + $ trackW <+> titleW +-- | Move focus right in Library view. libraryMoveRight :: FocLib -> FocLib libraryMoveRight FocArtists = FocAlbums libraryMoveRight _ = FocSongs +-- | Move focus left in Library view. libraryMoveLeft :: FocLib -> FocLib libraryMoveLeft FocSongs = FocAlbums libraryMoveLeft _ = FocArtists -drawViewLibrary :: HState -> Widget Name +-- | Draw Library view. +drawViewLibrary :: HumState -> Widget Name drawViewLibrary st = drawLibraryLeft st <+> drawLibraryMid st <+> drawLibraryRight st +-- | Move focused library column by given function libraryMove - :: (forall e . List Name e -> List Name e) -> HState -> EventM Name HState + :: (forall e . List Name e -> List Name e) -- ^ Function to move the focused column with + -> HumState + -> EventM Name HumState libraryMove moveFunc s = let libfoc = s ^. focusL . focLibL in case libfoc of FocArtists -> rebuildLibArtists $ s & libraryL . artistsL %~ moveFunc - FocAlbums -> rebuildLibAlbums $ s & libraryL . albumsL %~ moveFunc + FocAlbums -> rebuildLibAlbums $ s & libraryL . yalbumsL %~ moveFunc FocSongs -> do pure $ s & libraryL . songsL %~ moveFunc - -libraryAddtoQ :: Bool -> HState -> EventM Name HState +-- | Add selected element in Library view to queue. +-- If the element is an album or artist add all songs under it. +libraryAddtoQ + :: Bool -- ^ Play first item added to queue + -> HumState + -> EventM Name HumState libraryAddtoQ play s = let libfoc = s ^. focusL . focLibL in case libfoc of FocArtists -> do - songs <- - liftIO - (songsOfArtist - (snd <$> listSelectedElement (s ^. libraryL . artistsL)) - ) + let martist = snd <$> listSelectedElement (s ^. libraryL . artistsL) + songs <-liftIO $ maybe (pure empty) songsOfArtist martist songBulkAddtoQ play songs s FocAlbums -> do - songs <- - liftIO - (songsOfAlbum - (snd <$> listSelectedElement (s ^. libraryL . albumsL)) - ) + let malbum = snd . snd <$> listSelectedElement (s ^. libraryL . yalbumsL) + songs <- liftIO $ maybe (pure empty) songsOfAlbum malbum songBulkAddtoQ play songs s FocSongs -> do - let maybeFilePath = MPD.sgFilePath . snd <$> listSelectedElement + let songs = maybe V.empty V.singleton $ snd <$> listSelectedElement (s ^. libraryL . songsL) - traverse_ - (\sel -> liftIO - (withMPD $ MPD.addId sel Nothing >>= if play - then MPD.playId - else const pass - ) - ) - maybeFilePath - song <- liftIO (withMPD MPD.currentSong) - pure s { currentSong = fromRight Nothing song, queue = queue s } + songBulkAddtoQ play songs s -librarySearch :: Bool -> HState -> EventM Name HState +-- | Search focused library column for next instance of last search. +librarySearch + :: Bool -- ^ Search direction, True for forward. + -> HumState + -> EventM Name HumState librarySearch direction s = let libfoc = s ^. focusL . focLibL dir = if direction then id else listReverse @@ -166,30 +181,27 @@ then pure s else case libfoc of FocArtists -> do - extentMap <- updateExtentMap rebuildLibArtists - $ (s { extentMap }) + $ s & libraryL . artistsL %~ (dir . listFindBy (stringySearch searchkey) . dir) FocAlbums -> do - extentMap <- updateExtentMap rebuildLibAlbums - $ (s { extentMap }) + $ s & libraryL - . albumsL - %~ (dir . listFindBy (stringySearch searchkey) . dir) + . yalbumsL + %~ (dir . listFindBy (stringySearch searchkey . snd) . dir) FocSongs -> do - extentMap <- updateExtentMap pure - $ s { extentMap } + $ s & libraryL . songsL %~ (dir . listFindBy (songSearch searchkey [MPD.Title]) . dir) - +-- | handle key inputs for Library view. handleEventLibrary - :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState) + :: HumState -> BrickEvent Name HumEvent -> EventM Name (Next HumState) handleEventLibrary s e = case e of VtyEvent vtye -> case vtye of EvKey (KChar 'j') [] -> continue =<< libraryMove listMoveDown s @@ -204,11 +216,8 @@ continue =<< libraryMove listMoveDown =<< libraryAddtoQ True s EvKey (KChar ' ') [] -> continue =<< libraryMove listMoveDown =<< libraryAddtoQ False s - EvKey (KChar 'G') [] -> - continue =<< libraryMove (\ls -> listMoveBy (length ls) ls) s + EvKey (KChar 'G') [] -> continue =<< libraryMove (listMoveTo (-1)) s EvKey (KChar 'g') [] -> continue =<< libraryMove (listMoveTo 0) s -- TODO change this to 'gg', somehow + EvKey (KChar '`') [] -> continue =<< rebuildLibArtists (s & libraryL . yalbumSortL %~ not) _ -> continue s _ -> continue s - -addToPl :: EventM Name HState -addToPl = error "not implemented" diff --git a/src/Hum/Views/Playlists.hs b/src/Hum/Views/Playlists.hs --- a/src/Hum/Views/Playlists.hs +++ b/src/Hum/Views/Playlists.hs @@ -1,10 +1,16 @@ -{-#LANGUAGE RankNTypes#-} --- | +-- | Module : Hum.Views.Library +-- Copyright : (c) Itai Y. Efrat 2020-2021 +-- License : GPLv2-or-later (see LICENSE) +-- Maintainer : Itai Y. Efrat +-- +-- Functions for the Playlist view. + module Hum.Views.Playlists where import Hum.Types import Brick.Types +import Brick.Widgets.Edit hiding ( decodeUtf8 ) import Graphics.Vty.Input.Events import Brick.Main import Brick.Widgets.Core @@ -17,21 +23,19 @@ import Hum.Views.Common import Hum.Rebuild import qualified Data.Text as T +import qualified Data.Text.Zipper as Z import Network.MPD ( withMPD ) import qualified Network.MPD as MPD -import qualified Data.Map.Strict as Map import Hum.Utils - - -drawPlaylistLeft :: HState -> Widget Name -drawPlaylistLeft st = - let vsize = case join $ Map.lookup PlaylistLeft $ extentMap st of - Just e -> snd . extentSize $ e - Nothing -> 20 - in reportExtent PlaylistLeft $ hCenter - ( viewport PlaylistLeft Vertical - . visible +-- | Draw left column in Playlist view. +drawPlaylistLeft :: HumState -> Widget Name +drawPlaylistLeft st = reportExtent PlaylistLeft $ + Widget Greedy Greedy $ do + ctx <- getContext + let vsize = ctx ^. windowHeightL - 6 -- HACK Don't hardcode nowplaying size? + render $ hCenter + ( visible . vLimit vsize . center $ hBorder @@ -41,14 +45,15 @@ (MPD.toText <$> st ^. playlistsL . plListL) ) ) -drawPlaylistRight :: HState -> Widget Name -drawPlaylistRight st = - let vsize = case join $ Map.lookup PlaylistRight $ extentMap st of - Just e -> snd . extentSize $ e - Nothing -> 20 - in reportExtent PlaylistRight $ hCenter - ( viewport PlaylistRight Vertical - . visible + +-- | Draw right column in Playlist view. +drawPlaylistRight :: HumState -> Widget Name +drawPlaylistRight st = reportExtent PlaylistRight $ + Widget Greedy Greedy $ do + ctx <- getContext + let vsize = ctx ^. windowHeightL - 6 -- HACK Don't hardcode nowplaying size? + render $ hCenter + ( visible . vLimit vsize . center $ (if st ^. editableL @@ -66,33 +71,34 @@ ) ) -playlistRow :: HState -> T.Text -> Widget n +-- | Draw row in playlist column in Playlist view. +playlistRow :: HumState -> T.Text -> Widget n -- TODO rename? playlistRow _ val = - withAttr queueAlbumAttr $ column Nothing (Pad 1) Max $ txt val + withAttr albumAttr $ column Nothing (Pad 1) Max $ txt val -playlistSongRow :: HState -> (MPD.Song,Highlight) -> Widget n +-- | Draw row in song column in Playlist view. +playlistSongRow :: HumState -> (MPD.Song,Highlight) -> Widget n playlistSongRow st (song,hl) = let pathsInQueue = (MPD.sgFilePath <$>) . (fst <$>) . listElements . queue $ st - in (if hl then highlightOverQueueAttrs else id) . withAttr + in (if hl then highlightOverAttrs else id) . withAttr (if MPD.sgFilePath song `elem` pathsInQueue - then queueTitleBoldAttr - else queueTitleAttr + then titleBoldAttr + else titleAttr ) $ column Nothing (Pad 1) Max $ txt (meta (MPD.toText . MPD.sgFilePath $ song) MPD.Title song) - - - - - -drawViewPlaylists :: HState -> Widget Name +-- | Draw Playlist view. +drawViewPlaylists :: HumState -> Widget Name drawViewPlaylists st = hLimitPercent 25 (drawPlaylistLeft st) <+> drawPlaylistRight st +-- | Move focused playlist column by given function playlistsMove - :: (forall e . List Name e -> List Name e) -> HState -> EventM Name HState + :: (forall e . List Name e -> List Name e) -- ^ Function to move the focused column with + -> HumState + -> EventM Name HumState playlistsMove moveFunc s = let playfoc = s ^. focusL . focPlayL in case playfoc of @@ -100,7 +106,12 @@ FocPSongs -> do pure $ s & playlistsL . plSongsL %~ moveFunc -playlistsAddtoQ :: Bool -> HState -> EventM Name HState +-- | Add selected element in Playlist view to queue. +-- If the element is a playlist adds entire playlist. +playlistsAddtoQ + :: Bool -- ^ Play first item added to queue + -> HumState + -> EventM Name HumState playlistsAddtoQ play s = let playfoc = s ^. focusL . focPlayL in case playfoc of @@ -120,7 +131,11 @@ song <- liftIO (withMPD MPD.currentSong) pure s { currentSong = fromRight Nothing song, queue = queue s } -playlistsSearch :: Bool -> HState -> EventM Name HState +-- | Search focused playlist column for next instance of last search. +playlistsSearch + :: Bool -- ^ Search direction, True for forward. + -> HumState + -> EventM Name HumState playlistsSearch direction s = let playfoc = s ^. focusL . focPlayL dir = if direction then id else listReverse @@ -129,23 +144,33 @@ then pure s else case playfoc of FocPlaylists -> do - extentMap <- updateExtentMap rebuildPlList - $ (s { extentMap }) + $ s & playlistsL . plListL %~ (dir . listFindBy (stringySearch searchkey) . dir) FocPSongs -> do - extentMap <- updateExtentMap pure - $ s { extentMap } + $ s & playlistsL . plSongsL %~ (dir . listFindBy (songSearch searchkey [MPD.Title] . fst) . dir) +-- | Rename the given playlist with input from the text prompt. +renamePl + :: T.Text -> Bool -> HumState -> EventM n HumState +renamePl oldname bl st = if bl + then + let newname = fromString (toString $ st ^. promptsL . textPromptL . editContentsL & Z.currentLine) + oldname' = fromString . T.unpack $ oldname + in do + _ <- liftIO . withMPD $MPD.rename oldname' newname + rebuildPl st + else pure st +-- | handle key inputs for Playlist view. handleEventPlaylists - :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState) + :: HumState -> BrickEvent Name HumEvent -> EventM Name (Next HumState) handleEventPlaylists s e = case e of VtyEvent vtye -> case vtye of EvKey (KChar 'j') [] -> continue =<< playlistsMove listMoveDown s @@ -169,7 +194,7 @@ -> continue $ s & modeL .~ PromptMode & promptsL . currentPromptL .~ YNPrompt & promptsL . promptTitleL .~ ("DELETE " <> selectedPl <> "?\nYou can't paste it back yet") - & promptsL . exitPromptL .~ deleteSelectedPl + & promptsL . exitPromptFuncL .~ deleteSelectedPl | otherwise -> continue s EvKey (KChar 'y') [] | s ^. editableL @@ -183,16 +208,21 @@ | s ^. focusL . focPlayL == FocPlaylists -> continue =<< pastePlaylist s | otherwise -> continue s - EvKey (KChar 'G') [] -> - continue =<< playlistsMove (\ls -> listMoveBy (length ls) ls) s + EvKey (KChar 'G') [] -> continue =<< playlistsMove (listMoveTo (-1)) s EvKey (KChar 'g') [] -> continue =<< playlistsMove (listMoveTo 0) s -- TODO change this to 'gg', somehow - EvKey (KChar 'e') [] -> if s ^. editableL then - continue $ s & editableL %~ not - & modeL .~ PromptMode - & promptsL . currentPromptL .~ YNPrompt - & promptsL . promptTitleL .~ ("Save changes to " <> selectedPl <> "?") - & promptsL . exitPromptL .~ saveEditedPl - else continue =<< rebuildPlList (s & editableL %~ not) + EvKey (KChar 'e') [] -> case s ^. focusL . focPlayL of + FocPlaylists + -> continue $ s & modeL .~ PromptMode + & promptsL . currentPromptL .~ TextPrompt + & promptsL . promptTitleL .~ ("Rename " <> selectedPl <> " to:") + & promptsL . exitPromptFuncL .~ renamePl selectedPl + FocPSongs -> if s ^. editableL then + continue $ s & editableL %~ not + & modeL .~ PromptMode + & promptsL . currentPromptL .~ YNPrompt + & promptsL . promptTitleL .~ ("Save changes to " <> selectedPl <> "?") + & promptsL . exitPromptFuncL .~ saveEditedPl + else continue =<< reloadPlList (s & editableL %~ not) _ -> continue s _ -> continue s where selectedPl = s ^. playlistsL . plListL & listSelectedElement ? maybe "" snd ? MPD.toText diff --git a/src/Hum/Views/Queue.hs b/src/Hum/Views/Queue.hs --- a/src/Hum/Views/Queue.hs +++ b/src/Hum/Views/Queue.hs @@ -1,5 +1,12 @@ --- | +-- | Module : Hum.Views.Queue +-- Copyright : (c) Itai Y. Efrat 2020-2021 +-- License : GPLv2-or-later (see LICENSE) +-- Maintainer : Itai Y. Efrat +-- +-- Functions for the Queue view. + + module Hum.Views.Queue where import Hum.Types import Brick.Main @@ -14,18 +21,16 @@ import Hum.Views.Common import Network.MPD ( withMPD ) import qualified Network.MPD as MPD -import qualified Data.Map.Strict as Map import Control.Lens -drawViewQueue :: HState -> Widget Name -drawViewQueue st = - let vsize = case join $ Map.lookup Queue $ extentMap st of - Just e -> snd . extentSize $ e - Nothing -> 60 - in reportExtent Queue $ hCenter - ( viewport Queue Vertical --- . visible - . vLimit vsize +-- | Draw the queue. +drawViewQueue :: HumState -> Widget Name +drawViewQueue st = reportExtent Queue $ + Widget Greedy Greedy $ do + ctx <- getContext + let vsize = ctx ^. windowHeightL - 6 -- HACK Don't hardcode nowplaying size? + render $ hCenter + ( vLimit vsize . center $ hCenter header <=> hCenter @@ -39,20 +44,21 @@ {-songIdx = column (Just (Col 4)) Max (Pad 1) $ txt "Inx" songId = column (Just (Col 3)) Max (Pad 1) $ txt "ID"-} album = - withAttr queueAlbumAttr $ column (Just (Per 25)) (Pad 1) Max $ txt "Album" - track = withAttr queueTrackAttr $ column (Just (Col 3)) Max (Pad 1) $ txt "#" - title = withAttr queueTitleAttr $ column Nothing Max Max $ txt "Title" + withAttr albumAttr $ column (Just (Per 25)) (Pad 1) Max $ txt "Album" + track = withAttr trackAttr $ column (Just (Col 3)) Max (Pad 1) $ txt "#" + title = withAttr titleAttr $ column Nothing Max Max $ txt "Title" artist = - withAttr queueArtistAttr $ column (Just (Per 25)) Max (Pad 1) $ txt "Artist" + withAttr artistAttr $ column (Just (Per 25)) Max (Pad 1) $ txt "Artist" time = - withAttr queueTimeAttr $ column (Just (Col 5)) Max (Pad 1) $ txt "Time" + withAttr timeAttr $ column (Just (Col 5)) Max (Pad 1) $ txt "Time" header = withDefAttr headerAttr ({-songIdx <+> songId <+>-} album <+> track <+> title <+> artist <+> time) -queueRow :: HState -> (MPD.Song, Highlight) -> Widget n +-- | Draw individual row in queue. +queueRow :: HumState -> (MPD.Song, Highlight) -> Widget n queueRow st (song, hl) = - (if hl then highlightOverQueueAttrs else id) + (if hl then highlightOverAttrs else id) . (if Just (MPD.sgIndex song) == (MPD.sgIndex <$> nowPlaying) then withDefAttr queueNowPlayingAttr else id @@ -71,45 +77,36 @@ $ maybe "?" (\(MPD.Id x) -> show x) $ MPD.sgId song-} album = - withAttr queueAlbumAttr $ column (Just (Per 25)) (Pad 1) Max $ txt $ meta + withAttr albumAttr $ column (Just (Per 25)) (Pad 1) Max $ txt $ meta "" MPD.Album song track = - withAttr queueTrackAttr $ column (Just (Col 3)) Max (Pad 1) $ txt $ meta + withAttr trackAttr $ column (Just (Col 3)) Max (Pad 1) $ txt $ meta "?" MPD.Track song - title = withAttr queueTitleAttr $ column Nothing Max Max $ txt $ meta + title = withAttr titleAttr $ column Nothing Max Max $ txt $ meta "" MPD.Title song artist = - withAttr queueArtistAttr $ column (Just (Per 25)) Max (Pad 1) $ txt $ meta + withAttr artistAttr $ column (Just (Per 25)) Max (Pad 1) $ txt $ meta "" MPD.Artist song time = - withAttr queueTimeAttr + withAttr timeAttr $ column (Just (Col 5)) Max (Pad 1) $ txt $ secondsToTime $ MPD.sgLength song -pasteDeleteCleanup :: HState -> SongList -> EventM Name HState -pasteDeleteCleanup s clSongs' = do - let mi = listSelected (queue s) - extentMap <- updateExtentMap - currentSong <- liftIO (fromRight Nothing <$> withMPD MPD.currentSong) - status <- liftIO (fromRight Nothing <$> (Just <<$>> withMPD MPD.status)) - s' <- rebuildQueue s - pure (s' & queueL %~ maybe id listMoveTo mi - & clipboardL . clSongsL .~ clSongs') { currentSong - , status - , extentMap - } - -queueSearch :: Bool -> HState -> EventM Name HState +-- | Search queue for next instance of last search. +queueSearch + :: Bool -- ^ Search direction, True for forward. + -> HumState + -> EventM Name HumState queueSearch direction s = let dir = if direction then id else listReverse @@ -118,9 +115,8 @@ if searchkey == "" then pure s else do - extentMap <- updateExtentMap pure - $ s { extentMap } + $ s & queueL %~ ( dir . listFindBy @@ -130,7 +126,11 @@ . dir ) -queueAddToPl :: HState -> String -> EventM Name HState +-- | Add highlighted songs to given playlist. +queueAddToPl + :: HumState + -> String -- ^ Playlist name + -> EventM Name HumState queueAddToPl s plName = let songs = (s ^. queueL) @@ -139,50 +139,42 @@ <&> fst in songBulkAddtoPl plName songs s - - +-- | handle key inputs for Queue view. handleEventQueue - :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState) + :: HumState -> BrickEvent Name HumEvent -> EventM Name (Next HumState) handleEventQueue s e = case e of VtyEvent vtye -> case vtye of - EvKey (KChar 'j') [] -> do - extentMap <- updateExtentMap - continue s { queue = listMoveDown $ queue s, extentMap } - EvKey (KChar 'k') [] -> do - extentMap <- updateExtentMap - continue s { queue = listMoveUp $ queue s, extentMap } + EvKey (KChar 'j') [] -> continue $ s & queueL %~ listMoveDown + EvKey (KChar 'k') [] -> continue $ s & queueL %~ listMoveUp EvKey (KChar 'n') [] -> continue =<< queueSearch (s ^. exL . searchDirectionL) s EvKey (KChar 'N') [] -> continue =<< queueSearch (s ^. exL . searchDirectionL & not) s - EvKey (KChar 'a') [] -> continue $ s & modeL .~ PromptMode - & promptsL . currentPromptL .~ PlSelectPrompt - & promptsL . promptTitleL .~ "Add selected Item(s) to:" + EvKey (KChar 'a') [] -> + continue $ s & modeL .~ PromptMode + & promptsL . plSelectPromptL .~ listInsert 0 Nothing (Just <$> (s ^. playlistsL . plListL)) + & promptsL . currentPromptL .~ PlSelectPrompt + & promptsL . promptTitleL .~ "Add selected Item(s) to:" EvKey KEnter [] -> do let maybeSelectedId = MPD.sgId . fst . snd =<< listSelectedElement (queue s) traverse_ (\sel -> liftIO (withMPD $ MPD.playId sel)) maybeSelectedId - song <- liftIO (withMPD MPD.currentSong) - continue s { currentSong = fromRight Nothing song, queue = queue s } + rebuildStatus s >>= continue EvKey (KChar ' ') [] -> continue $ s & queueL %~ (listMoveDown . listToggleHighlight) EvKey (KChar 'd') [] -> do - let clSongs' = getHighlighted (queue s) - _ <- liftIO (withMPD $ deleteHighlightedfromQ (queue s)) - continue =<< pasteDeleteCleanup s clSongs' + let clSongs' = s ^. queueL & getHighlighted + _ <- liftIO (withMPD $ deleteHighlightedfromQ (s ^. queueL)) + let s' = s & clipboardL . clSongsL .~ clSongs' + rebuildQueue s' >>= rebuildStatus >>= continue EvKey (KChar 'D') [] -> do - let clip = queue s - _ <- liftIO (withMPD $ deleteAll (queue s)) - continue =<< pasteDeleteCleanup s clip - EvKey (KChar 'y') [] -> continue $ s & clipboardL . clSongsL .~ (s ^. queueL & getHighlighted) + let clSongs' = s^. queueL + let s' = s & clipboardL . clSongsL .~ clSongs' + _ <- liftIO (withMPD MPD.clear) + rebuildQueue s' >>= rebuildStatus >>= continue + EvKey (KChar 'y') [] -> continue $ yankHighlighted s queueL EvKey (KChar 'p') [] -> do - let clip = s ^. clipboardL . clSongsL - _ <- liftIO (withMPD $ pasteSongstoQ clip (queue s)) - continue =<< pasteDeleteCleanup s clip - EvKey (KChar 'G') [] -> do - extentMap <- updateExtentMap - continue s { queue = listMoveTo (length . queue $ s) $ queue s - , extentMap - } - EvKey (KChar 'g') [] -> do -- TODO change this to 'gg', somehow - extentMap <- updateExtentMap - continue s { queue = listMoveTo 0 $ queue s, extentMap } + let clSongs' = s ^. clipboardL . clSongsL + _ <- liftIO (withMPD $ pasteSongstoQ clSongs' (s ^. queueL)) + rebuildQueue s >>= rebuildStatus >>= continue + EvKey (KChar 'G') [] -> continue $ s & queueL %~ listMoveTo (-1) + EvKey (KChar 'g') [] -> continue $ s & queueL %~ listMoveTo 0 -- TODO change this to 'gg', somehow _ -> continue s _ -> continue s