hum 0.1.0.0 → 0.2.0.0

raw patch · 22 files changed

+991/−1216 lines, 22 filesdep +arraydep +regex-tdfadep +witherabledep −witherable-classdep ~brickdep ~bytestringdep ~libmpdPVP ok

version bump matches the API change (PVP)

Dependencies added: array, regex-tdfa, witherable

Dependencies removed: witherable-class

Dependency ranges changed: brick, bytestring, libmpd, time, vty

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• README.md +1/−1
• app/Main.hs +4/−1
• default.nix +29/−0
• hum.cabal +15/−10
• release.nix +4/−0
• src/Brick/Widgets/List.hs +0/−648
• src/Brick/Widgets/Search.hs +83/−0
• src/Hum/Attributes.hs +40/−30
• src/Hum/BChan.hs +0/−6
• src/Hum/Modes/ExMode.hs +29/−12
• src/Hum/Modes/PromptMode.hs +51/−25
• src/Hum/Orphans.hs +19/−0
• src/Hum/Rebuild.hs +119/−35
• src/Hum/Types.hs +74/−46
• src/Hum/UI.hs +65/−75
• src/Hum/Utils.hs +99/−68
• src/Hum/Views/Common.hs +43/−28
• src/Hum/Views/Help.hs +61/−21
• src/Hum/Views/Library.hs +96/−87
• src/Hum/Views/Playlists.hs +81/−51
• src/Hum/Views/Queue.hs +64/−72

@@ -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.

@@ -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

@@ -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)

@@ -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;+}

@@ -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.

@@ -0,0 +1,4 @@+ let+  pkgs = import <nixpkgs> { };+ in+  pkgs.haskellPackages.callPackage ./default.nix { }

@@ -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

@@ -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

@@ -1,5 +1,11 @@--- | +-- | Module    : Hum.Attributes+-- Copyright   : (c) Itai Y. Efrat 2020-2021+-- License     : GPLv2-or-later (see LICENSE)+-- Maintainer  : Itai Y. Efrat <itai3397@gmail.com>+--+-- 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         ]     )   )

@@ -1,6 +0,0 @@--- |-module Hum.BChan where---import           Network.MPD---import           Hum.Types---- put stuff dealing with Types here later

@@ -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 <itai3397@gmail.com>+--+-- 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

@@ -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 <itai3397@gmail.com>+--+-- 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

@@ -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 <itai3397@gmail.com>+--++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

@@ -1,62 +1,121 @@--- |+-- | Module    : Hum.Rebuild+-- Copyright   : (c) Itai Y. Efrat 2020-2021+-- License     : GPLv2-or-later (see LICENSE)+-- Maintainer  : Itai Y. Efrat <itai3397@gmail.com>+--+-- 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 "<no playlists>" 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 "<no playlists>" 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'

@@ -1,89 +1,109 @@--- |+-- | Module    : Hum.Types+-- Copyright   : (c) Itai Y. Efrat 2020-2021+-- License     : GPLv2-or-later (see LICENSE)+-- Maintainer  : Itai Y. Efrat <itai3397@gmail.com>+--+-- 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

@@ -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 <itai3397@gmail.com>+--+-- 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 "<no playlists>" 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

@@ -1,21 +1,27 @@--- | +-- | Module    : Hum.Utils+-- Copyright   : (c) Itai Y. Efrat 2020-2021+-- License     : GPLv2-or-later (see LICENSE)+-- Maintainer  : Itai Y. Efrat <itai3397@gmail.com>+--++ module Hum.Utils where import           Hum.Types import           Hum.Rebuild import           Brick.Types-import           Brick.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 "<error>" (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_

@@ -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 <itai3397@gmail.com>+--+-- 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 "<no title>" MPD.Title song+    title = withAttr titleAttr $ txt $ meta "<no title>" MPD.Title song     album =-      withAttr queueAlbumAttr (txt $ meta "<no album>" MPD.Album song)+      withAttr albumAttr (txt $ meta "<no album>" MPD.Album song)         <+> txt " ("-        <+> withAttr queueDateAttr (txt $ meta "????" MPD.Date song)+        <+> withAttr dateAttr (txt $ meta "????" MPD.Date song)         <+> txt ")"-    artist  = withAttr queueArtistAttr $ txt $ meta "<no one>" MPD.Artist song-    progbar = withAttr queueTimeAttr $ drawProgressBar st+    artist  = withAttr artistAttr $ txt $ meta "<no one>" 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 "<error getting playlist name>" pl)

@@ -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 <itai3397@gmail.com>+--+-- 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

@@ -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 <itai3397@gmail.com>+--+-- 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"

@@ -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 <itai3397@gmail.com>+--+-- 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 "<error>" snd ? MPD.toText

@@ -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 <itai3397@gmail.com>+--+-- 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       "<no album>"       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     "<no title>"     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       "<no artist>"       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