hum (empty) → 0.1.0.0
raw patch · 23 files changed
+2938/−0 lines, 23 filesdep +basedep +brickdep +bytestringsetup-changed
Dependencies added: base, brick, bytestring, containers, directory, filepath, hum, lens, libmpd, mtl, relude, template-haskell, text, text-zipper, time, transformers, vector, vty, witherable-class
Files
- CHANGELOG.md +13/−0
- LICENSE +339/−0
- README.md +47/−0
- Setup.hs +2/−0
- app/Main.hs +36/−0
- hum.cabal +164/−0
- src/Brick/Widgets/List.hs +648/−0
- src/Hum/Attributes.hs +77/−0
- src/Hum/BChan.hs +6/−0
- src/Hum/Modes.hs +11/−0
- src/Hum/Modes/ExMode.hs +54/−0
- src/Hum/Modes/PromptMode.hs +76/−0
- src/Hum/Rebuild.hs +85/−0
- src/Hum/Types.hs +108/−0
- src/Hum/UI.hs +252/−0
- src/Hum/Utils.hs +183/−0
- src/Hum/Views.hs +16/−0
- src/Hum/Views/Common.hs +137/−0
- src/Hum/Views/Help.hs +80/−0
- src/Hum/Views/Library.hs +214/−0
- src/Hum/Views/Playlists.hs +198/−0
- src/Hum/Views/Queue.hs +188/−0
- test/MyLibTest.hs +4/−0
+ CHANGELOG.md view
@@ -0,0 +1,13 @@++# Revision history for hum++## 0.1.0.0 - 2020-12-12++- First version. Released on an unsuspecting world.+- Includes basic functionality: the queue, library navigation, and playlist selection+- Vi keybindings for navigation+- Vi keybindings for queue and playlist editing+- Vi style search in all views +- Rudimentary ex mode style commands, including `:help`+- ncmpcpp style mpd mode change keybindings+
+ LICENSE view
@@ -0,0 +1,339 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Lesser General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License along+ with this program; if not, write to the Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License.
+ README.md view
@@ -0,0 +1,47 @@+# Hum: a Haskell Music Manager++A TUI mpd client, currently in beta and under active development.++The plan is to basically reimplement ncmpcpp in haskell (at least featurewise). The reasons are as follows:++- Haskell is much more fun than C+++- I find the tag editor of ncmpcpp to be lacking and want to change it+- Generally, I want to change some stuff with the UI+- It's faster (try scrolling down the artists in the library in both programs)+- I wanted to design the program around vim style bindings+- I don't know C+++++## Installation++As this is an MPD client, you will need to install [mpd](https://github.com/MusicPlayerDaemon/MPD) from your favorite package manager.++You can install `hum` either by running `cabal install hum` to install directly from hackage, or by cloning the repo and running `cabal install` from within it.++## Features++### Current++- playback keys+- Viewing the Queue, Library, and Playlists screens+- Editing the Queue with vim like cut copy and paste+- adding and bulk adding songs from the Library and Play nlists+- vim style search+- a help command+- playlist editing+++### Planned++- better documentation+- tag info and editing+- mpdish file browser 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+- more commands+- more vimmy keybindings (e.g. 10j, perhaps making y and d verbs)+- doing stuff with album art using uegerzug+- config file++For a list of all the keybindings and ex style commands, type `:help` and press `RET`.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,36 @@+module Main where++import Brick.Main+import qualified Brick.BChan as BC+import qualified Graphics.Vty as Vty+import Hum.UI ( buildInitialState+ , app+ )+import Control.Concurrent ( threadDelay+ , forkIO+ )+import Hum.Types+import Network.MPD ( withMPD+ , idle+ )++main :: IO ()+main = do+ chan <- BC.newBChan 10+ _ <- forkIO $ mpdListenForever chan+ _ <- forkIO $ tickTock chan+ initialState <- buildInitialState chan+ let buildVty = Vty.mkVty Vty.defaultConfig+ initialVty <- buildVty+ _ <- customMain initialVty buildVty (Just chan) app initialState+ pass++mpdListenForever :: BC.BChan HumEvent -> IO ()+mpdListenForever chan = forever $ do+ response <- withMPD $ idle []+ BC.writeBChan chan (Right response)++tickTock :: BC.BChan HumEvent -> IO ()+tickTock chan = forever $ do+ BC.writeBChan chan (Left Tick)+ threadDelay 1000000
+ hum.cabal view
@@ -0,0 +1,164 @@+cabal-version: 3.0++-- Initial package description 'hum.cabal' generated by 'cabal init'. For+-- further documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name: hum++-- The package version. See the Haskell package versioning policy (PVP)+-- for standards guiding when and how versions should be incremented.+-- https://pvp.haskell.org+-- PVP summary: +-+------- breaking API changes+-- | | +----- non-breaking API additions+-- | | | +--- code changes with no API change+version: 0.1.0.0++-- A short (one-line) description of the package.+synopsis: A TUI MPD client, inspired by ncmpcpp++-- A longer description of the package.+description: A TUI MPD client, inspired by ncmpcpp.+ Built using brick and libmpd.++-- A URL where users can report bugs.+-- bug-reports:++-- The license under which the package is released.+license: GPL-2.0-or-later++-- The file containing the license text.+license-file: LICENSE++-- The package author(s).+author: Itai Y. Efrat++-- An email address to which users can send suggestions, bug reports, and+-- patches.+maintainer: itai3397@gmail.com++-- A copyright notice.+copyright: (c) Itai Efrat 2020++category: Sound++tested-with: GHC == 8.10.2, 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++source-repository head+ type: git+ location: https://gitlab.com/iyefrat/hum.git++common deps+ build-depends:+ base >= 4.11 && < 4.15+ ,brick >= 0.57.1 && < 0.58+ ,bytestring >= 0.10.10 && < 0.11+ ,containers >= 0.6.2 && < 0.7+ ,text >= 1.2.3 && < 1.3+ ,mtl >= 2.2.2 && < 2.3+ ,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+ ,lens >= 4.19.2 && < 4.20+ ,text-zipper >= 0.10.1 && < 0.11+ ,vector >= 0.12.1 && < 0.13+ ,vty >= 5.32 && < 5.33+ ,libmpd >= 0.9.2 && < 0.10+ ,relude >= 0.7.0 && < 0.8+ ,witherable-class++ mixins:+ base hiding (Prelude)+ , relude (Relude as Prelude)++ ghc-options:+ -Wall+ -Wcompat+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wredundant-constraints++ default-extensions:+ LambdaCase+ FlexibleInstances+ FlexibleContexts+ InstanceSigs+ MultiParamTypeClasses+ EmptyCase+ OverloadedStrings+ NamedFieldPuns+ MultiWayIf+ TupleSections+ DeriveFoldable+ DeriveFunctor+ DeriveTraversable+ DeriveGeneric+ GeneralizedNewtypeDeriving+ DerivingStrategies+ BangPatterns+ KindSignatures+ TypeOperators+ ScopedTypeVariables+ TemplateHaskell+ RankNTypes+ default-language: Haskell2010++library+ import: deps+ -- Modules exported by the library.+ exposed-modules:+ Hum.UI+ , Hum.Types+ , Hum.BChan+ , Hum.Attributes+ , Hum.Views+ , Hum.Views.Common+ , Hum.Views.Queue+ , Hum.Views.Library+ , Hum.Views.Playlists+ , Hum.Views.Help+ , Hum.Utils+ , Hum.Modes+ , Hum.Modes.ExMode+ , Hum.Modes.PromptMode+ , Hum.Rebuild+ -- Modules included in this library but not exported.+ other-modules: Brick.Widgets.List++ -- Other library packages from which modules are imported.+ -- Directories containing source files.+ hs-source-dirs: src+++executable hum+ import: deps+ -- .hs or .lhs file containing the Main module.+ main-is: Main.hs++ -- Modules included in this executable, other than Main.+ -- other-modules:+ build-depends: hum+ -- Directories containing source files.+ hs-source-dirs: app+ ghc-options: -threaded++test-suite hum-test+ import: deps+ -- Base language which the package is written in.+ default-language: Haskell2010++ -- The interface type and version of the test suite.+ type: exitcode-stdio-1.0++ -- The directory where the test specifications are found.+ hs-source-dirs: test++ -- The entrypoint to the test suite.+ main-is: MyLibTest.hs
+ src/Brick/Widgets/List.hs view
@@ -0,0 +1,648 @@+{-# 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
+ src/Hum/Attributes.hs view
@@ -0,0 +1,77 @@+-- |++module Hum.Attributes where++import Brick.AttrMap+import Brick.Types+import Brick.Widgets.Core+import Brick.Widgets.List ( listAttr+ , listSelectedAttr+ , listSelectedFocusedAttr+ )+import qualified Brick.Util as BU+import Graphics.Vty ( defAttr )+import qualified Graphics.Vty as Vty+++humAttrMap :: AttrMap+humAttrMap = attrMap+ defAttr+ [ (listAttr , Vty.withStyle (BU.fg Vty.white) Vty.defaultStyleMask)+ , (listSelectedAttr , Vty.withStyle defAttr Vty.underline)+ , (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)+ ]++wobAttr :: Vty.Attr+wobAttr = BU.fg Vty.white++queueAttr, queueAlbumAttr, queueTitleAttr, queueTrackAttr, queueArtistAttr, queueTimeAttr, queueDateAttr+ :: AttrName+queueAttr = "queue"+queueAlbumAttr = queueAttr <> "album"+queueTitleAttr = queueAttr <> "title"+queueTrackAttr = queueAttr <> "track"+queueArtistAttr = queueAttr <> "artist"+queueTimeAttr = queueAttr <> "time"+queueDateAttr = queueAttr <> "date"++headerAttr :: AttrName+headerAttr = "header"++listHighlightedAttr :: AttrName+listHighlightedAttr = listAttr <> "highlighted"+queueNowPlayingAttr :: AttrName+queueNowPlayingAttr = queueAttr <> "now playing"++queueTitleBoldAttr :: AttrName+queueTitleBoldAttr = queueTitleAttr <> "bold"+++editorAttr :: AttrName+editorAttr = "editor"++highlightOverQueueAttrs :: Widget n -> Widget n+highlightOverQueueAttrs = updateAttrMap+ (mapAttrNames+ ( (listHighlightedAttr, )+ <$> [ queueAlbumAttr+ , queueTrackAttr+ , queueTitleAttr+ , queueArtistAttr+ , queueTimeAttr+ ]+ )+ )
+ src/Hum/BChan.hs view
@@ -0,0 +1,6 @@+-- |+module Hum.BChan where+--import Network.MPD+--import Hum.Types++-- put stuff dealing with Types here later
+ src/Hum/Modes.hs view
@@ -0,0 +1,11 @@+-- |++module Hum.Modes+ (+ module Hum.Modes.ExMode+ ,module Hum.Modes.PromptMode+ )+where++import Hum.Modes.ExMode+import Hum.Modes.PromptMode
+ src/Hum/Modes/ExMode.hs view
@@ -0,0 +1,54 @@+-- |++module Hum.Modes.ExMode where++import Brick.Widgets.Edit hiding ( decodeUtf8 )+import Brick.Types+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 Control.Lens hiding (uncons)+import qualified Network.MPD as MPD++exEnd :: HState -> EventM Name (Next HState)+exEnd s =+ let searched = (s ^. exL . exEditorL . editContentsL & Z.currentLine)+ s'= s & exL . exEditorL .~ editorText ExEditor (Just 1) ""+ & modeL .~ NormalMode+ & focusL . focExL .~ False+ in+ case s ^. exL . exPrefixL of+ Cmd -> exCmdExecute (words searched) (s' & exL . cmdHistoryL %~ (searched :) )+ srch -> case hview s' of+ QueueView -> continue =<< queueSearch (srch == FSearch) s''+ LibraryView -> continue =<< librarySearch (srch == FSearch) s''+ PlaylistsView -> continue =<< playlistsSearch (srch == FSearch) s''+ HelpView -> continue s'+ where s''= s' & exL . searchHistoryL %~ (searched :)+handleExEvent+ :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState)+handleExEvent s e = case e of+ VtyEvent (EvKey KEnter []) -> exEnd s+ VtyEvent vtye ->+ continue =<< handleEventLensed s (exL . exEditorL) handleEditorEvent vtye+ _ -> continue s++exPrefixTxt :: ExSubMode -> Text+exPrefixTxt Cmd = ":"+exPrefixTxt FSearch= "/"+exPrefixTxt BSearch = "?"++exCmdExecute :: [Text] -> HState -> EventM Name (Next HState)+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 _ s = continue s
+ src/Hum/Modes/PromptMode.hs view
@@ -0,0 +1,76 @@+-- |++module Hum.Modes.PromptMode where++import Brick.Widgets.Edit hiding ( decodeUtf8 )+import Brick.Types+import Brick.Main+import Hum.Types+import Hum.Utils+import Graphics.Vty.Input.Events+import qualified Data.Text.Zipper as Z+ hiding ( textZipper )+import Control.Lens+import qualified Network.MPD as MPD+import qualified Data.Vector as V+import Brick.Widgets.List+++handlePromptEvent+ :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState)+handlePromptEvent s e = case s ^. promptsL . currentPromptL of+ PlSelectPrompt -> handlePlSelectPromptEvent s e+ TextPrompt -> handleTextPromptEvent s e+ YNPrompt -> handleYNPromptEvent s e++handlePlSelectPromptEvent+ :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState)+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 (KChar 'j') [] -> do+ continue $ s & promptsL . plSelectPromptL %~ listMoveDown+ EvKey (KChar 'k') [] -> do+ continue $ s & promptsL . plSelectPromptL %~ listMoveUp+ EvKey (KChar 'l') [] -> do+ 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+ 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+ _ -> 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++handleTextPromptEvent+ :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState)+handleTextPromptEvent s e = case e of+ VtyEvent (EvKey KEsc []) -> continue (s & modeL .~ NormalMode)+ VtyEvent (EvKey KEnter []) ->+ continue =<< (s ^. promptsL . exitPromptL) (s & modeL .~ NormalMode)+ VtyEvent vtye ->+ continue+ =<< handleEventLensed s (promptsL . textPromptL) handleEditorEvent vtye+ _ -> continue s++handleYNPromptEvent+ :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState)+handleYNPromptEvent s e = case e of+ VtyEvent (EvKey KEsc []) -> continue (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
+ src/Hum/Rebuild.hs view
@@ -0,0 +1,85 @@+-- |++module Hum.Rebuild where++import Hum.Types+import Control.Lens+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))++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)+++rebuildLib :: MonadIO m => HState -> m HState+rebuildLib s = do+ artistsVec <- liftIO (V.fromList . fromRight [] <$> withMPD+ (MPD.list MPD.AlbumArtist Nothing))+ let artists' = list ArtistsList artistsVec 1+ albumsVec <- liftIO $ albumsOfArtist (snd <$> listSelectedElement artists')+ let albums' = list AlbumsList albumsVec 1+ songsVec <- liftIO $ songsOfAlbum (snd <$> listSelectedElement albums')+ let songs' = list SongsList songsVec 1+ pure $ s & libraryL . artistsL .~ artists'+ & libraryL . albumsL .~ albums'+ & libraryL . songsL .~ songs'++rebuildLibArtists :: MonadIO m => HState -> m HState+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')+ let songs' = list SongsList songsVec 1+ pure $ s & libraryL . artistsL .~ artists'+ & libraryL . albumsL .~ albums'+ & libraryL . songsL .~ songs'++rebuildLibAlbums :: MonadIO m => HState -> m HState+rebuildLibAlbums s = do+ let albums' = s ^. libraryL . albumsL+ songsVec <- liftIO $ songsOfAlbum (snd <$> listSelectedElement albums')+ let songs' = list SongsList songsVec 1+ pure $ s & libraryL . albumsL .~ albums' & libraryL . songsL .~ songs'++rebuildPl :: MonadIO m => HState -> m HState+rebuildPl s = do+ plListVec <- liftIO $ V.fromList . fromRight [] <$> withMPD MPD.listPlaylists+ let plList' = list PlaylistList plListVec 1+ plSongsVec <- liftIO $ V.fromList . fromRight [] <$> withMPD+ (MPD.listPlaylistInfo+ (maybe "<no playlists>" snd (listSelectedElement plList'))+ )+ let plSongs' = (, False) <$> list PlaylistSongs plSongsVec 1+ pure $ s & playlistsL . plListL .~ plList'+ & playlistsL . plSongsL .~ plSongs'++rebuildPlList :: MonadIO m => HState -> m HState+rebuildPlList s = do+ let plList' = s ^. playlistsL . plListL+ plSongsVec <- liftIO+ (V.fromList . fromRight [] <$> withMPD+ (MPD.listPlaylistInfo+ (maybe "<no playlists>" snd (listSelectedElement plList'))+ )+ )+ let plSongs' = (, False) <$> list PlaylistSongs plSongsVec 1+ pure $ s & playlistsL . plListL .~ plList'+ & playlistsL . plSongsL .~ plSongs'++rebuildQueue :: MonadIO m => HState -> m HState+rebuildQueue s = do+ queueVec <- liftIO $ V.fromList . fromRight [] <$> withMPD (MPD.playlistInfo Nothing)+ let queue' = (, False) <$> list QueueList queueVec 1+ pure $ s & queueL .~ queue'
+ src/Hum/Types.hs view
@@ -0,0 +1,108 @@+-- |++module Hum.Types where+import Network.MPD as MPD+import qualified Brick.BChan as BC+import Brick.Types+import Brick.Widgets.Edit+import Brick.Widgets.List+++data HState = HState+ { chan :: !(BC.BChan HumEvent)+ , hview :: !View+ , status :: !(Maybe MPD.Status)+ , mode :: !Mode+ , ex :: !ExState+ , currentSong :: !(Maybe MPD.Song)+ , queue :: !SongList+ , library :: !LibraryState+ , playlists :: !PlaylistsState+ , extentMap :: !(Map Name (Maybe (Extent Name)))+ , clipboard :: !Clipboard+ , focus :: !Focus+ , editable :: !Bool+ , prompts :: !Prompts+ , helpScreen :: !Int --HACK+ }+-- deriving (Show) --, Eq)++data LibraryState = LibraryState+ { artists :: !(List Name MPD.Value)+ , albums :: !(List Name MPD.Value)+ , songs :: !(List Name Song)+ }++data PlaylistsState = PlaylistsState+ { plList :: !(List Name PlaylistName)+ , plSongs :: !SongList+ }++data ExSubMode = Cmd | FSearch | BSearch+ deriving (Show, Eq, Ord)++data ExState = ExState+ { exPrefix :: !ExSubMode+ , exEditor :: !(Editor Text Name)+ , searchDirection :: !Bool+ , 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+ }++data PromptType = PlSelectPrompt | YNPrompt | TextPrompt+ deriving (Show,Eq)++data Clipboard = Clipboard { clSongs :: !SongList+ , clPlName :: !(Maybe PlaylistName)}++data Mode = NormalMode | ExMode | PromptMode+ deriving (Show,Eq)++type SongList = List Name (Song, Highlight)++type HumEvent = Either Tick (Response [Subsystem])++data Name = NowPlaying | ClSongs+ | Queue | QueueList+ | Library | ArtistsList | LibraryLeft | AlbumsList | LibraryMid | SongsList | LibraryRight+ | PlaylistList | PlaylistLeft | PlaylistSongs | PlaylistRight+ | 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+ , focPlay :: FocPlay+ , focEx :: Bool+ }+ deriving (Show, Eq, Ord)++data View = QueueView | LibraryView | PlaylistsView | HelpView+ deriving (Show,Eq,Ord)++type Highlight = Bool++data Tick = Tick++suffixLenses ''HState+suffixLenses ''Focus+suffixLenses ''LibraryState+suffixLenses ''PlaylistsState+suffixLenses ''ExState+suffixLenses ''Prompts+suffixLenses ''Clipboard
+ src/Hum/UI.hs view
@@ -0,0 +1,252 @@+{-# LANGUAGE LambdaCase #-}+module Hum.UI where+++import Brick.Main+import Brick.Types+import qualified Brick.BChan as BC+import Brick.Widgets.Core+import Brick.Widgets.List+import Brick.Widgets.Edit+import Graphics.Vty.Input.Events+import Network.MPD ( withMPD )+import qualified Network.MPD as MPD+import Hum.Types+import qualified Data.Vector as V+import qualified Data.Text as T+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++app = App { appDraw = drawUI+ , appChooseCursor = chooseCursor+ , appHandleEvent = handleEvent+ , appStartEvent = humStartEvent+ , appAttrMap = const humAttrMap+ }++drawUI :: HState -> [Widget Name]+drawUI st =+ [if st ^. modeL == PromptMode then drawPrompt st else emptyWidget,+ drawNowPlaying st+ <=> (case hview st of+ QueueView -> drawViewQueue st+ LibraryView -> drawViewLibrary st+ PlaylistsView -> drawViewPlaylists st+ HelpView -> drawViewHelp st+ )+ <=> if st ^. focusL . focExL+ then txt (st ^. exL . exPrefixL & exPrefixTxt) <+> renderEditor+ (txt . T.unlines)+ (st ^. focusL . focExL)+ (st ^. exL . exEditorL)+ else txt " "+ ]++chooseCursor :: HState -> [CursorLocation Name] -> Maybe (CursorLocation Name)+chooseCursor st ls+ | st ^. focusL . focExL = find (isCurrent ExEditor) ls+ | st ^. promptsL . currentPromptL == TextPrompt = find (isCurrent TextPromptEditor) ls+ | otherwise = Nothing+ where+ isCurrent n cl = cl ^. cursorLocationNameL == Just n++buildInitialState :: BC.BChan HumEvent -> IO HState+buildInitialState chan = do+ configDir <- getXdgDirectory XdgConfig "hum"+ _ <- createDirectoryIfMissing True configDir+ let mode = NormalMode+ let ex = ExState { exPrefix = Cmd+ , exEditor = editorText ExEditor (Just 1) ""+ , searchDirection = True+ , searchHistory = []+ , cmdHistory = []+ }+ 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+ , focEx = False+ }+ let clipboard = Clipboard { clSongs = list ClSongs V.empty 1+ , 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)+ let artists = list ArtistsList artistsVec 1+ albumsVec <- albumsOfArtist (snd <$> listSelectedElement artists)+ let albums = list AlbumsList albumsVec 1+ songsVec <- songsOfAlbum (snd <$> listSelectedElement albums)+ let songs = list SongsList songsVec 1+ plListVec <- V.fromList . 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+ { currentPrompt = PlSelectPrompt+ , promptTitle = ""+ , textPrompt = editorText TextPromptEditor (Just 1) ""+ , plSelectPrompt = listInsert 0 Nothing (Just <$> plList)+ , exitPrompt = \s -> pure $ s & modeL .~ NormalMode+ }+ let helpScreen = 0+ pure HState { chan+ , hview+ , mode+ , ex+ , status+ , currentSong+ , queue+ , extentMap+ , clipboard+ , library+ , playlists+ , focus+ , editable+ , prompts+ , helpScreen+ }++humStartEvent :: HState -> EventM Name HState+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)+handleEvent s e = case e of+ VtyEvent vtye -> case s ^. modeL of+ ExMode -> handleExEvent s e+ PromptMode -> handlePromptEvent s e+ NormalMode -> case vtye of+ EvKey (KChar 'q') [] -> halt s+ 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)+ 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 }+ 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 }+ EvKey (KChar 'x') [] -> do+ _ <- liftIO+ (withMPD $ MPD.crossfade+ ( (\case+ 0 -> 5+ _ -> 0+ )+ $ maybe 0 MPD.stXFadeWidth (status s)+ )+ ) -- TODO+ status <- liftIO (fromRight Nothing <$> (Just <<$>> withMPD MPD.status))+ continue s { status }+ 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 }+ 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 }+ EvKey (KChar '/') [] ->+ continue $ s & modeL .~ ExMode+ & exL . exPrefixL .~ FSearch+ & exL . searchDirectionL .~ True+ & focusL . focExL .~ True+ EvKey (KChar '?') [] ->+ continue $ s & modeL .~ ExMode+ & exL . exPrefixL .~ BSearch+ & exL . searchDirectionL .~ False+ & focusL . focExL .~ True+ EvKey (KChar ':') [] ->+ continue $ s & modeL .~ ExMode+ & exL . exPrefixL .~ Cmd+ & focusL . focExL .~ True+ EvKey (KChar '.') [] -> do+ _ <- liftIO (withMPD MPD.next)+ song <- liftIO (withMPD MPD.currentSong)+ continue s { currentSong = fromRight Nothing song }+ 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+ EvKey (KChar '1') [] -> do+ _ <- liftIO (BC.writeBChan (chan s) (Left Tick))+ continue $ s & editableL .~ False+ & hviewL .~ QueueView+ EvKey (KChar '2') [] -> do+ _ <- liftIO (BC.writeBChan (chan s) (Left Tick))+ continue $ s & editableL .~ False+ & hviewL .~ LibraryView+ EvKey (KChar '3') [] -> do+ _ <- liftIO (BC.writeBChan (chan s) (Left Tick))+ continue $ s & editableL .~ False+ & hviewL .~ PlaylistsView+ EvResize _ _ -> do+ extentMap <- updateExtentMap+ continue s { extentMap }+ _ -> 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 }+ _ -> continue s
+ src/Hum/Utils.hs view
@@ -0,0 +1,183 @@+-- |++module Hum.Utils where+import Hum.Types+import Hum.Rebuild+import Brick.Types+import Brick.Main+import Brick.Widgets.List+import qualified Data.Vector as V+import qualified Data.Text as T+import Network.MPD ( withMPD )+import qualified Network.MPD as MPD+import qualified Data.Map.Strict as Map+import Text.Printf ( printf )+import Control.Lens+import qualified Data.Witherable.Class as W++-- | A backwards function composition operator+infixl 8 ?+{-# INLINE (?) #-}+-- Make sure it has TWO args only on the left, so that it inlines+-- when applied to two functions, even if there is no final argument+(?) :: (a -> b) -> (b -> c) -> a -> c+(?) f g = \x -> g (f x)++-- | Get comma seperated metedata from tag+meta :: Text -> MPD.Metadata -> MPD.Song -> Text+meta notFound tag song = maybe+ notFound+ (T.intercalate ",")+ (MPD.toText <<$>> Map.lookup tag (MPD.sgTags song))++-- | like meta, but returns a Maybe for future use+mmeta :: MPD.Metadata -> MPD.Song -> Maybe Text+mmeta tag song =+ T.intercalate "," <$> (MPD.toText <<$>> Map.lookup tag (MPD.sgTags song))+++secondsToTime :: Integer -> Text+secondsToTime sec =+ let (minutes, seconds) = divMod sec 60+ in toText (printf "%d:%02d" minutes seconds :: String)++updateExtentMap :: EventM Name (Map Name (Maybe (Extent Name)))+updateExtentMap = do+ queueE <- lookupExtent Queue+ nowPlayingE <- lookupExtent NowPlaying+ libLeftE <- lookupExtent LibraryLeft+ libMidE <- lookupExtent LibraryMid+ libRightE <- lookupExtent LibraryRight+ playLeftE <- lookupExtent PlaylistLeft+ playRightE <- lookupExtent PlaylistRight+ let extentMap = Map.fromList+ [ (Queue , queueE)+ , (NowPlaying , nowPlayingE)+ , (LibraryLeft , libLeftE)+ , (LibraryMid , libMidE)+ , (LibraryRight , libRightE)+ , (PlaylistLeft , playLeftE)+ , (PlaylistRight, playRightE)+ ]+ pure extentMap++deleteHighlightedfromQ :: MPD.MonadMPD m => SongList -> m ()+deleteHighlightedfromQ ls =+ let (hls :: SongList) = W.filter snd ls+ in for_ hls (\s -> whenJust (MPD.sgId . fst $ s) MPD.deleteId)+ >> whenJust+ ((MPD.sgId . fst . snd) =<< listSelectedElement ls)+ MPD.deleteId++deleteAll :: MPD.MonadMPD m => SongList -> m ()+deleteAll ls = for_ ls (\s -> whenJust (MPD.sgId . fst $ s) MPD.deleteId)++pasteSongstoQ :: MPD.MonadMPD m => SongList -> SongList -> m ()+pasteSongstoQ clip ls =+ let pos = listSelected ls+ indexedClip = V.indexed $ MPD.sgFilePath . fst <$> listElements clip+ in for_ indexedClip (\(n, song) -> MPD.addId song $ (+ (n + 1)) <$> pos)++getHighlighted+ :: (Eq e, W.Filterable t, Foldable t, Splittable t)+ => GenericList n t (e, Highlight)+ -> GenericList n t (e, Highlight)+getHighlighted ls = hls where+ hls = W.filter+ (\(el, hl) -> hl || Just (el, hl) == (snd <$> listSelectedElement ls))+ ls++listPaste+ :: (Splittable t, Semigroup (t e))+ => GenericList n t e+ -> GenericList n t e+ -> GenericList n t e+listPaste paste ls =+ let es = listElements ls+ pos = fromMaybe 0 (listSelected ls)+ (es1, es2) = Brick.Widgets.List.splitAt (pos + 1) es+ in ls { listElements = es1 <> listElements paste <> es2 }++deleteHighlighted :: HState+ -> Lens' HState SongList+ -> HState+deleteHighlighted st lns = st & clipboardL . clSongsL .~ (st ^. lns & listHighlight ? W.filter snd ? listUnhighlightAll)+ & lns %~ listHighlight ? W.filter (not . snd)++-- | toggle selected items highlight status+listToggleHighlight :: Traversable t => GenericList n t (e,Highlight) -> GenericList n t (e,Highlight)+listToggleHighlight = listModify (second not)+++-- | Highlight selcted item status+listHighlight :: Traversable t => GenericList n t (e,Highlight) -> GenericList n t (e,Highlight)+listHighlight = listModify (second (const True))++listUnhighlightAll :: Traversable t => GenericList n t (e,Highlight) -> GenericList n t (e,Highlight)+listUnhighlightAll = fmap (second $ const False)++saveListToPl :: MPD.MonadMPD m => SongList -> Text -> m ()+saveListToPl ls name =+ let songpaths = MPD.sgFilePath . fst <$> listElements ls+ name' = fromString . T.unpack $ name+ in for_ songpaths (MPD.playlistAdd name')++overwriteListToPl :: MPD.MonadMPD m => SongList -> Text -> m ()+overwriteListToPl ls name =+ let songpaths = MPD.sgFilePath . fst <$> listElements ls+ name' = fromString . T.unpack $ name+ in MPD.playlistClear name' >>+ for_ songpaths (MPD.playlistAdd name')++saveEditedPl :: HState -> EventM n HState+saveEditedPl st = do+ let plSongs = st ^. playlistsL . plSongsL+ let plName = st ^. playlistsL . plListL & listSelectedElement ? maybe "unnamed" snd ? MPD.toText+ _ <- liftIO . withMPD $ overwriteListToPl plSongs plName+ pure st++deleteSelectedPl :: HState -> EventM n HState+deleteSelectedPl st = do+ let plName = st ^. playlistsL . plListL & listSelectedElement <&> snd+ _ <- liftIO . withMPD $ traverse MPD.rm plName+ rebuildPl st++duplicatePlaylist :: MPD.PlaylistName -> HState -> EventM n HState+duplicatePlaylist pl st = do+ songs <- V.fromList . fromRight [] <$> (liftIO . withMPD $ MPD.listPlaylistInfo pl)+ plNames <- (MPD.toText <$>) . fromRight [] <$> (liftIO . withMPD $ MPD.listPlaylists)+ let newPlName = viaNonEmpty head $ filter (`notElem` plNames) (map ((\tx num -> tx <> "-copy" <> show num) (MPD.toText pl)) [1::Int ..])+ traverse_ (\pln -> songBulkAddtoPl pln songs st) (T.unpack <$> newPlName)+ rebuildPl st++pastePlaylist :: HState -> EventM n HState+pastePlaylist st = do+ let plName = fromMaybe "<error>" (st ^. clipboardL . clPlNameL)+ duplicatePlaylist plName st++songBulkAddtoQ :: Bool -> V.Vector MPD.Song -> HState -> EventM n HState+songBulkAddtoQ play songs s = do+ let songPaths = MPD.sgFilePath <$> songs+ traverse_+ (\sel -> liftIO+ (withMPD $ MPD.addId sel Nothing >>= if play+ then MPD.playId+ else const pass+ )+ )+ (V.take 1 songPaths)+ traverse_ (\sel -> liftIO (withMPD $ MPD.addId sel Nothing))+ (V.drop 1 songPaths)+ song <- liftIO (withMPD MPD.currentSong)+ pure s { currentSong = fromRight Nothing song, queue = queue s }++songBulkAddtoPl :: String -> V.Vector MPD.Song -> HState -> EventM n HState+songBulkAddtoPl pl songs s = do+ let songPaths = MPD.sgFilePath <$> songs+ traverse_+ (\sel -> liftIO+ (withMPD $ MPD.playlistAdd (fromString pl) sel+ )+ )+ songPaths+ rebuildPl s
+ src/Hum/Views.hs view
@@ -0,0 +1,16 @@+-- |++module Hum.Views+ ( module Hum.Views.Common+ , module Hum.Views.Queue+ , module Hum.Views.Library+ , module Hum.Views.Playlists+ , module Hum.Views.Help+ )+where++import Hum.Views.Common+import Hum.Views.Queue+import Hum.Views.Library+import Hum.Views.Playlists+import Hum.Views.Help
+ src/Hum/Views/Common.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE LambdaCase #-}+-- |++module Hum.Views.Common where+import Hum.Types+import Brick.Types+import Brick.Widgets.Core+import Brick.Widgets.Center+import Brick.Widgets.Edit+import Brick.Widgets.Border+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+drawNowPlaying st = reportExtent NowPlaying $ vLimit 5 . center $ maybe+ (txt "nothing.")+ nowPlaying+ (currentSong st)+ where+ nowPlaying song =+ txt "\n"+ <=> hCenter title+ <=> hCenter (artist <+> txt " - " <+> album)+ <=> progbar+ <=> (padRight Max playing <+> padLeft Max mode)+ where+ title = withAttr queueTitleAttr $ txt $ meta "<no title>" MPD.Title song+ album =+ withAttr queueAlbumAttr (txt $ meta "<no album>" MPD.Album song)+ <+> txt " ("+ <+> withAttr queueDateAttr (txt $ meta "????" MPD.Date song)+ <+> txt ")"+ artist = withAttr queueArtistAttr $ txt $ meta "<no one>" MPD.Artist song+ progbar = withAttr queueTimeAttr $ drawProgressBar st+ playing = txt $ maybe+ "[ ]"+ ((\t -> "[" <> t <> "]") . T.toLower . show . MPD.stState)+ (status st)+ formatMode t modeFun = maybe+ "-"+ ( (\case+ False -> "-"+ True -> t+ )+ . modeFun+ )+ (status st)+ repeatmpd = formatMode "r" MPD.stRepeat+ random = formatMode "z" MPD.stRandom+ single = formatMode "s" MPD.stSingle+ consume = formatMode "c" MPD.stConsume+ crossfade = formatMode "x" ((/= 0) . MPD.stXFadeWidth)+ mode =+ txt $ "[" <> repeatmpd <> random <> single <> consume <> crossfade <> "]"++drawProgressBar :: HState -> Widget Name+drawProgressBar st = case width of+ 0 -> txt $ Prelude.toText timeText+ _ -> bar+ 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+ (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) ' ')+ )++--drawEx :: HState -> Widget Name+--drawEx st =++data PerCol = Per Int | Col Int+column :: Maybe PerCol -> Padding -> 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++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)+++stringySearch :: MPD.ToString a => Text -> a -> Bool+stringySearch text value =+ T.isInfixOf (T.toLower text) (T.toLower . MPD.toText $ value)++drawPrompt :: HState -> Widget Name+drawPrompt st = case st ^. promptsL . currentPromptL of+ PlSelectPrompt ->+ centerLayer+ . border+ . setAvailableSize (30, 10)+ . center+ $ (hCenter . txt $ st ^. promptsL . promptTitleL)+ <=> hBorder+ <=> renderListWithIndex choosePlRow+ True+ (st ^. promptsL . plSelectPromptL)+ TextPrompt ->+ centerLayer+ . border+ . setAvailableSize (30, 3)+ . center+ $ (hCenter . txt $ st ^. promptsL . promptTitleL)+ <=> hBorder+ <=> (center . setAvailableSize (25, 1) . withDefAttr editorAttr)+ (renderEditor (txt . T.unlines) True (st ^. promptsL . textPromptL))+ YNPrompt ->+ centerLayer+ . border+ . hLimit 30+ $ (hCenter . txt $ st ^. promptsL . promptTitleL)+ <=> (hCenter . txt $ "[y/n]")+++choosePlRow :: Int -> Bool -> Maybe MPD.PlaylistName -> Widget n+choosePlRow i _ pl = if i==0 then+ str "New Playlist" <=> modifyDefAttr (const wobAttr) hBorder+ else str (MPD.toString $ fromMaybe "<error getting playlist name>" pl)
+ src/Hum/Views/Help.hs view
@@ -0,0 +1,80 @@+{-#LANGUAGE RankNTypes#-}+-- |++module Hum.Views.Help where+import Prelude hiding ( Down )+import Hum.Types+import Brick.Types+import Graphics.Vty.Input.Events+import Brick.Main+import Brick.Widgets.Core+import Brick.Widgets.Center+import Control.Lens+++drawViewHelp :: HState -> Widget Name+drawViewHelp st = center ((hCenter . txt $ "j/k cycle between help screens.") <=> txt (helpText st))++helpText :: HState -> Text+helpText st = unlines $ case st^.helpScreenL of+ 0 -> [+ "Change views:"+ , " 1 - queue"+ , " 2 - library"+ , " 3 - playlists"+ , ""+ , "General Bindings:"+ , " t - play/pause toggle"+ , " , - previous song"+ , " . - next song"+ , " [ and ] - skip 5 second in either direction"+ , " { and } - skip 30 second in either direction"+ , " hjkl - vim movements"+ , " / and ? - forwards and backwards search"+ , " n and N - move to next and previous match of search"+ , " : - execute commands"+ , " q - quit"+ , " s - toggle single mode in mpd"+ , " 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:"+ , " SPC - select song"+ , " y and d - yank and delete the selected songs"+ , " p - paste selected song"+ , " a - add selected songs to playlist"+ , ""+ , "Library and Playlists keybindigns:"+ , " SPC - add song/song collection to queue"+ , " RET - add song/song collection to queue, and start playing the first one"+ , ""+ , "Playlists keybindigns:"+ , " on playlist conents:"+ , " e - make playlist editable, press again to get save prompt."+ , " editing a playlist is the same as editing the queue"+ , " on list of playlists:"+ , " y and p - copy and paste playlists (with -copy added to the name)"+ , " d - delete playlist (with prompt)"+ , ""+ , "Commands:"+ , ":help - gets you this"+ , ":q - quits"+ , ":save $name - saves the queue to a playlist called $name"+ ]+ _ -> ["something went wrong."]+++handleEventHelp+ :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState)+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 'G') [] -> continue s+ EvKey (KChar 'g') [] -> continue s+ _ -> continue s+ _ -> continue s
+ src/Hum/Views/Library.hs view
@@ -0,0 +1,214 @@+{-#LANGUAGE RankNTypes#-}+-- |++module Hum.Views.Library where+import Prelude hiding ( Down )+import Hum.Types+import Brick.Types+import Graphics.Vty.Input.Events+import Brick.Main+import Brick.Widgets.Core+import Brick.Widgets.Center+import Brick.Widgets.Border+import Control.Lens+import Brick.Widgets.List+import Hum.Attributes+import Hum.Views.Common+import Hum.Rebuild+import qualified Data.Text as T+import Network.MPD ( withMPD )+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+ . vLimit vsize+ . center+ $ hBorder+ <=> hCenter+ (renderList (const $ libraryRow st LibraryLeft)+ ((focLib . focus $ st) == FocArtists)+ (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+ . vLimit vsize+ . center+ $ hBorder+ <=> hCenter+ (renderList (const $ libraryRow st LibraryMid)+ ((focLib . focus $ st) == FocAlbums)+ (MPD.toText <$> st ^. libraryL . albumsL)+ )+ )+++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+ . vLimit vsize+ . center+ $ hBorder+ <=> hCenter+ (renderList (const $ librarySongRow st)+ ((focLib . focus $ st) == FocSongs)+ (st ^. libraryL . songsL)+ )+ )+++libraryRow :: HState -> Name -> T.Text -> Widget n+libraryRow _ name val =+ withAttr+ (case name of+ LibraryLeft -> queueArtistAttr+ LibraryMid -> queueAlbumAttr+ _ -> listAttr+ )+ $ column Nothing (Pad 1) Max+ $ txt val++librarySongRow :: HState -> 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+ )+ $ column Nothing (Pad 1) Max+ $ txt (meta (MPD.toText . MPD.sgFilePath $ song) MPD.Title song)++libraryMoveRight :: FocLib -> FocLib+libraryMoveRight FocArtists = FocAlbums+libraryMoveRight _ = FocSongs++libraryMoveLeft :: FocLib -> FocLib+libraryMoveLeft FocSongs = FocAlbums+libraryMoveLeft _ = FocArtists++drawViewLibrary :: HState -> Widget Name+drawViewLibrary st =+ drawLibraryLeft st <+> drawLibraryMid st <+> drawLibraryRight st++libraryMove+ :: (forall e . List Name e -> List Name e) -> HState -> EventM Name HState+libraryMove moveFunc s =+ let libfoc = s ^. focusL . focLibL+ in case libfoc of+ FocArtists -> rebuildLibArtists $ s & libraryL . artistsL %~ moveFunc+ FocAlbums -> rebuildLibAlbums $ s & libraryL . albumsL %~ moveFunc+ FocSongs -> do+ pure $ s & libraryL . songsL %~ moveFunc+++libraryAddtoQ :: Bool -> HState -> EventM Name HState+libraryAddtoQ play s =+ let libfoc = s ^. focusL . focLibL+ in+ case libfoc of+ FocArtists -> do+ songs <-+ liftIO+ (songsOfArtist+ (snd <$> listSelectedElement (s ^. libraryL . artistsL))+ )+ songBulkAddtoQ play songs s+ FocAlbums -> do+ songs <-+ liftIO+ (songsOfAlbum+ (snd <$> listSelectedElement (s ^. libraryL . albumsL))+ )+ songBulkAddtoQ play songs s+ FocSongs -> do+ let maybeFilePath = MPD.sgFilePath . 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 }++librarySearch :: Bool -> HState -> EventM Name HState+librarySearch direction s =+ let libfoc = s ^. focusL . focLibL+ dir = if direction then id else listReverse+ searchkey = fromMaybe "" ((s ^. exL . searchHistoryL) !!? 0)+ in if searchkey == ""+ then pure s+ else case libfoc of+ FocArtists -> do+ extentMap <- updateExtentMap+ rebuildLibArtists+ $ (s { extentMap })+ & libraryL+ . artistsL+ %~ (dir . listFindBy (stringySearch searchkey) . dir)+ FocAlbums -> do+ extentMap <- updateExtentMap+ rebuildLibAlbums+ $ (s { extentMap })+ & libraryL+ . albumsL+ %~ (dir . listFindBy (stringySearch searchkey) . dir)+ FocSongs -> do+ extentMap <- updateExtentMap+ pure+ $ s { extentMap }+ & libraryL+ . songsL+ %~ (dir . listFindBy (songSearch searchkey [MPD.Title]) . dir)+++handleEventLibrary+ :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState)+handleEventLibrary s e = case e of+ VtyEvent vtye -> case vtye of+ EvKey (KChar 'j') [] -> continue =<< libraryMove listMoveDown s+ EvKey (KChar 'k') [] -> continue =<< libraryMove listMoveUp s+ EvKey (KChar 'l') [] -> continue $ s & focusL . focLibL %~ libraryMoveRight+ EvKey (KChar 'h') [] -> continue $ s & focusL . focLibL %~ libraryMoveLeft+ EvKey (KChar 'n') [] ->+ continue =<< librarySearch (s ^. exL . searchDirectionL) s+ EvKey (KChar 'N') [] ->+ continue =<< librarySearch (s ^. exL . searchDirectionL & not) s+ EvKey KEnter [] ->+ 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 0) s -- TODO change this to 'gg', somehow+ _ -> continue s+ _ -> continue s++addToPl :: EventM Name HState+addToPl = error "not implemented"
+ src/Hum/Views/Playlists.hs view
@@ -0,0 +1,198 @@+{-#LANGUAGE RankNTypes#-}+-- |++module Hum.Views.Playlists where++import Hum.Types+import Brick.Types+import Graphics.Vty.Input.Events+import Brick.Main+import Brick.Widgets.Core+import Brick.Widgets.Center+import Brick.Widgets.Border+import Brick.Widgets.Border.Style+import Control.Lens+import Brick.Widgets.List+import Hum.Attributes+import Hum.Views.Common+import Hum.Rebuild+import qualified Data.Text as T+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+ . vLimit vsize+ . center+ $ hBorder+ <=> hCenter+ (renderList (const $ playlistRow st)+ ((focPlay . focus $ st) == FocPlaylists)+ (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+ . vLimit vsize+ . center+ $ (if st ^. editableL+ then+ withDefAttr listHighlightedAttr+ . withBorderStyle (borderStyleFromChar '=')+ $ hBorderWithLabel+ $ txt "editing"+ else hBorder+ )+ <=> hCenter+ (renderList (const $ playlistSongRow st)+ ((focPlay . focus $ st) == FocPSongs)+ (st ^. playlistsL . plSongsL)+ )+ )++playlistRow :: HState -> T.Text -> Widget n+playlistRow _ val =+ withAttr queueAlbumAttr $ column Nothing (Pad 1) Max $ txt val++playlistSongRow :: HState -> (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+ (if MPD.sgFilePath song `elem` pathsInQueue+ then queueTitleBoldAttr+ else queueTitleAttr+ )+ $ column Nothing (Pad 1) Max+ $ txt (meta (MPD.toText . MPD.sgFilePath $ song) MPD.Title song)+++++++drawViewPlaylists :: HState -> Widget Name+drawViewPlaylists st =+ hLimitPercent 25 (drawPlaylistLeft st) <+> drawPlaylistRight st++playlistsMove+ :: (forall e . List Name e -> List Name e) -> HState -> EventM Name HState+playlistsMove moveFunc s =+ let playfoc = s ^. focusL . focPlayL+ in case playfoc of+ FocPlaylists -> rebuildPlList $ s & playlistsL . plListL %~ moveFunc+ FocPSongs -> do+ pure $ s & playlistsL . plSongsL %~ moveFunc++playlistsAddtoQ :: Bool -> HState -> EventM Name HState+playlistsAddtoQ play s =+ let playfoc = s ^. focusL . focPlayL+ in case playfoc of+ FocPlaylists -> do+ songBulkAddtoQ play (fst <$> listElements (s ^. playlistsL . plSongsL)) s+ FocPSongs -> do+ let maybeFilePath = MPD.sgFilePath . fst . snd <$> listSelectedElement+ (s ^. playlistsL . plSongsL)+ 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 }++playlistsSearch :: Bool -> HState -> EventM Name HState+playlistsSearch direction s =+ let playfoc = s ^. focusL . focPlayL+ dir = if direction then id else listReverse+ searchkey = fromMaybe "" ((s ^. exL . searchHistoryL) !!? 0)+ in if searchkey == ""+ then pure s+ else case playfoc of+ FocPlaylists -> do+ extentMap <- updateExtentMap+ rebuildPlList+ $ (s { extentMap })+ & playlistsL+ . plListL+ %~ (dir . listFindBy (stringySearch searchkey) . dir)+ FocPSongs -> do+ extentMap <- updateExtentMap+ pure+ $ s { extentMap }+ & playlistsL+ . plSongsL+ %~ (dir . listFindBy (songSearch searchkey [MPD.Title] . fst) . dir)+++handleEventPlaylists+ :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState)+handleEventPlaylists s e = case e of+ VtyEvent vtye -> case vtye of+ EvKey (KChar 'j') [] -> continue =<< playlistsMove listMoveDown s+ EvKey (KChar 'k') [] -> continue =<< playlistsMove listMoveUp s+ EvKey (KChar 'l') [] -> continue $ s & focusL . focPlayL .~ FocPSongs+ EvKey (KChar 'h') [] -> continue $ s & focusL . focPlayL .~ FocPlaylists+ EvKey (KChar 'n') [] ->+ continue =<< playlistsSearch (s ^. exL . searchDirectionL) s+ EvKey (KChar 'N') [] ->+ continue =<< playlistsSearch (s ^. exL . searchDirectionL & not) s+ EvKey KEnter [] ->+ continue =<< playlistsMove listMoveDown =<< playlistsAddtoQ True s+ EvKey (KChar ' ') [] -> if s ^. editableL then+ continue $ s & playlistsL . plSongsL %~ (listMoveDown . listToggleHighlight)+ else+ continue =<< playlistsMove listMoveDown =<< playlistsAddtoQ False s+ EvKey (KChar 'd') []+ | s ^. editableL+ -> continue $ deleteHighlighted s (playlistsL . plSongsL)+ | s ^. focusL . focPlayL == FocPlaylists+ -> continue $ s & modeL .~ PromptMode+ & promptsL . currentPromptL .~ YNPrompt+ & promptsL . promptTitleL .~ ("DELETE " <> selectedPl <> "?\nYou can't paste it back yet")+ & promptsL . exitPromptL .~ deleteSelectedPl+ | otherwise -> continue s+ EvKey (KChar 'y') []+ | s ^. editableL+ -> continue $ s & clipboardL . clSongsL .~ (s ^. playlistsL . plSongsL & getHighlighted)+ | s ^. focusL . focPlayL == FocPlaylists+ -> continue $ s & clipboardL . clPlNameL .~ (s ^. playlistsL . plListL & listSelectedElement <&> snd)+ | otherwise -> continue s+ EvKey (KChar 'p') []+ | s ^. editableL+ -> continue $ s & playlistsL . plSongsL %~ listPaste (s^. clipboardL. clSongsL)+ | 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 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)+ _ -> continue s+ _ -> continue s+ where selectedPl = s ^. playlistsL . plListL & listSelectedElement ? maybe "<error>" snd ? MPD.toText
+ src/Hum/Views/Queue.hs view
@@ -0,0 +1,188 @@+-- |++module Hum.Views.Queue where+import Hum.Types+import Brick.Main+import Graphics.Vty.Input.Events+import Brick.Types+import Brick.Widgets.Core+import Brick.Widgets.Center+import Brick.Widgets.List+import Hum.Attributes+import Hum.Utils+import Hum.Rebuild+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+ . center+ $ hCenter header+ <=> hCenter+ (renderList (const (queueRow st))+ ((focQueue . focus $ st) == FocQueue)+ (queue st)+ )+ )++ where+ {-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"+ artist =+ withAttr queueArtistAttr $ column (Just (Per 25)) Max (Pad 1) $ txt "Artist"+ time =+ withAttr queueTimeAttr $ 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+queueRow st (song, hl) =+ (if hl then highlightOverQueueAttrs else id)+ . (if Just (MPD.sgIndex song) == (MPD.sgIndex <$> nowPlaying)+ then withDefAttr queueNowPlayingAttr+ else id+ )+ $ hCenter ( {-songIdx+ <+> songId+ <+> -}+ album <+> track <+> title <+> artist <+> time)+ where+ nowPlaying = currentSong st+ {-songIdx =+ column (Just (Col 4)) Max (Pad 1) $ txt $ maybe "?" show $ MPD.sgIndex song+ songId =+ column (Just (Col 3)) Max (Pad 1)+ $ txt+ $ maybe "?" (\(MPD.Id x) -> show x)+ $ MPD.sgId song-}+ album =+ withAttr queueAlbumAttr $ 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+ "?"+ MPD.Track+ song+ title = withAttr queueTitleAttr $ column Nothing Max Max $ txt $ meta+ "<no title>"+ MPD.Title+ song+ artist =+ withAttr queueArtistAttr $ column (Just (Per 25)) Max (Pad 1) $ txt $ meta+ "<no artist>"+ MPD.Artist+ song+ time =+ withAttr queueTimeAttr+ $ 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+queueSearch direction s =+ let+ dir = if direction then id else listReverse+ searchkey = fromMaybe "" ((s ^. exL . searchHistoryL) !!? 0)+ in+ if searchkey == ""+ then pure s+ else do+ extentMap <- updateExtentMap+ pure+ $ s { extentMap }+ & queueL+ %~ ( dir+ . listFindBy+ ( songSearch searchkey [MPD.Title, MPD.Album, MPD.Artist]+ . fst+ )+ . dir+ )++queueAddToPl :: HState -> String -> EventM Name HState+queueAddToPl s plName =+ let songs =+ (s ^. queueL)+ & getHighlighted+ & listElements+ <&> fst+ in songBulkAddtoPl plName songs s++++handleEventQueue+ :: HState -> BrickEvent Name HumEvent -> EventM Name (Next HState)+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 '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 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 }+ 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'+ 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)+ 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 }+ _ -> continue s+ _ -> continue s
+ test/MyLibTest.hs view
@@ -0,0 +1,4 @@+module Main (main) where++main :: IO ()+main = putStrLn "Test suite not yet implemented."