diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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 + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. + + + Copyright (C) + + 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. + + , 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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`. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -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 diff --git a/hum.cabal b/hum.cabal new file mode 100644 --- /dev/null +++ b/hum.cabal @@ -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 diff --git a/src/Brick/Widgets/List.hs b/src/Brick/Widgets/List.hs new file mode 100644 --- /dev/null +++ b/src/Brick/Widgets/List.hs @@ -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 diff --git a/src/Hum/Attributes.hs b/src/Hum/Attributes.hs new file mode 100644 --- /dev/null +++ b/src/Hum/Attributes.hs @@ -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 + ] + ) + ) diff --git a/src/Hum/BChan.hs b/src/Hum/BChan.hs new file mode 100644 --- /dev/null +++ b/src/Hum/BChan.hs @@ -0,0 +1,6 @@ +-- | +module Hum.BChan where +--import Network.MPD +--import Hum.Types + +-- put stuff dealing with Types here later diff --git a/src/Hum/Modes.hs b/src/Hum/Modes.hs new file mode 100644 --- /dev/null +++ b/src/Hum/Modes.hs @@ -0,0 +1,11 @@ +-- | + +module Hum.Modes + ( + module Hum.Modes.ExMode + ,module Hum.Modes.PromptMode + ) +where + +import Hum.Modes.ExMode +import Hum.Modes.PromptMode diff --git a/src/Hum/Modes/ExMode.hs b/src/Hum/Modes/ExMode.hs new file mode 100644 --- /dev/null +++ b/src/Hum/Modes/ExMode.hs @@ -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 diff --git a/src/Hum/Modes/PromptMode.hs b/src/Hum/Modes/PromptMode.hs new file mode 100644 --- /dev/null +++ b/src/Hum/Modes/PromptMode.hs @@ -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 diff --git a/src/Hum/Rebuild.hs b/src/Hum/Rebuild.hs new file mode 100644 --- /dev/null +++ b/src/Hum/Rebuild.hs @@ -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 "" 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 "" 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' diff --git a/src/Hum/Types.hs b/src/Hum/Types.hs new file mode 100644 --- /dev/null +++ b/src/Hum/Types.hs @@ -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 diff --git a/src/Hum/UI.hs b/src/Hum/UI.hs new file mode 100644 --- /dev/null +++ b/src/Hum/UI.hs @@ -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 "" 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 diff --git a/src/Hum/Utils.hs b/src/Hum/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Hum/Utils.hs @@ -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 "" (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 diff --git a/src/Hum/Views.hs b/src/Hum/Views.hs new file mode 100644 --- /dev/null +++ b/src/Hum/Views.hs @@ -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 diff --git a/src/Hum/Views/Common.hs b/src/Hum/Views/Common.hs new file mode 100644 --- /dev/null +++ b/src/Hum/Views/Common.hs @@ -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 "" MPD.Title song + album = + withAttr queueAlbumAttr (txt $ meta "" MPD.Album song) + <+> txt " (" + <+> withAttr queueDateAttr (txt $ meta "????" MPD.Date song) + <+> txt ")" + artist = withAttr queueArtistAttr $ txt $ meta "" 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 "" pl) diff --git a/src/Hum/Views/Help.hs b/src/Hum/Views/Help.hs new file mode 100644 --- /dev/null +++ b/src/Hum/Views/Help.hs @@ -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 diff --git a/src/Hum/Views/Library.hs b/src/Hum/Views/Library.hs new file mode 100644 --- /dev/null +++ b/src/Hum/Views/Library.hs @@ -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" diff --git a/src/Hum/Views/Playlists.hs b/src/Hum/Views/Playlists.hs new file mode 100644 --- /dev/null +++ b/src/Hum/Views/Playlists.hs @@ -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 "" snd ? MPD.toText diff --git a/src/Hum/Views/Queue.hs b/src/Hum/Views/Queue.hs new file mode 100644 --- /dev/null +++ b/src/Hum/Views/Queue.hs @@ -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 + "" + 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 + "" + MPD.Title + song + artist = + withAttr queueArtistAttr $ column (Just (Per 25)) Max (Pad 1) $ txt $ meta + "" + 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 diff --git a/test/MyLibTest.hs b/test/MyLibTest.hs new file mode 100644 --- /dev/null +++ b/test/MyLibTest.hs @@ -0,0 +1,4 @@ +module Main (main) where + +main :: IO () +main = putStrLn "Test suite not yet implemented."