Configurable history size; 61 selectable. (#126)

Author: galenhuntington

Base.hs

@@ -21,6 +21,7 @@ import Data.Functor as X hiding (unzip)
 import Data.IORef as X
 import Data.List as X hiding ((!?))
 import Data.Maybe as X
+import Data.Sequence as X (Seq, (<|), (|>))
 import Data.String as X
 import Data.Traversable as X
 import Data.Version as X

Core.hs

@@ -61,6 +61,7 @@ mp3Tool = "mpg123"
 data Options = Options
     { optPaused     :: !Bool             -- ^ start in a paused state
     , optConfigPath :: !(Maybe FilePath) -- ^ override the style.conf location
+    , optHistSize   :: Int               -- ^ history size
     }
 
 -- | Sets up state, spawns sub-threads, and starts player.
@@ -108,6 +109,7 @@ start opts (Playlist folders music) = do
         , modal        = Nothing
         , playHist     = mempty
         , searchHist   = []
+        , histSize     = optHistSize opts
         , miniFocused  = False
         , exiting      = False
         , status       = Stopped
@@ -414,7 +416,7 @@ runPlayOp op = do
                 { current = new
                 , status  = Playing
                 , cursor  = if current == cursor then new else cursor
-                , playHist = Seq.take 36 $ (now, new) Seq.<| playHist
+                , playHist = Seq.take histSize $ (now, new) <| playHist
                 , id3     = Nothing
                 }
             pure f

Keyboard.hs

@@ -3,11 +3,12 @@
 -- Copyright (c) 2019, 2023-2026 Galen Huntington
 -- SPDX-License-Identifier: GPL-2.0-or-later
 
-module Keyboard (unkey, charToKey, Key(..)) where
+module Keyboard (unkey, charToKey, Key(..), historyKeys) where
 
 import Base
 
 import Data.Map.Strict qualified as M
+import Data.Sequence qualified as Seq
 import UI.HSCurses.Curses (Key(..), decodeKey)
 
 ------------------------------------------------------------------------
@@ -29,3 +30,6 @@ keyCharMap = M.fromList [(charToKey c, c) | c <- ['\0' .. '\500']]
 unkey :: Key -> Char
 unkey k = fromMaybe '\0' $ M.lookup k keyCharMap
 
+historyKeys :: Seq Char
+historyKeys = Seq.fromList $ ['0'..'9'] ++ ['a'..'z'] ++ filter (/='H') ['A'..'Z']
+

Keymap.hs

@@ -16,7 +16,7 @@ import Base
 
 import Core
 import Config (package)
-import Keyboard (unkey, charToKey, Key(..))
+import Keyboard (unkey, charToKey, Key(..), historyKeys)
 import State (getsHS, modifyHS_, KeysHelp, Modal(..), HState(..))
 import Style (defaultSty, StringA(Fast))
 import UI qualified (getKey, resetui)
@@ -70,7 +70,7 @@ mainMode = KeyMap \c -> getsHS modal >>= \case
 
 
 historyKeyMap :: M.Map Char Int
-historyKeyMap = M.fromList $ zip (['0'..'9'] ++ ['a'..'z']) [0..]
+historyKeyMap = M.fromList $ zip (toList historyKeys) [0..]
 
 
 ------------------------------------------------------------------------

State.hs

@@ -14,7 +14,6 @@ import Playlist                 (FileArray, DirArray)
 import Style                    (StringA, UIStyle)
 
 import Data.ByteString          (hPut)
-import Data.Sequence            (Seq)
 import System.Clock             (TimeSpec(..))
 import System.IO                (hFlush)
 import System.Process           (ProcessHandle)
@@ -50,6 +49,7 @@ data HState = HState
     , searchHist      :: ![String]
     , exiting         :: !Bool                 -- let mpg123 die?
     , playHist        :: !(Seq (TimeSpec, Int))
+    , histSize        :: Int
     , config          :: !UIStyle
     }
 

UI.hs

@@ -27,7 +27,7 @@ import Syntax
 import Config
 import Width                    (displayWidth, toMaxWidth, toWidth)
 import UI.HSCurses.Curses qualified as Curses
-import Keyboard                 (unkey, charToKey)
+import Keyboard                 (unkey, charToKey, historyKeys)
 
 import Data.Array               ((!), bounds, Array)
 import Data.Array.Base          (unsafeAt)
@@ -235,13 +235,15 @@ helpModal help swd = (wd, map showLine help) where
 ------------------------------------------------------------------------
 
 histModal :: HistDisplay -> ModalMaker
+histModal []   _   = let s = "  No history  " in (P.length s, [s])
 histModal hist swd = do
     let wd = commonModalWidth swd
-        mtlen = maximum $ 0 : map (displayWidth . fst) hist
+        mtlen = maximum $ map (displayWidth . fst) hist
         tlen = min (mtlen + 1) $ wd `div` 3
-    (wd,) $ flip map (zip (['0'..'9']++['a'..'z']) hist) \ (c, (time, (_, song))) ->
+    (wd, [
         let tstr = toMaxWidth tlen $ P.replicate (tlen - displayWidth time) ' ' <> time
         in mconcat [" ", P.singleton c, " ", tstr, " ", song]
+        | (c, (time, (_, song))) <- zip (toList historyKeys ++ repeat ' ') hist ])
 
 ------------------------------------------------------------------------
 
@@ -484,9 +486,7 @@ renderModals st sz =
         ExitModal   -> exitModal
 
 ------------------------------------------------------------------------
---
 -- | Draw the screen
---
 redraw :: Draw
 redraw = Draw $ discardErrors {- TODO what errors are discarded? -} do
     st <- getsHS id    -- another refresh could be triggered?
@@ -516,9 +516,7 @@ redraw = Draw $ discardErrors {- TODO what errors are discarded? -} do
         -- todo rendering bug here when deleting backwards in minibuffer
 
 ------------------------------------------------------------------------
---
 -- | Draw a coloured (or not) string to the screen
---
 drawLine :: StringA -> IO ()
 drawLine (Fast ps sty) = drawSegment ps sty
 drawLine (FancyS ls)   = traverse_ (uncurry drawSegment) ls

app/Main.hs

@@ -54,6 +54,9 @@ invocation = (,) <$> opts <*> files
         <*> optional (strOption -- temporarily internal since feature needs work
             (long "config" <> short 'c' <> metavar "FILE" <> internal
                 <> help "Read this config file instead of the XDG default"))
+        <*> option auto (
+            long "history" <> short 'h' <> metavar "NUM" <> value 61
+                <> help "Size of play history, up to 61 selectable" <> showDefault)
     files = some $ argument (UTF8.fromString <$> str) (metavar "FILE|DIR...")
 
 parserInfo :: ParserInfo (Options, [ByteString])