diff --git a/Base.hs b/Base.hs
--- a/Base.hs
+++ b/Base.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE CPP #-}
 
--- Copyright (c) 2020-2025 Galen Huntington
+-- Copyright (c) 2020-2026 Galen Huntington
 -- SPDX-License-Identifier: GPL-2.0-or-later
 
 module Base (module Prelude, module X, module Base) where
@@ -19,13 +19,13 @@
 import Data.Foldable as X
 import Data.Functor as X hiding (unzip)
 import Data.IORef as X
-import Data.List as X
+import Data.List as X hiding ((!?))
 import Data.Maybe as X
 import Data.String as X
 import Data.Traversable as X
 import Data.Version as X
+import Data.Void as X
 import Data.Word as X
-import System.Environment as X
 import System.Exit as X
 import System.IO as X (Handle, hClose)
 import System.IO.Unsafe as X
@@ -47,8 +47,10 @@
     Monotonic
 #endif
 
-sequenceWhile :: Monad m => (a -> Bool) -> [m a] -> m [a]
-sequenceWhile _ [] = pure []
-sequenceWhile p (m:ms) = m >>= \a ->
-    if p a then (a:) <$> sequenceWhile p ms else pure []
+whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
+whenJust = flip $ maybe $ pure ()
+
+-- Compatibility: List.!? only added in GHC 9.8
+(!?) :: [a] -> Int -> Maybe a
+xs !? n = listToMaybe $ drop n xs
 
diff --git a/Core.hs b/Core.hs
--- a/Core.hs
+++ b/Core.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, AllowAmbiguousTypes #-}
+{-# LANGUAGE CPP #-}
 
 -- Copyright (c) 2005-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons
 -- Copyright (c) 2008, 2019-2026 Galen Huntington
@@ -9,54 +9,52 @@
 --
 module Core (
     Options(..),
-    start,
-    shutdown,
+    start, shutdown,
     seekLeft, seekRight, upOne, downOne, pause, nextMode, playNext, playPrev,
-    forcePause, putmsg, clrmsg, toggleHelp, play, playCur,
+    forcePause, putMessage, clearMessage, playCursor, playCur,
     jumpToPlaying, jump, jumpRel,
     upPage, downPage,
     seekStart,
     blacklist,
-    showHist, hideHist,
+    setsModal, closeModal, showHist,
     jumpToMatchDir, jumpToMatchFile,
     toggleFocus, jumpToNextDir, jumpToPrevDir,
     loadConfig,
     discardErrors,
-    toggleExit,
     showTimeDiff_,
 ) where
 
 import Base
 
 import Syntax
-import Lexer                (parser)
+import Lexer (mpgParser)
 import State
 import Style
-import FastIO               (FiltHandle(..), newFiltHandle)
 import Tree hiding (File, Dir)
 import qualified Tree (File,Dir)
 import qualified UI
 
-import Text.Regex.PCRE.Light
-import {-# SOURCE #-} Keymap (keyLoop)
-
 import qualified Data.ByteString.Char8 as P
 import qualified Data.Sequence as Seq
 
 import Data.Array               ((!), bounds, Array)
+import Data.Proxy
 import Data.Tuple               (swap)
 import Control.Monad.State.Strict
 import System.Directory         (doesFileExist, findExecutable, createDirectoryIfMissing,
                                  getXdgDirectory, XdgDirectory(..))
-import System.IO                (hPutStrLn, hGetLine, stderr, hFlush)
+import System.IO                (hPutStrLn, hGetLine, stderr)
 import System.Process           (runInteractiveProcess, waitForProcess)
 import System.Clock             (TimeSpec(..), diffTimeSpec)
-import System.Random            (randomR)
+import System.Random            (randomR, newStdGen)
 import System.FilePath          ((</>))
+import System.Posix.FilePath    (takeFileName)
 
 import System.Posix.Process     (exitImmediately)
 
+import Text.Regex.PCRE.Light
 
+
 mp3Tool :: String
 mp3Tool =
 #ifdef MPG321
@@ -73,17 +71,25 @@
     , optConfigPath :: !(Maybe FilePath) -- ^ override the style.conf location
     }
 
+-- | Sets up state, spawns sub-threads, and starts player.
 start :: Options -> Tree -> IO ()
-start opts (Tree ds fs) = handle @SomeException (shutdown . Just . show) do
-
-    c <- UI.start -- initialise curses
+start opts (Tree folders music) = do
 
-    now <- getMonoTime
+    config <- catch @SomeException UI.start \err -> do
+        -- An uncaught exception here would deadlock.
+        -- XXX more state model revisions should obviate need
+        hPutStrLn stderr $ "Curses failed to start: " ++ show err
+        exitImmediately (ExitFailure 1) *> error "Unix <2.8"
+    bootTime <- getMonoTime
+    let size = length music
     mode <- readState
+    gen <- newStdGen
+    let (current, randomGen) =
+            if mode == Random then randomR (0, size-1) gen else (0, gen)
 
     threads <- traverse forkIO
         [ mpgLoop
-        , mpgInput readf
+        , mpgInput readh
         , refreshLoop
         , clockLoop
         , uptimeLoop
@@ -91,24 +97,39 @@
         , if mp3Tool == "mpg321" then mpgInput errh else errorLoop
         ]
 
-    silentlyModifyHS $ \st -> st
-        { music        = fs
-        , folders      = ds
-        , size         = 1 + (snd . bounds $ fs)
-        , cursor       = 0
-        , current      = 0
-        , mode         = mode
-        , boottime     = now
-        , config       = c
+    putMVar hState HState
+        { music
+        , folders
+        , size
+        , bootTime
         , configPath   = optConfigPath opts
-        , threads      }
-
-    loadConfig
+        , current
+        , cursor       = current
+        , randomGen
+        , mode
+        , config
+        , threads
+        , spawns       = 0
+        , mpgPid       = Nothing
+        , clock        = Nothing
+        , info         = Nothing
+        , id3          = Nothing
+        , regex        = Nothing
+        , modal        = Nothing
+        , playHist     = mempty
+        , searchHist   = []
+        , clockUpdate  = False
+        , miniFocused  = False
+        , exiting      = False
+        , status       = Stopped
+        , minibuffer   = Fast mempty defaultSty
+        , uptime       = mempty
+        }
 
-    if mode == Random then runPlayOp playRandomOp else playCur
-    when (optPaused opts) pause
+    loadConfig  -- TODO this should return config rather than setting it
 
-    run         -- won't restart if this fails!
+    playCur
+    when (optPaused opts) pause -- TODO use LOADPAUSED?
 
 ------------------------------------------------------------------------
 
@@ -125,12 +146,12 @@
 -- I don't know why these are ignored, but preserving old logic.
 -- For profiling, make sure to return True for anything:
 exitTime :: SomeException -> Bool
-exitTime e | is @IOException e = False -- ignore
-           | is @ErrorCall e   = False -- ignore
+exitTime e | is @IOException Proxy e = False -- ignore
+           | is @ErrorCall Proxy e   = False -- ignore
            -- "user errors" were caught before, but are no longer a thing
-           | otherwise         = True
-    where is :: forall e. Exception e => SomeException -> Bool
-          is = isJust . fromException @e
+           | otherwise               = True
+    where is :: forall e. Exception e => Proxy e -> SomeException -> Bool
+          is _ = isJust . fromException @e
 
 ------------------------------------------------------------------------
 
@@ -151,7 +172,7 @@
           Left (ex :: SomeException) ->
             warnA $ mppath ++ " failed to start; retrying: " ++ show ex
 
-          Right (writeh, r, e, pid) -> do
+          Right (writeh, readh, errh, pid) -> do
             ct <- modifyHS $ \st -> let sp = spawns st + 1 in (st
                 { mpgPid    = Just pid
                 , status    = Stopped
@@ -160,9 +181,7 @@
                 , spawns    = sp
                 }, sp)
 
-            readf <- newFiltHandle r
-            errh <- newFiltHandle e
-            putMVar mpg Mpg { readf, errh, writeh }
+            putMVar mpg Mpg { readh, errh, writeh }
 
             when (ct > 1) $ warnA $ mp3Tool ++ " #" ++ show ct ++ ": Ready"
             catch @SomeException (void $ waitForProcess pid) (const $ pure ())
@@ -171,7 +190,7 @@
             silentlyModifyHS $ \st -> st { mpgPid = Nothing }
             void $ takeMVar mpg
 
-            stop <- getsHS doNotResuscitate
+            stop <- getsHS exiting
             when stop exitSuccess
             threadDelay 1_000_000  -- let threads spit errors
             warnA $ "Restarting " ++ mppath ++ " ..."
@@ -185,17 +204,16 @@
 -- | When the editor state has been modified, refresh, then wait
 -- for it to be modified again.
 refreshLoop :: IO ()
-refreshLoop = do
-    mvar <- getsHS modified
-    runForever $ takeMVar mvar >> UI.refresh
+refreshLoop = runForever $ takeMVar modified *> UI.refresh
 
+
 ------------------------------------------------------------------------
 
 -- | The clock ticks once per minute, but check more often in case of drift.
 uptimeLoop :: IO ()
 uptimeLoop = runForever $ do
     now <- getMonoTime
-    modifyHS_ $ \st -> st { uptime = showTimeDiff (boottime st) now }
+    modifyHS_ $ \st -> st { uptime = showTimeDiff (bootTime st) now }
     threadDelay 3_000_000
 
 ------------------------------------------------------------------------
@@ -229,7 +247,7 @@
 -- | Handle, and display errors produced by mpg123
 errorLoop :: IO ()
 errorLoop = runForever $
-    readMVar mpg <&> errh >>= hGetLine . filtHandle >>= (warnA . ("mpg: " ++))
+    readMVar mpg <&> errh >>= hGetLine >>= (warnA . ("mpg123 err: " ++))
 
 ------------------------------------------------------------------------
 
@@ -237,34 +255,31 @@
 -- shutdown kills the other end of the pipe, hGetLine will fail, so we
 -- take that chance to exit.
 --
-mpgInput :: (Mpg -> FiltHandle) -> IO ()
+mpgInput :: (Mpg -> Handle) -> IO ()
 mpgInput field = runForever $ do
-    res <- parser =<< field <$> readMVar mpg
-    case res of
+    line <- P.hGetLine =<< field <$> readMVar mpg
+    case mpgParser line of
         Right m       -> handleMsg m
-        Left (Just e) -> (warnA . ("read: " ++) . show) e
+        Left (Just e) -> warnA ("mpg123: " ++ e)
         _             -> pure ()
 
 ------------------------------------------------------------------------
 
--- | The main thread: handle keystrokes fed to us by curses
-run :: IO ()
-run = runForever keyLoop
-
-------------------------------------------------------------------------
-
 -- | Close most things. Important to do all the jobs:
+-- TODO maybe releaseSignals here in case mpg is frozen?
+--   and/or move UI.end up?
 shutdown :: Maybe String -> IO ()
 shutdown ms = do
-    silentlyModifyHS $ \st -> st { doNotResuscitate = True }
+    silentlyModifyHS $ \st -> st { exiting = True }
     discardErrors writeState
     mpid <- getsHS mpgPid
-    flip (maybe $ pure ()) mpid \pid -> do
+    whenJust mpid \pid -> do
         discardErrors $ sendMpg Quit
         void $ waitForProcess pid
-    UI.end =<< getsHS xterm
-    flip (maybe $ pure ()) ms \s -> hPutStrLn stderr s *> hFlush stderr
-    exitImmediately ExitSuccess
+    UI.end
+    exitImmediately =<< case ms of
+        Just s -> hPutStrLn stderr s *> pure (ExitFailure 1)
+        _      -> pure ExitSuccess
 
 ------------------------------------------------------------------------
 -- 
@@ -272,13 +287,13 @@
 -- right pigeon hole.
 --
 handleMsg :: Msg -> IO ()
-handleMsg (T _)                = pure ()
-handleMsg (I i)                = modifyHS_ $ \s -> s { info = Just i }
-handleMsg (F (File (Left  _))) = modifyHS_ $ \s -> s { id3 = Nothing }
-handleMsg (F (File (Right i))) = modifyHS_ $ \s -> s { id3 = Just i  }
 
+handleMsg (T _)   = pure ()
+handleMsg (I i)   = modifyHS_ $ \s -> s { info = Just i }
+handleMsg (F id3) = modifyHS_ $ \s -> s { id3 = Just id3 }
+
 handleMsg (S t) = do
-    modifyHS_ $ \s -> s { status  = t }
+    modifyHS_ $ \s -> s { status = t }
     when (t == Stopped) playNext   -- transition to next song
 
 handleMsg (R f) = do
@@ -305,13 +320,10 @@
 -- | Generic seek
 seek :: (Frame -> Int) -> IO ()
 seek fn = do
-    f <- getsHS clock
-    case f of
-        Nothing -> pure ()
-        Just g  -> do
-            sendMpg $ Jump (fn g)
-            forceNextPacket         -- don't drop the next Frame.
-            silentlyModifyHS $ \st -> st { clockUpdate = True }
+    mfr <- getsHS clock
+    whenJust mfr \fr -> do
+        sendMpg $ Jump (fn fr)
+        silentlyModifyHS $ \st -> st { clockUpdate = True }
 
 
 ------------------------------------------------------------------------
@@ -358,14 +370,11 @@
 -- | Operates on HState and outputs maybe a track to play.
 type PlayOp = State HState (Maybe Int)
 
--- | Play the song under the cursor or random if that one is playing
--- TODO these semantics are strange; maybe playNext instead of random?
-play :: IO ()
-play = runPlayOp do
+-- | Play the song under the cursor or next if that one is current
+playCursor :: IO ()
+playCursor = runPlayOp do
     HState { current, cursor } <- get
-    if current == cursor
-        then playRandomOp
-        else pure $ Just cursor
+    if current == cursor then playNextOp else pure $ Just cursor
 
 -- | Play the song under the cursor (from the start)
 playCur :: IO ()
@@ -389,7 +398,10 @@
 -- If we're at the end, and loop mode is on, then loop to the start
 -- If we're in random mode, play the next random track
 playNext :: IO ()
-playNext = runPlayOp do
+playNext = runPlayOp playNextOp
+
+playNextOp :: PlayOp
+playNextOp = do
     HState { mode, current, size } <- get
     let next = current + 1
     case mode of
@@ -425,6 +437,7 @@
                 , status  = Playing
                 , cursor  = if current == cursor then new else cursor
                 , playHist = Seq.take 36 $ (now, new) Seq.<| playHist
+                , id3     = Nothing
                 }
             pure f
     forM_ mfile $ sendMpg . Load
@@ -466,8 +479,8 @@
 -- a bit of bounded parametric polymorphism so we can abstract over record selectors
 -- in the regex search stuff below
 --
-class Lookup a       where extract :: a -> FilePathP
-instance Lookup Tree.Dir  where extract = dname
+class Lookup a       where extract :: a -> RawFilePath
+instance Lookup Tree.Dir  where extract = takeFileName . dname
 instance Lookup Tree.File where extract = fbase
 
 jumpToMatchFile :: Maybe String -> Bool -> IO ()
@@ -507,41 +520,34 @@
                 i:_ -> (st' { cursor = sel i st }, True)
                 _   -> (st', False)
 
-    unless found $ putmsg (Fast "No match found." defaultSty) *> touchHS
+    unless found $ putMessage $ Fast "No match found." defaultSty
 
 ------------------------------------------------------------------------
 
--- | Show/hide the help window
-toggleHelp :: IO ()
-toggleHelp = modifyHS_ $ \st -> st { helpVisible = not (helpVisible st) }
-
--- | Focus the minibuffer
-toggleFocus :: IO ()
-toggleFocus = modifyHS_ $ \st -> st { miniFocused = not (miniFocused st) }
-
--- | Show/hide the confirm exit modal
-toggleExit :: IO ()
-toggleExit = modifyHS_ $ \st -> st { exitVisible = not (exitVisible st) }
+-- | General modal setting.
+setsModal :: (HState -> Maybe Modal) -> IO ()
+setsModal f = modifyHS_ $ \st -> st { modal = f st }
 
--- | History on or off
-hideHist :: IO ()
-hideHist = modifyHS_ $ \st -> st { histVisible = Nothing }
+-- | Close any open modal.
+closeModal :: IO ()
+closeModal = setsModal $ const Nothing
 
+-- | Show history.
 showHist :: IO ()
 showHist = do
     now <- getMonoTime
-    modifyHS_ $ \st -> st {
-        helpVisible = False,
-        histVisible = Just $ do
-            (tm, ix) <- toList $ playHist st
-            pure (showTimeDiff_ True tm now, (ix, fbase $ music st ! ix))
-        }
+    setsModal \st -> Just $ HistModal [
+        (showTimeDiff_ True tm now, (ix, fbase $ music st ! ix))
+            | (tm, ix) <- toList $ playHist st ]
 
+-- | Focus the minibuffer
+toggleFocus :: IO ()
+toggleFocus = modifyHS_ $ \st -> st { miniFocused = not (miniFocused st) }
+
 -- | Toggle the mode flag
 nextMode :: IO ()
-nextMode = modifyHS_ $ \st -> st { mode = next (mode st) }
-    where
-        next v = if v == maxBound then minBound else succ v
+nextMode = modifyHS_ $ \st -> st { mode = next (mode st) } where
+    next v = if v == maxBound then minBound else succ v
 
 ------------------------------------------------------------------------
 
@@ -598,20 +604,16 @@
     UI.resetui
 
 ------------------------------------------------------------------------
--- Editing the minibuffer
+-- Set the minibuffer
 
--- TODO maybe shouldn't be silent?
-putmsg :: StringA -> IO ()
-putmsg s = silentlyModifyHS $ \st -> st { minibuffer = s }
+putMessage :: StringA -> IO ()
+putMessage s = modifyHS_ \st -> st { minibuffer = s }
 
--- | Modify without triggering a refresh
-clrmsg :: IO ()
-clrmsg = putmsg (Fast P.empty defaultSty)
+clearMessage :: IO ()
+clearMessage = putMessage $ Fast P.empty defaultSty
 
---
 warnA :: String -> IO ()
 warnA x = do
     sty <- getsHS config
-    putmsg $ Fast (P.pack x) (warnings sty)
-    touchHS
+    putMessage $ Fast (P.pack x) (warnings sty)
 
diff --git a/FastIO.hs b/FastIO.hs
deleted file mode 100644
--- a/FastIO.hs
+++ /dev/null
@@ -1,89 +0,0 @@
--- Copyright (c) 2005-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons
--- Copyright (c) 2019-2021, 2025 Galen Huntington
--- SPDX-License-Identifier: GPL-2.0-or-later
-
--- | ByteString versions of some common IO functions
-
-module FastIO where
-
-import Base
-
-import qualified Data.ByteString.Char8 as B
-
-import System.Posix.Files.ByteString
-import System.Posix.Directory.ByteString
-
-------------------------------------------------------------------------
-
---  Use every nth frame.  1 for no dropping.
-dropRate :: Int
-dropRate = 4   -- used to be 10, but computers are faster
-
--- | Packed string version of basename
-basenameP :: ByteString -> ByteString
-basenameP fps = case B.elemIndexEnd '/' fps of
-    Nothing -> fps
-    Just i  -> B.drop (i+1) fps
-{-# INLINE basenameP #-}
-
-dirnameP :: ByteString -> ByteString
-dirnameP fps = case B.elemIndexEnd '/' fps of
-    Nothing -> "."
-    Just i  -> B.take i fps
-{-# INLINE dirnameP #-}
-
--- | Packed version of listDirectory
-packedGetDirectoryContents :: ByteString -> IO [ByteString]
-packedGetDirectoryContents fp = bracket (openDirStream fp) closeDirStream
-    $ \ds -> fmap (filter (\p -> p/="." && p/=".."))
-        $ sequenceWhile (not . B.null) $ repeat $ readDirStream ds
-
-doesFileExist :: ByteString -> IO Bool
-doesFileExist fp = catch @SomeException
-   (not . isDirectory <$> getFileStatus fp)
-   (\_ -> pure False)
-
-doesDirectoryExist :: ByteString -> IO Bool
-doesDirectoryExist fp = catch @SomeException
-   (isDirectory <$> getFileStatus fp)
-   (\_ -> pure False)
-
-packedFileNameEndClean :: ByteString -> ByteString
-packedFileNameEndClean name =
-  case B.unsnoc name of
-    Just (name', ec) | ec == '\\' || ec == '/'
-         -> packedFileNameEndClean name'
-    _    -> name
-
--- ---------------------------------------------------------------------
-
-data FiltHandle = FiltHandle { filtHandle :: !Handle, frameCount :: !(IORef Int) }
-
-newFiltHandle :: Handle -> IO FiltHandle
-newFiltHandle h = FiltHandle h <$> newIORef 0
-
--- | Read a line from a file stream connected to an external prcoess,
--- Returning a ByteString.
-getPacket :: FiltHandle -> IO ByteString
-getPacket (FiltHandle fp _) = B.hGetLine fp
-
--- | Check if it's one of every dropRate packets.
--- We don't need to process all since there are so many.
-checkF :: FiltHandle -> IO Bool
-checkF (FiltHandle _ ir) = do
-  modifyIORef' ir (\x -> (x+1) `mod` dropRate)
-  i <- readIORef ir
-  pure $ dropRate==1 || i==1
-
--- ---------------------------------------------------------------------
-
-isReadable :: ByteString -> IO Bool
-isReadable fp = fileAccess fp True False False
-
------------------------------------------------------------------------- 
-
--- ---------------------------------------------------------------------
-trim :: ByteString -> ByteString
-{-# INLINE trim #-}
-trim = B.dropWhileEnd isSpace . B.dropSpace
-
diff --git a/Keyboard.hs b/Keyboard.hs
new file mode 100644
--- /dev/null
+++ b/Keyboard.hs
@@ -0,0 +1,31 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+-- Copyright (c) 2019, 2023-2026 Galen Huntington
+-- SPDX-License-Identifier: GPL-2.0-or-later
+
+module Keyboard (unkey, charToKey, Key(..)) where
+
+import Base
+
+import qualified Data.Map.Strict as M
+import UI.HSCurses.Curses (Key(..), decodeKey)
+
+------------------------------------------------------------------------
+-- Char ↔ Key translation
+--
+-- ncurses delivers special keys as integer codes ≥ 256; for everything
+-- in 0..255 'decodeKey' returns 'KeyChar (chr n)'.  We keep working in
+-- 'Char' (UI.getKey's type), so we extend the range up to '\500' to
+-- cover the named keys we actually use (KEY_RESIZE is around 410).
+
+deriving stock instance Ord Key
+
+charToKey :: Char -> Key
+charToKey = decodeKey . toEnum . fromEnum
+
+keyCharMap :: M.Map Key Char
+keyCharMap = M.fromList [(charToKey c, c) | c <- ['\0' .. '\500']]
+
+unkey :: Key -> Char
+unkey k = fromMaybe '\0' $ M.lookup k keyCharMap
+
diff --git a/Keymap.hs b/Keymap.hs
--- a/Keymap.hs
+++ b/Keymap.hs
@@ -1,5 +1,3 @@
-{-# OPTIONS -Wno-orphans #-}
-
 -- Copyright (c) 2004-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons
 -- Copyright (c) 2008, 2019-2026 Galen Huntington
 -- SPDX-License-Identifier: GPL-2.0-or-later
@@ -14,17 +12,17 @@
 --
 module Keymap (keyLoop, keyTable, unkey, charToKey) where
 
-import Base hiding ((!?))
+import Base
 
 import Core
-import Config       (package)
-import State        (getsHS, touchHS, modifyHS_, HState(histVisible, searchHist))
-import Style        (defaultSty, StringA(Fast))
+import Config (package)
+import Keyboard (unkey, charToKey, Key(..))
+import State (getsHS, modifyHS_, KeysHelp, Modal(..), HState(..))
+import Style (defaultSty, StringA(Fast))
 import qualified UI (getKey, resetui)
 
-import UI.HSCurses.Curses (Key(..), decodeKey)
-
 import qualified Data.ByteString.Char8 as P
+import qualified Data.ByteString.UTF8 as UTF8
 import qualified Data.Map.Strict as M
 
 
@@ -38,31 +36,43 @@
 -- | Read keys forever and dispatch.  Each round clears the minibuffer
 -- between the keystroke and the action so messages from the previous
 -- action remain visible until the user reacts.
-keyLoop :: IO ()
+keyLoop :: IO Void
 keyLoop = go mainMode where
-    go (KeyMap f) = UI.getKey >>= \c -> clrmsg *> f c >>= go
+    go (KeyMap f) = UI.getKey >>= \c -> clearMessage *> f c >>= go
 
 
 ------------------------------------------------------------------------
 -- Top-level normal mode
 
 mainMode :: KeyMap
-mainMode = KeyMap dispatch where
-    dispatch 'q'  = forcePause *> toggleExit *> touchHS $> confirmQuitMode
-    dispatch c
-        | c `elem` ['/', '?', '\\', '|']
-                               = enterSearch c
-        | c `elem` ['H', ';']  = showHist *> touchHS $> historyMode
-        | c >= '1' && c <= '9' =
+mainMode = KeyMap \c -> getsHS modal >>= \case
+
+    Just ExitModal -> case c of
+        'y' -> shutdown Nothing $> undefined -- shutdown never returns
+        _   -> closeModal $> mainMode
+
+    Just (HistModal hist) -> do
+        for_ (M.lookup c historyKeyMap >>= (hist !?)) (jump . fst . snd)
+        closeModal $> mainMode
+
+    _ -> if
+        | c `elem` ['/', '?', '\\', '|'] -> do
+            toggleFocus
+            hist <- getsHS searchHist
+            searchMode c $ Zipper "" hist []
+        | c == 'q' ->
+            forcePause *> setsModal (const $ Just ExitModal) $> mainMode
+        | c `elem` ['H', ';'] ->
+            showHist $> mainMode
+        | c >= '1' && c <= '9' ->
             jumpRel (0.1 * fromIntegral (fromEnum c - 48)) $> mainMode
-        | True                 = sequence_ (M.lookup c keyMap) $> mainMode
+        | True -> sequence_ (M.lookup c keyMap) $> mainMode
 
-    enterSearch stype = do
-        toggleFocus
-        hist <- getsHS searchHist
-        searchMode stype $ Zipper "" hist []
 
+historyKeyMap :: M.Map Char Int
+historyKeyMap = M.fromList $ zip (['0'..'9'] ++ ['a'..'z']) [0..]
 
+
 ------------------------------------------------------------------------
 -- Search mode
 
@@ -76,7 +86,7 @@
     step z = renderSearch stype z $> KeyMap (`dispatch` z)
 
     dispatch c z
-        | c == '\ESC'      = clrmsg *> touchHS *> leave
+        | c == '\ESC'      = clearMessage *> leave
         | c `elem` enter'  = commit z
         | c `elem` delete' = step $ zipEdit dropLast z
         | k == KeyUp       = step $ zipUp z
@@ -86,7 +96,7 @@
         | otherwise        = step $ zipEdit (++ [c]) z
       where k = charToKey c
 
-    commit (Zipper []  _ _) = clrmsg *> touchHS *> leave
+    commit (Zipper []  _ _) = clearMessage *> leave
     commit (Zipper pat _ _) = do
         let jumpy = if stype `elem` ['/', '?']
                     then jumpToMatchFile else jumpToMatchDir
@@ -104,9 +114,7 @@
     leave = toggleFocus $> mainMode
 
 renderSearch :: Char -> Zipper -> IO ()
-renderSearch prefix z = do
-    putmsg $ Fast (P.pack (prefix : cur z)) defaultSty
-    touchHS
+renderSearch prefix z = putMessage $ Fast (P.pack (prefix : cur z)) defaultSty
 
 dropLast :: [a] -> [a]
 dropLast [] = []
@@ -121,54 +129,6 @@
 zipDown (Zipper c b (pv:rest))  = Zipper pv (c:b) rest
 zipDown z                       = z
 
-
-------------------------------------------------------------------------
--- Song-history popup
-
-historyMode :: KeyMap
-historyMode = KeyMap \c -> do
-    for_ (M.lookup c historyKeys) \k -> do
-        phm <- getsHS histVisible
-        for_ (phm >>= (!? k)) (jump . fst . snd)
-    hideHist
-    touchHS
-    pure mainMode
-  where
-    historyKeys :: M.Map Char Int
-    historyKeys = M.fromList $ zip (['0'..'9'] ++ ['a'..'z']) [0..]
-
-    -- Compatibility: List.!? only added in GHC 9.8
-    xs !? n = listToMaybe $ drop n xs
-
-
-------------------------------------------------------------------------
--- Confirm-quit modal
-
-confirmQuitMode :: KeyMap
-confirmQuitMode = KeyMap \case
-    'y' -> shutdown Nothing $> undefined -- shutdown never returns
-    _   -> toggleExit *> touchHS $> mainMode
-
-
-------------------------------------------------------------------------
--- Char ↔ Key translation
---
--- ncurses delivers special keys as integer codes ≥ 256; for everything
--- in 0..255 'decodeKey' returns 'KeyChar (chr n)'.  We keep working in
--- 'Char' (UI.getKey's type), so we extend the range up to '\500' to
--- cover the named keys we actually use (KEY_RESIZE is around 410).
-
-deriving stock instance Ord Key
-
-charToKey :: Char -> Key
-charToKey = decodeKey . toEnum . fromEnum
-
-keyCharMap :: M.Map Key Char
-keyCharMap = M.fromList [(charToKey c, c) | c <- ['\0' .. '\500']]
-
-unkey :: Key -> Char
-unkey k = fromMaybe '\0' $ M.lookup k keyCharMap
-
 enter', delete' :: [Char]
 enter'  = ['\n', '\r']
 delete' = ['\BS', '\DEL', unkey KeyBackspace]
@@ -177,7 +137,7 @@
 ------------------------------------------------------------------------
 -- The keymap with help descriptions and actions.
 
-keyTable :: [(String, [Char], IO ())]
+keyTable :: [(ByteString, [Char], IO ())]
 keyTable =
     [ ("Move up",                                 ['k',unkey KeyUp],    upOne)
     , ("Move down",                               ['j',unkey KeyDown],  downOne)
@@ -189,7 +149,7 @@
     , ("Seek left within song",                   [unkey KeyLeft],      seekLeft)
     , ("Seek right within song",                  [unkey KeyRight],     seekRight)
     , ("Toggle pause",                            [' '],                pause)
-    , ("Play song under cursor",                  ['\n'],               play)
+    , ("Play from cursor",                        ['\n'],               playCursor)
     , ("Play previous track",                     ['K'],                playPrev)
     , ("Play next track",                         ['J'],                playNext)
     , ("Toggle the help screen",                  ['h'],                toggleHelp)
@@ -209,11 +169,18 @@
     , ("Search backwards for file",               ['?'],                placeholder)
     , ("Search for directory matching regex",     ['\\'],               placeholder)
     , ("Search backwards for directory",          ['|'],                placeholder)
-    , ("Quit " ++ package,                        ['q'],                placeholder)
+    , ("Quit " <> UTF8.fromString package,        ['q'],                placeholder)
     ]
   where placeholder = pure () -- handled separately
 
 -- Compiled dispatch table for normal-mode single-key commands.
 keyMap :: M.Map Char (IO ())
 keyMap = M.fromList [ (c, a) | (_, cs, a) <- keyTable, c <- cs ]
+
+keysHelp :: [KeysHelp]
+keysHelp = [ (keys, desc) | (desc, keys, _) <- keyTable ]
+
+toggleHelp :: IO ()
+toggleHelp = setsModal \st ->
+    if isNothing $ modal st then Just $ HelpModal keysHelp else Nothing
 
diff --git a/Keymap.hs-boot b/Keymap.hs-boot
deleted file mode 100644
--- a/Keymap.hs-boot
+++ /dev/null
@@ -1,10 +0,0 @@
-module Keymap where
-
-import UI.HSCurses.Curses (Key)
-
-keyLoop :: IO ()
-
-keyTable   :: [(String, [Char], IO ())]
-unkey      :: Key -> Char
-charToKey  :: Char -> Key
-
diff --git a/Lexer.hs b/Lexer.hs
--- a/Lexer.hs
+++ b/Lexer.hs
@@ -4,147 +4,111 @@
 
 -- Lexer for mpg123 messages
 
-module Lexer ( parser, doP, doF, doS, doI ) where
+module Lexer ( mpgParser ) where
 
 import Base
-
-import Syntax   (Msg(..),Status(..),Frame(..),Info(..),Id3(..),File(..),Tag(..))
-import FastIO   (FiltHandle(..), checkF, getPacket, trim)
+import Syntax (Msg(..), Status(..), Frame(..), Info(..), Id3(..), Tag(..))
 
 import qualified Data.ByteString.Char8 as P
 import qualified Data.ByteString.UTF8 as UTF8
-import Control.Monad.Except
-import Control.Monad.Trans (lift)
 
 ------------------------------------------------------------------------
 
-readPS :: ByteString -> Int
-readPS = fst . fromJust . P.readInt
+-- | Strip leading and trailing whitespace.
+trim :: ByteString -> ByteString
+trim = P.dropWhileEnd isSpace . P.dropSpace
 
-doP :: ByteString -> Msg
-doP s = S case fst <$> P.uncons s of
-    Just '0' -> Stopped
-    Just '1' -> Paused
-    Just '2' -> Playing
-    -- mpg123 outputs this but then @P 0 causing double Plays
-    -- (I think old mpg123 didn't do @P 0 so I added this)
-    -- '3' -> Stopped  -- used by mpg123 for end of song
-    _ -> Playing
-    -- _ -> error "Invalid Status"
+readPS :: ByteString -> Maybe Int
+readPS = fmap fst . P.readInt
 
+doP :: ByteString -> Maybe Msg
+doP s = do
+    (p, _) <- P.uncons s
+    case p of
+        '0' -> pure $ S Stopped
+        '1' -> pure $ S Paused
+        '2' -> pure $ S Playing
+        -- recent mpg123 outputs 3 for end of song; don't need
+        _   -> Nothing
+
 -- Frame decoding status updates (once per frame).
-doF :: ByteString -> Msg
-doF s = R Frame {
-                currentFrame = readPS f0
-              , framesLeft   = readPS f1
-              , currentTime  = read . P.unpack $ f2
-              , timeLeft     = max 0 . read . P.unpack $ f3
-           }
-        where
-          f0 : f1 : f2 : f3 : _ = P.split ' ' s
+doF :: ByteString -> Maybe Msg
+doF s = do
+    f0 : f1 : f2 : f3 : _ <- pure $ P.split ' ' s
+    currentFrame <- readPS f0
+    framesLeft   <- readPS f1
+    currentTime  <- readMaybe $ P.unpack f2
+    timeLeft     <- max 0 <$> readMaybe (P.unpack f3)
+    pure $ R Frame { currentFrame , framesLeft, currentTime, timeLeft }
 
--- Outputs information about the mp3 file after loading.
-doS :: ByteString -> Msg
-doS s = let fs = P.split ' ' s
-        in I Info {
-            {-
-                  version       = fs !! 0
-                , layer         = read . P.unpack $ fs !! 1
-                , sampleRate    = read . P.unpack $ fs !! 2
-                , playMode      = fs !! 3
-                , modeExtns     = read . P.unpack $ fs !! 4
-                , bytesPerFrame = read . P.unpack $ fs !! 5
-                , channelCount  = read . P.unpack $ fs !! 6
-                , copyrighted   = toEnum (read $ P.unpack (fs !! 7))
-                , checksummed   = toEnum (read $ P.unpack (fs !! 8))
-                , emphasis      = read $ P.unpack $ fs !! 9
-                , bitrate       = read $ P.unpack $ fs !! 10
-                , extension     = read $ P.unpack $ fs !! 11
-            -}
-                userinfo      = mconcat
-                       ["mpeg "
-                       ,fs !! 0
-                       ," "
-                       ,fs !! 10
-                       ,"kbit/s "
-                       ,(P.pack . show) (readPS (fs !! 2) `div` 1000 :: Int)
-                       ,"kHz"]
-                }
+-- Info about mp3 file after loading.
+-- Breakdown from mpg123 README.remote (as numbers):
+--   0 = mpeg type (string)
+--   1 = layer (int)
+--   2 = sampling frequency (int)
+--   3 = mode (string)
+--   4 = mode extension (int)
+--   5 = framesize (int)
+--   6 = stereo (int)
+--   7 = copyright (int)
+--   8 = error protection (int)
+--   9 = emphasis (int)
+--  10 = bitrate (int)
+--  11 = extension (int)
+doS :: ByteString -> Maybe Msg
+doS s = do
+    let fs = P.split ' ' s
+    guard $ length fs >= 11
+    hz <- readPS $ fs !! 2
+    pure $ I $ Info $ mconcat [
+        "mpeg ", fs !! 0, " ", fs !! 10, "kbit/s ",
+            P.pack $ show $ hz `div` 1000, "kHz"]
 
 -- Track info if ID fields are in the file, otherwise file name.
--- 30 chars per field?
-doI :: ByteString -> Msg
-doI s = let f = trim s
-        in case P.take 4 f of
-            cs | cs == "ID3:" -> F . File $
-                    let ttl = toId id3 . splitUp . P.drop 4 $ f
-                    -- mpg123 sometimes returns null titles
-                    in if P.null (id3title ttl) then Left f else Right ttl
-               | otherwise    -> F . File . Left $ f
-    where
-        -- a default
-        id3 :: Id3
-        id3 = Id3 "" "" "" ""
-
-        -- break the ID3 string up
-        splitUp :: ByteString -> [ByteString]
-        splitUp f
-            | f == P.empty  = []
-            | otherwise
-            = let (a,xs) = P.splitAt 30 f   -- we expect it to be 
-                  xs'    = splitUp xs
-              in a : xs'
-
-        -- and some ugly code:
-        toId :: Id3 -> [ByteString] -> Id3
-        toId i ls =
-            let arg n = normalise $ ls !! n
-                j = case length ls of
-                    0   -> i
-
-                    1   -> i { id3title  = arg 0 }
-
-                    2   -> i { id3title  = arg 0
-                             , id3artist = arg 1 }
-
-                    _   -> i { id3title  = arg 0
-                             , id3artist = arg 1
-                             , id3album  = arg 2 }
+doI :: ByteString -> Maybe Msg
+doI s = F <$> do
+    ("ID3:", info) <- pure $ P.splitAt 4 s
+    let id3 = parseId3 info
+    guard $ not $ P.null $ id3title id3 -- title sometimes empty
+    pure id3
 
-            in j { id3str =
-                    mconcat $ intersperse " : " $ filter (not . P.null)
-                        [id3artist j, id3album j, id3title j] }
+-- Format: title (30), author (30), album (30), year (4), comment (30), genre
+-- We currently only use the first three.
+parseId3 :: ByteString -> Id3
+parseId3 = toId . cut where
+    cut f | P.null f = []
+          | True     = let (a, xs) = P.splitAt 30 f in normalise a : cut xs
+    toId ls = Id3 (arg 0) (arg 1) (arg 2) $ mconcat $ intersperse " : "
+        $ filter (not . P.null) [arg 1, arg 2, arg 0]
+      where arg = fromMaybe "" . (ls !?)
 
-        -- strip spaces, and decide if UTF-8 or ISO-8859-1
-        normalise :: ByteString -> ByteString
-        normalise raw =
-            let bs = trim raw
-            in if UTF8.replacement_char `elem` UTF8.toString bs
-                then UTF8.fromString $ P.unpack bs
-                else bs
+-- | Strip spaces, and if seeming ISO-8859-1 convert to UTF-8
+normalise :: ByteString -> ByteString
+normalise raw =
+    let bs = trim raw
+    in if UTF8.replacement_char `elem` UTF8.toString bs
+        then UTF8.fromString $ P.unpack bs
+        else bs
 
 ------------------------------------------------------------------------
 
-parser :: FiltHandle -> IO (Either (Maybe String) Msg)
-parser h = runExceptT do
-    x <- lift $ getPacket h
+-- Parse line; on failure, return Just only if error to report.
+mpgParser :: ByteString -> Either (Maybe String) Msg
+mpgParser line = do
     -- bad packets are generally just \n in ID3 (and not of interest anyway)
-    let skip = throwError Nothing
+    let quiet = maybe (Left Nothing) pure
 
-    when (P.length x < 3) skip
-    let (pre, m) = P.splitAt 3 x
-        at : code : sp : _ = P.unpack pre
-    when (at /= '@' || sp /= ' ') skip
+    code <- quiet do
+        '@' : c : ' ' : _ <- pure $ P.unpack line
+        pure c
 
-    -- TODO: make doX functions total
+    let m = P.drop 3 line
     case code of
         'R' -> pure $ T Tag
-        'I' -> pure $ doI m
-        'S' -> pure $ doS m
-        'F' -> do
-            b <- lift $ checkF h
-            if b then pure $ doF m else skip
-        'P' -> pure $ doP m
-        'E' -> throwError $ Just $ "mpg123 error: " ++ P.unpack m
-        _   -> skip
+        'I' -> quiet $ doI m
+        'S' -> quiet $ doS m
+        'F' -> quiet $ doF m
+        'P' -> quiet $ doP m
+        'E' -> Left $ Just $ P.unpack m
+        _   -> quiet Nothing
 
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -20,14 +20,17 @@
 regeneration of a `configure` file (now gone).
 
 *  The code has been updated to compile under recent GHC (tested
-through 9.10) and libraries.  This required rewriting or entirely
-replacing large sections, mainly low-level optimizations.
+through 9.14; minimum supported 9.0) and libraries.  This required
+rewriting or entirely replacing large sections, mainly low-level
+optimizations.
 
 *  I added support for building with Stack.  It can also be installed
 with Nix from nixpkgs (`haskellPackages.hmp3-ng`).
 
 *  There is a public GitHub issue tracker, and a GitHub action to
 continuously test builds.
+
+*  There is a test suite built on the Tasty framework.
 
 *  I try to avoid “Not Invented Here” by using established,
 up-to-date packages from Hackage.  Much old code has now been
diff --git a/State.hs b/State.hs
--- a/State.hs
+++ b/State.hs
@@ -9,119 +9,80 @@
 
 import Base
 
-import FastIO (FiltHandle(..))
-import Syntax                   (Status(Stopped), Mode(..), Frame, Info, Id3, Pretty(ppr))
+import Syntax                   (Status, Mode, Frame, Info, Id3, Pretty(ppr))
 import Tree                     (FileArray, DirArray)
-import Style                    (StringA(Fast), defaultSty, UIStyle)
-import qualified Config (defaultStyle)
+import Style                    (StringA, UIStyle)
 
-import Text.Regex.PCRE.Light    (Regex)
-import Data.Array               (listArray)
 import Data.ByteString          (hPut)
 import Data.Sequence            (Seq)
 import System.Clock             (TimeSpec(..))
 import System.IO                (hFlush)
 import System.Process           (ProcessHandle)
-import System.Random
+import System.Random            (StdGen)
+import Text.Regex.PCRE.Light    (Regex)
 
 
--- | The editor state type
-data HState = HState {
-        music           :: !FileArray
-       ,folders         :: !DirArray
-       ,size            :: !Int                  -- cache size of list
-       ,current         :: !Int                  -- currently playing mp3
-       ,cursor          :: !Int                  -- mp3 under the cursor
-       ,clock           :: !(Maybe Frame)        -- current clock value
-       ,clockUpdate     :: !Bool
-       ,randomGen       :: !StdGen               -- random seed
-       ,mpgPid          :: !(Maybe ProcessHandle) -- pid of decoder
-       ,spawns          :: !Integer              -- count of decoder spawns
-       ,threads         :: ![ThreadId]           -- all our threads
-       ,id3             :: !(Maybe Id3)          -- maybe mp3 id3 info
-       ,info            :: !(Maybe Info)         -- mp3 info
-       ,status          :: !Status
-       ,minibuffer      :: !StringA              -- contents of minibuffer
-       ,helpVisible     :: !Bool                 -- is the help window shown?
-       ,histVisible     :: !(Maybe [(ByteString, (Int, ByteString))]) -- history pop-up if shown
-       ,exitVisible     :: !Bool                 -- confirm exit modal shown
-       ,miniFocused     :: !Bool                 -- is the mini buffer focused?
-       ,mode            :: !Mode
-       ,uptime          :: !ByteString
-       ,boottime        :: !TimeSpec
-       ,regex           :: !(Maybe (Regex,Bool)) -- most recent search pattern and direction
-       ,searchHist      :: ![String]             -- history of searches
-       ,xterm           :: !Bool
-       ,doNotResuscitate :: !Bool                -- should we just let mpg123 die?
-       ,playHist        :: !(Seq (TimeSpec, Int)) -- limited history of songs played
-       ,config          :: !UIStyle             -- config values
-       ,configPath      :: !(Maybe FilePath)     -- style.conf override (CLI)
-
-       ,modified        :: !(MVar ())           -- Set when redrawable components of 
-                                                -- the state are modified. The ui
-                                                -- refresh thread waits on this.
-       ,drawLock        :: !(MVar ())           -- simple semaphore for display
+-- | Player state
+data HState = HState
+    -- These never change
+    { music           :: !FileArray
+    , folders         :: !DirArray
+    , size            :: !Int                  -- cache size of list
+    , bootTime        :: !TimeSpec
+    , configPath      :: !(Maybe FilePath)     -- style.conf override (CLI)
+    -- These can
+    , current         :: !Int                  -- currently playing mp3
+    , cursor          :: !Int                  -- mp3 under the cursor
+    , clock           :: !(Maybe Frame)        -- current clock value
+    , clockUpdate     :: !Bool
+    , randomGen       :: !StdGen               -- random seed
+    , mpgPid          :: !(Maybe ProcessHandle) -- pid of decoder
+    , spawns          :: !Integer              -- count of decoder spawns
+    , threads         :: ![ThreadId]           -- all our threads
+    , id3             :: !(Maybe Id3)          -- maybe mp3 id3 info
+    , info            :: !(Maybe Info)         -- mp3 info
+    , status          :: !Status
+    , minibuffer      :: !StringA              -- contents of minibuffer
+    , modal           :: !(Maybe Modal)        -- modal visible
+    , miniFocused     :: !Bool                 -- is the mini buffer focused?
+    , mode            :: !Mode
+    , uptime          :: !ByteString
+    , regex           :: !(Maybe (Regex,Bool)) -- most recent search pattern and direction
+    , searchHist      :: ![String]
+    , exiting         :: !Bool                 -- let mpg123 die?
+    , playHist        :: !(Seq (TimeSpec, Int))
+    , config          :: !UIStyle
     }
 
-------------------------------------------------------------------------
---
--- | The initial state
---
-newEmptyHS :: IO HState
-newEmptyHS = do
-    modified  <- newEmptyMVar
-    drawLock  <- newMVar ()
-    randomGen <- newStdGen
-    pure HState {
-        music        = listArray (0,0) []
-       ,folders      = listArray (0,0) []
-
-       ,size         = 0
-       ,current      = 0
-       ,cursor       = 0
-
-       ,threads      = []
-       ,modified
-
-       ,mpgPid       = Nothing
-       ,spawns       = 0
-       ,clock        = Nothing
-       ,info         = Nothing
-       ,id3          = Nothing
-       ,regex        = Nothing
-       ,searchHist   = []
+-- Each is (timestamp-string, (song-index, song-name)).
+type HistDisplay = [(ByteString, (Int, ByteString))]
 
-       ,clockUpdate      = False
-       ,helpVisible      = False
-       ,histVisible      = Nothing
-       ,exitVisible      = False
-       ,miniFocused      = False
-       ,xterm            = False
-       ,doNotResuscitate = False    -- mpg123 should be restarted
+-- (list-of-keys, description)
+type KeysHelp = ([Char], ByteString)
 
-       ,randomGen
-       ,playHist     = mempty
-       ,config       = Config.defaultStyle
-       ,configPath   = Nothing
-       ,boottime     = 0
-       ,status       = Stopped
-       ,mode         = minBound
-       ,minibuffer   = Fast mempty defaultSty
-       ,uptime       = mempty
-       ,drawLock
-    }
+data Modal = HelpModal ![KeysHelp] | ExitModal | HistModal !HistDisplay
 
---
 -- | A global variable holding the state.
---
 hState :: MVar HState
-hState = unsafePerformIO $ newMVar =<< newEmptyHS
+hState = unsafePerformIO newEmptyMVar
 {-# NOINLINE hState #-}
 
+-- | The refresh thread waits on this
+modified :: MVar ()
+modified = unsafePerformIO newEmptyMVar
+{-# NOINLINE modified #-}
+
+-- | Queues a refresh.
+setModified :: IO ()
+setModified = void $ tryPutMVar modified ()
+
+------------------------------------------------------------------------
+-- The decoder.
+
 data Mpg = Mpg
     { writeh :: !Handle
-    , readf  :: !FiltHandle
-    , errh   :: !FiltHandle
+    , readh  :: !Handle
+    , errh   :: !Handle
     }
 
 mpg :: MVar Mpg
@@ -139,28 +100,14 @@
 getsHS :: (HState -> a) -> IO a
 getsHS f = f <$> readMVar hState
 
--- | Modify the state with a pure function
+-- | Modify the state with a pure function and no refresh
 silentlyModifyHS :: (HState -> HState) -> IO ()
 silentlyModifyHS  f = modifyMVar_ hState (pure . f)
 
 modifyHS_ :: (HState -> HState) -> IO ()
-modifyHS_ f = silentlyModifyHS f <* touchHS
+modifyHS_ f = silentlyModifyHS f <* setModified
 
 -- | Modify the state returning a value
 modifyHS :: (HState -> (HState, a)) -> IO a
-modifyHS f = modifyMVar hState (pure . f) <* touchHS
-
--- | Trigger a refresh. This is the only way to update the screen.
-touchHS :: IO ()
-touchHS = withMVar hState \st -> void $ tryPutMVar (modified st) ()
-
-forceNextPacket :: IO ()
-forceNextPacket = do
-  fh <- readf <$> readMVar mpg
-  writeIORef (frameCount fh) 0
-
-withDrawLock :: IO () -> IO ()
-withDrawLock io = do
-    lock <- getsHS drawLock
-    withMVar lock $ const io
+modifyHS f = modifyMVar hState (pure . f) <* setModified
 
diff --git a/Style.hs b/Style.hs
--- a/Style.hs
+++ b/Style.hs
@@ -10,7 +10,7 @@
 
 import Base
 import qualified UI.HSCurses.Curses as Curses
-import qualified Data.Map as M  (fromList, empty, lookup, Map)
+import qualified Data.Map as M
 
 ------------------------------------------------------------------------
 
diff --git a/Syntax.hs b/Syntax.hs
--- a/Syntax.hs
+++ b/Syntax.hs
@@ -52,10 +52,6 @@
 data Tag = Tag
     deriving stock (Eq, Show)
 
--- Track info if ID fields are in the file, otherwise file name.
-newtype File = File (Either ByteString Id3)
-    deriving stock (Eq, Show)
-
 -- ID3 info
 data Id3 = Id3
         { id3title  :: !ByteString
@@ -69,47 +65,13 @@
 --      , genre  :: Maybe ByteString }
 
 
-
--- Outputs information about the mp3 file after loading.
--- <a>: version of the mp3 file. Currently always 1.0 with madlib, but don't 
---      depend on it, particularly if you intend portability to mpg123 as well.
---      Float/string.
--- <b>: layer: 1, 2, or 3. Integer.
--- <c>: Samplerate. Integer.
--- <d>: Mode string. String.
--- <e>: Mode extension. Integer.
--- <f>: Bytes per frame (estimate, particularly if the stream is VBR). Integer.
--- <g>: Number of channels (1 or 2, usually). Integer.
--- <h>: Is stream copyrighted? (1 or 0). Integer.
--- <i>: Is stream CRC protected? (1 or 0). Integer.
--- <j>: Emphasis. Integer.
--- <k>: Bitrate, in kbps. (i.e., 128.) Integer.
--- <l>: Extension. Integer.
-newtype Info = Info {
-                userinfo      :: ByteString  -- user friendly string
-           --   version       :: !ByteString,
-           --   layer         :: !Int,     -- 1,2 or 3
-           --   sampleRate    :: !Int,
-           --   playMode      :: !ByteString,
-           --   modeExtns     :: !Int,
-           --   bytesPerFrame :: !Int,
-           --   channelCount  :: !Int,
-           --   copyrighted   :: !Bool,
-           --   checksummed   :: !Bool,
-           --   emphasis      :: !Int,
-           --   bitrate       :: !Int,
-           --   extension     :: !Int
-            }
+-- mp3 file info; TODO maybe don't need this newtype at all?
+newtype Info = Info { userinfo :: ByteString }
     deriving stock (Eq, Show)
 
--- @F <current-frame> <frames-remaining> <current-time> <time-remaining>
 -- Frame decoding status updates (once per frame).
 -- Current-frame and frames-remaining are integers; current-time and
 -- time-remaining floating point numbers with two decimal places.
---
--- Only 1 frame a second is actually read, so make sure it's lazy so
--- there's no need to evaluate all the others. 
--- 
 data Frame = Frame {
                 currentFrame   :: !Int,
                 framesLeft     :: !Int,
@@ -118,14 +80,8 @@
              }
     deriving stock (Eq, Show)
 
--- @P {0, 1, 2}
 -- Stop/pause status.
--- 0 - playing has stopped. When 'STOP' is entered, or the mp3 file is finished.
--- 1 - Playing is paused. Enter 'PAUSE' or 'P' to continue.
--- 2 - Playing has begun again.
-data Status = Stopped
-            | Paused
-            | Playing
+data Status = Stopped | Paused | Playing
     deriving stock (Eq, Show)
 
 data Mode = Once | Loop | Random | Single
@@ -143,8 +99,9 @@
 -- And a wrapper type 
 --
 data Msg = T {-# UNPACK #-} !Tag
-         | F                !File
+         | F                !Id3
          | I {-# UNPACK #-} !Info
          | R {-# UNPACK #-} !Frame
          | S                !Status
     deriving stock (Eq, Show)
+
diff --git a/Tree.hs b/Tree.hs
--- a/Tree.hs
+++ b/Tree.hs
@@ -6,20 +6,19 @@
 -- functions for manipulating file trees
 --
 
-module Tree where
+module Tree (module Tree, RawFilePath) where
 
-import Base hiding (partition)
+import Base
 
-import FastIO
 import qualified Data.ByteString.Char8 as P
 import qualified Data.Map.Strict as M
 
 import Data.Array
-import System.IO        (hPrint, stderr)
+import System.Posix.FilePath
+import System.Posix.Files.ByteString (getFileStatus, isDirectory, fileAccess)
+import System.Posix.Directory.Traversals (getDirectoryContents)
 
 
-type FilePathP = ByteString
-
 -- | A filesystem hierarchy is flattened to just the end nodes
 type DirArray = Array Int Dir
 
@@ -29,14 +28,14 @@
 -- | A directory entry is the directory name, and a list of bound
 -- indicies into the Files array.
 data Dir  =
-    Dir { dname :: !FilePathP        -- ^ directory name
+    Dir { dname :: !RawFilePath        -- ^ directory name
         , dsize :: !Int              -- ^ number of file entries
         , dlo   :: !Int              -- ^ index of first entry
         , dhi   :: !Int }            -- ^ index of last entry
 
 -- Most data is allocated in this structure
 data File =
-    File { fbase :: !FilePathP      -- ^ basename of file
+    File { fbase :: !RawFilePath      -- ^ basename of file
          , fdir  :: !Int }          -- ^ index of Dir entry 
 
 data Tree = Tree !DirArray !FileArray
@@ -44,9 +43,11 @@
 --
 -- | Given the start directories, populate the dirs and files arrays
 --
-buildTree :: [FilePathP] -> IO Tree
+buildTree :: [RawFilePath] -> IO Tree
 buildTree fs = do
-    (os, dirs) <- partition fs    -- note we will lose the ordering of files given on cmd line.
+    -- note we will lose the ordering of files given on cmd line.
+    (os, dirs) <- catch @SomeException (sift fs)
+        \e -> print e *> exitWith (ExitFailure 1)
 
     let loop []     = pure []
         loop (a:xs) = do
@@ -70,67 +71,65 @@
 isEmpty (Tree _ files) = null files
 
 -- | Create nodes based on dirname for orphan files on cmdline
-doOrphans :: [FilePathP] -> [(FilePathP, [FilePathP])]
-doOrphans = map \f -> (dirnameP f, [basenameP f])
+doOrphans :: [RawFilePath] -> [(RawFilePath, [RawFilePath])]
+doOrphans = map \f -> (takeDirectory f, [takeFileName f])
 
 -- | Merge entries with the same root node into a single node
-merge :: [(FilePathP, [FilePathP])] -> [(FilePathP, [FilePathP])]
+merge :: [(RawFilePath, [RawFilePath])] -> [(RawFilePath, [RawFilePath])]
 merge = M.assocs . M.fromListWith (flip (++))
 
 -- | fold builder, for generating Dirs and Files
-make :: (Int,Int,[Dir],[File]) -> (FilePathP,[FilePathP]) -> (Int,Int,[Dir],[File])
+make :: (Int,Int,[Dir],[File]) -> (RawFilePath,[RawFilePath]) -> (Int,Int,[Dir],[File])
 make (i,n,acc1,acc2) (d,fs) =
     let (dir, n') = listToDir n d fs
         fs'= map makeFile fs
     in (i+1, n', dir:acc1, reverse fs' ++ acc2)
   where
-    makeFile f = File (basenameP f) i
+    makeFile f = File (takeFileName f) i
 
 ------------------------------------------------------------------------
 
--- | Expand a single directory into a maybe a  pair of the dir name and any files
+-- | Expand a single directory into a maybe a pair of the dir name and any files
 -- Return any extra directories to search in
 --
 -- Assumes no evil sym links
 --
-expandDir :: FilePathP -> IO (Maybe (FilePathP, [FilePathP]),  [FilePathP])
+expandDir :: RawFilePath -> IO (Maybe (RawFilePath, [RawFilePath]),  [RawFilePath])
 expandDir !f = do
-    ls_raw <- handle @SomeException (\e -> hPrint stderr e $> [])
-                $ packedGetDirectoryContents f
-    let ls = (map \s -> P.intercalate (P.singleton '/') [f,s])
-                . sort . filter validFiles $ ls_raw
-    (fs',ds) <- partition ls
-    let fs = filter onlyMp3s fs'
-        v = if null fs then Nothing else Just (f,fs)
-    pure (v,ds)
+    ls <- map (f </>) . sort . filter notHidden . map snd
+        <$> getDirectoryContents f
+    (fs', ds) <- sift ls
+    let fs = filter isMp3 fs'
+        v = guard (not $ null fs) *> Just (f, fs)
+    pure (v, ds)
   where
-    validFiles = not . P.isPrefixOf "."
-    onlyMp3s   = P.isSuffixOf ".mp3" . P.map toLower
+    notHidden = not . P.isPrefixOf "."
+    isMp3     = (== ".mp3") . P.map toLower . takeExtension
 
---
--- | Given an the next index into the files array, a directory name, and
+-- | Given an index into the files array, a directory name, and
 -- a list of files in that dir, build a Dir and return the next index
 -- into the array
---
-listToDir :: Int -> FilePathP -> [FilePathP] -> (Dir, Int)
-listToDir n d fs =
-        let dir = Dir { dname = packedFileNameEndClean d
-                      , dsize = len
-                      , dlo   = n
-                      , dhi   = n + len - 1
-                      } in (dir, n')
-    where
-        len = length fs
-        n'  = n + len
+listToDir :: Int -> RawFilePath -> [RawFilePath] -> (Dir, Int)
+listToDir n d fs = (dir, n') where
+    dir = Dir
+        { dname = dropTrailingPathSeparator d
+        , dsize = len
+        , dlo   = n
+        , dhi   = n + len - 1
+        }
+    len = length fs
+    n'  = n + len
 
--- | break a list of file paths into a pair of sublists corresponding
--- to the paths that point to files and to directories.
-partition :: [FilePathP] -> IO ([FilePathP], [FilePathP])
-partition [] = pure ([],[])
-partition (a:xs) = do
-    (fs,ds) <- partition xs
-    x <- doesFileExist a
-    if x then do y <- isReadable a
-                 pure if y then (a:fs, ds) else (fs, ds)
-         else pure (fs, a:ds)
+-- | Break a pair of sublists of files and directories, filtering
+-- out ones without permission.
+sift :: [RawFilePath] -> IO ([RawFilePath], [RawFilePath])
+sift []     = pure ([], [])
+sift (p:ps) = do
+    it@(fs,ds) <- sift ps
+    isDir <- isDirectory <$> getFileStatus p
+    perm <- fileAccess p True False isDir
+    pure if
+        | not perm -> it
+        | isDir    -> (fs, p:ds)
+        | True     -> (p:fs, ds)
 
diff --git a/UI.hs b/UI.hs
--- a/UI.hs
+++ b/UI.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE ForeignFunctionInterface, TupleSections, AllowAmbiguousTypes #-}
-
 -- Copyright (c) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons
 -- Copyright (c) 2019-2026 Galen Huntington
 -- SPDX-License-Identifier: GPL-2.0-or-later
@@ -15,7 +13,7 @@
 module UI (
     runDraw,
     -- * Construction, destruction
-    start, end, suspend, screenSize, refresh, refreshClock, resetui,
+    start, end, screenSize, refresh, refreshClock, resetui,
     -- * Input
     getKey
   ) where
@@ -23,19 +21,19 @@
 import Base
 
 import Style
-import FastIO                   (basenameP)
 import Tree                     (File(fdir, fbase), Dir(dname))
 import State
 import Syntax
 import Config
 import Width                    (displayWidth, toMaxWidth, toWidth)
 import qualified UI.HSCurses.Curses as Curses
-import {-# SOURCE #-} Keymap    (keyTable, unkey, charToKey)
+import Keyboard                 (unkey, charToKey)
 
 import Data.Array               ((!), bounds, Array)
 import Data.Array.Base          (unsafeAt)
+import System.Posix.FilePath    (takeFileName)
 import System.IO                (stderr, hFlush)
-import System.Posix.Signals     (raiseSignal, sigTSTP, installHandler, Handler(..))
+import System.Posix.Signals     (installHandler, Handler(..))
 
 import Foreign.C.String
 import Foreign.C.Types
@@ -52,26 +50,22 @@
 
 
 newtype Draw = Draw (IO ())
-instance Semigroup Draw where Draw x <> Draw y = Draw $ x >> y
-instance Monoid Draw where mempty = Draw $ pure ()
+    deriving newtype (Semigroup, Monoid)
 
+drawLock :: MVar ()
+drawLock = unsafePerformIO $ newMVar ()
+{-# NOINLINE drawLock #-}
+
 runDraw :: Draw -> IO ()
-runDraw (Draw d) = withDrawLock d
+runDraw (Draw io) = withMVar drawLock $ const io
 
 ------------------------------------------------------------------------
 
 -- | Initialize the UI
 start :: IO UIStyle
 start = do
-    discardErrors do
-        thisterm <- lookupEnv "TERM"
-        case thisterm of 
-            Just "vt220" -> setEnv "TERM" "xterm-color"
-            Just t | "xterm" `isPrefixOf` t 
-                   -> silentlyModifyHS $ \st -> st { xterm = True }
-            _ -> pure ()
-
     Curses.initCurses
+
     case Curses.cursesSigWinch of
         Just wch -> void $ installHandler wch (Catch resetui) Nothing
         _        -> pure () -- handled elsewhere
@@ -93,23 +87,14 @@
 nocursor :: Draw
 nocursor = Draw $ discardErrors $ void $ Curses.cursSet Curses.CursorInvisible
 
---
--- | Clean up and go home. Refresh is needed on linux. grr.
---
-end :: Bool -> IO ()
-end isXterm = withDrawLock do
-    when isXterm $ setXtermTitle ["xterm"]
+-- | Clean up and go home.
+end :: IO ()
+end = do
+    takeMVar drawLock        -- we keep so no one tries to draw
+    setXtermTitle ["xterm"]  -- XXX I don't see this title after exit?
     Curses.endWin
 
---
--- | Suspend the program
---
-suspend :: IO ()
-suspend = raiseSignal sigTSTP
-
---
 -- | Find the current screen height and width.
---
 screenSize :: IO (Int, Int)
 screenSize = Curses.scrSize
 
@@ -172,6 +157,7 @@
 data Pos  = Pos  { posY, _posX :: !Int }
 data Size = Size { _sizeH, sizeW :: !Int }
 
+-- | Renderable widgets are functions @DrawData -> ...@.
 data DrawData = DD {
     drawSize  :: Size,
     drawPos   :: Pos,
@@ -179,452 +165,364 @@
     drawFrame :: Maybe Frame
     }
 
---
--- | A class for renderable objects, given the application state, and
--- for printing the object as a list of strings
---
-class Element a where draw :: DrawData -> a
-
---
--- | The elements of the play mode widget
---
-data PlayScreen = PlayScreen !PPlaying !ProgressBar !PTimes 
-
--- | How does this all work? Firstly, we mostly want to draw fast strings
--- directly to the screen. To break the drawing problem down, you need
--- to write an instance of Element for each element in the ui. Larger
--- and larger elements then combine these items together. 
---
--- Obviously to write the element instance, you need a new type for each
--- element, to disinguish them. As follows:
-
-newtype PlayList = PlayList [StringA]
-
-newtype PPlaying    = PPlaying    StringA
-newtype PVersion    = PVersion    ByteString
-newtype PMode       = PMode       String
-newtype PMode2      = PMode2      String
-newtype ProgressBar = ProgressBar StringA
-newtype PTimes      = PTimes      StringA
-
-newtype PInfo       = PInfo       ByteString
-newtype PId3        = PId3        ByteString
-newtype PTime       = PTime       ByteString
-
-newtype PlayTitle = PlayTitle StringA
-newtype PlayInfo  = PlayInfo  ByteString
-newtype PlayModes = PlayModes String
-
-data HelpModal
-data HistModal
-data ExitModal
-class ModalElement a where
-    -- takes style, window width, state; returns (width, list of lines)
-    drawModal :: Style -> Int -> HState -> Maybe (Int, [StringA])
-
-------------------------------------------------------------------------
-
-instance Element PlayScreen where
-    draw dd = PlayScreen (draw dd) (draw dd) (draw dd)
-
--- | Decode the play screen
-printPlayScreen :: PlayScreen -> [StringA]
-printPlayScreen (PlayScreen (PPlaying a) 
-                            (ProgressBar b) 
-                            (PTimes c)) = [a , b , c]
+-- screen width -> (modal width, list of lines)
+type ModalMaker = Int -> (Int, [ByteString])
 
 ------------------------------------------------------------------------
 
-instance (Element a, Element b) => Element (a, b) where
-    draw dd = (draw dd, draw dd)
+-- | The three lines of the play-mode widget.
+playScreen :: DrawData -> [StringA]
+playScreen dd = [pPlaying dd, progressBar dd, pTimes dd]
 
 ------------------------------------------------------------------------
 
--- Info about the current track
-instance Element PPlaying where
-    draw dd =
-        PPlaying . FancyS $ map (, defaultSty) $ "  " : line
-      where
-        x       = sizeW $ drawSize dd
-        PId3 a  = draw dd
-        PInfo b = draw dd
-        line | gap >= 0 = a : spaces gap : right
-             | True     = toMaxWidth lim a : right
-            where lim = x - 5 - (if showId3 then P.length b else -1)
-                  gap = lim - displayWidth a
-                  showId3 = x > 59
-                  right = if showId3 then [" ", b] else []
+-- | Info about the current track
+pPlaying :: DrawData -> StringA
+pPlaying dd = FancyS $ map (, defaultSty) $ "  " : line where
+    x = sizeW $ drawSize dd
+    a = pId3 dd
+    b = pInfo dd
+    line | gap >= 0 = a : spaces gap : right
+         | True     = toMaxWidth lim a : right
+        where lim = x - 5 - (if showId3 then P.length b else -1)
+              gap = lim - displayWidth a
+              showId3 = x > 59
+              right = if showId3 then [" ", b] else []
 
--- | Id3 Info
-instance Element PId3 where
-    draw DD{drawState=st} = case id3 st of
-        Just i  -> PId3 $ id3str i
-        Nothing -> PId3 $ case size st of
-                                0 -> "(empty)"
-                                _ -> fbase $ music st ! current st
+-- | Id3 info
+pId3 :: DrawData -> ByteString
+pId3 DD{drawState=st} = case id3 st of
+    Just i  -> id3str i
+    Nothing -> case size st of
+        0 -> "(empty)"
+        _ -> fbase $ music st ! current st
 
 -- | mp3 information
-instance Element PInfo where
-    draw DD{drawState=st} = PInfo case info st of
-        Nothing  -> "(empty)"
-        Just i   -> userinfo i
+pInfo :: DrawData -> ByteString
+pInfo DD{drawState=st} = case info st of
+    Nothing -> "(empty)"
+    Just i  -> userinfo i
 
-modalWidth :: Int -> Int
-modalWidth w = max (min w 3) $ round $ fromIntegral w * (0.8::Float)
+commonModalWidth :: Int -> Int
+commonModalWidth w = max (min w 3) $ round $ fromIntegral w * (0.8::Float)
 
 ------------------------------------------------------------------------
 
--- instance ModalElement me => Element (Modal me) where draw = drawModal
-
-instance ModalElement HelpModal where
-    drawModal sty swd st = do
-        guard $ helpVisible st
-        pure (wd, [ Fast (f cs h) sty | (h, cs, _) <- keyTable ])
-      where
-        wd = modalWidth swd
-        f :: [Char] -> String -> ByteString
-        f cs ps = toWidth wd $ toWidth clen cmds <> u ps where
-            clen = max 4 $ round $ fromIntegral wd * (0.2::Float)
-            cmds = P.unwords ("" : map pprIt cs)
-            pprIt c = case c of
-                '\n' -> "Enter"
-                '\f' -> "^L"
-                '\\' -> "\\"
-                ' '  -> "Space"
-                _ -> case charToKey c of
-                    Curses.KeyUp        -> u"↑"
-                    Curses.KeyDown      -> u"↓"
-                    Curses.KeyPPage     -> "PgUp"
-                    Curses.KeyNPage     -> "PgDn"
-                    Curses.KeyLeft      -> u"←"
-                    Curses.KeyRight     -> u"→"
-                    Curses.KeyEnd       -> "End"
-                    Curses.KeyHome      -> "Home"
-                    Curses.KeyBackspace -> "Backspace"
-                    _ -> u[c]
+helpModal :: [KeysHelp] -> ModalMaker
+helpModal help swd = (wd, map showLine help) where
+    wd = commonModalWidth swd
+    showLine :: ([Char], ByteString) -> ByteString
+    showLine (cs, ps) = toWidth clen cmds <> ps where
+        clen = max 4 $ round $ fromIntegral wd * (0.2::Float)
+        cmds = P.unwords ("" : map pprIt cs)
+        pprIt c = case c of
+            '\n' -> "Enter"
+            '\f' -> "^L"
+            '\\' -> "\\"
+            ' '  -> "Space"
+            _ -> case charToKey c of
+                Curses.KeyUp        -> u"↑"
+                Curses.KeyDown      -> u"↓"
+                Curses.KeyPPage     -> "PgUp"
+                Curses.KeyNPage     -> "PgDn"
+                Curses.KeyLeft      -> u"←"
+                Curses.KeyRight     -> u"→"
+                Curses.KeyEnd       -> "End"
+                Curses.KeyHome      -> "Home"
+                Curses.KeyBackspace -> "Backspace"
+                _ -> u[c]
 
 ------------------------------------------------------------------------
 
-instance ModalElement HistModal where
-    drawModal sty swd st = flip fmap (histVisible st) \hist -> do
-        let wd = modalWidth swd
-            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))) ->
-            let tstr = toMaxWidth tlen $ P.replicate (tlen - displayWidth time) ' ' <> time
-            in Fast (toWidth wd $ " " <> P.singleton c <> " " <> tstr <> " " <> song) sty
+histModal :: HistDisplay -> ModalMaker
+histModal hist swd = do
+    let wd = commonModalWidth swd
+        mtlen = maximum $ 0 : map (displayWidth . fst) hist
+        tlen = min (mtlen + 1) $ wd `div` 3
+    (wd,) $ flip map (zip (['0'..'9']++['a'..'z']) hist) \ (c, (time, (_, song))) ->
+        let tstr = toMaxWidth tlen $ P.replicate (tlen - displayWidth time) ' ' <> time
+        in mconcat [" ", P.singleton c, " ", tstr, " ", song]
 
 ------------------------------------------------------------------------
 
-instance ModalElement ExitModal where
-    drawModal sty swd st = do
-        guard $ exitVisible st
-        let wd = modalWidth swd `min` 19
-            blank = Fast (toWidth wd "") sty
-            padl = P.replicate ((wd - 9) `div` 2) ' '
-            msg = toWidth wd $ padl <> "Exit (y)?"
-        pure (wd, [blank, Fast msg sty, blank])
+exitModal :: ModalMaker
+exitModal swd = (wd, ["", padl <> "Exit (y)?", ""]) where
+    wd = commonModalWidth swd `min` 19
+    padl = P.replicate ((wd - 9) `div` 2) ' '
 
 ------------------------------------------------------------------------
 
 -- | The time used and time left
-instance Element PTimes where
-    draw DD { drawFrame=Just Frame {..}, drawSize=Size{sizeW=x} } =
-        PTimes $ FancyS $ map (, defaultSty)
-            if x - 4 < P.length elapsed
-            then [" "]
-            else ["  ", elapsed]
-                    ++ (guard (distance > 0) *> [gap, remaining])
-      where
-        elapsed   = P.pack $ printf "%d:%02d" l_m l_s
-        remaining = P.pack $ printf "-%d:%02d" r_m r_s
-        (l_m,l_s) = toMS currentTime
-        (r_m,r_s) = toMS timeLeft
-        gap       = spaces distance
-        distance  = x - 4 - P.length elapsed - P.length remaining
-        toMS :: RealFrac a => a -> (Int, Int)
-        toMS = flip quotRem 60 . floor
-    draw _ = PTimes $ Fast (spaces 5) defaultSty
+pTimes :: DrawData -> StringA
+pTimes DD { drawFrame=Just Frame {..}, drawSize=Size{sizeW=x} } =
+    FancyS $ map (, defaultSty)
+        if x - 4 < P.length elapsed
+        then [" "]
+        else ["  ", elapsed]
+                ++ (guard (distance > 0) *> [gap, remaining])
+  where
+    elapsed   = P.pack $ printf "%d:%02d" l_m l_s
+    remaining = P.pack $ printf "-%d:%02d" r_m r_s
+    (l_m, l_s) = toMS currentTime
+    (r_m, r_s) = toMS timeLeft
+    gap        = spaces distance
+    distance   = x - 4 - P.length elapsed - P.length remaining
+    toMS :: RealFrac a => a -> (Int, Int)
+    toMS = flip quotRem 60 . floor
+pTimes _ = Fast (spaces 5) defaultSty
 
 ------------------------------------------------------------------------
 
 -- | A progress bar
-instance Element ProgressBar where
-    draw dd@DD{drawSize=Size{sizeW=w}, drawState=st} = case drawFrame dd of
-      Nothing -> ProgressBar . FancyS $
-              [("  ", defaultSty), (spaces (w-4), bgs)]
-        where
-          (Style _ bg) = progress (config st)
-          bgs          = Style bg bg
-      Just Frame {..} -> ProgressBar . FancyS $
-          [ ("  ", defaultSty)
-          , (spaces distance, fgs)
-          , (spaces (width - distance), bgs)]
-        where
-          width    = w - 4
-          total    = curr + left
-          distance = round ((curr / total) * fromIntegral width)
-          curr     = realToFrac currentTime :: Float
-          left     = realToFrac timeLeft
-          (Style fg bg) = progress (config st)
-          bgs           = Style bg bg
-          fgs           = Style fg fg
+progressBar :: DrawData -> StringA
+progressBar dd@DD{drawSize=Size{sizeW=w}, drawState=st} = case drawFrame dd of
+    Nothing -> FancyS [("  ", defaultSty), (spaces (w-4), bgs)]
+      where
+        Style _ bg = progress (config st)
+        bgs        = Style bg bg
+    Just Frame {..} -> FancyS
+        [ ("  ", defaultSty)
+        , (spaces distance, fgs)
+        , (spaces (width - distance), bgs) ]
+      where
+        width    = w - 4
+        total    = curr + left
+        distance = round ((curr / total) * fromIntegral width)
+        curr     = realToFrac currentTime :: Float
+        left     = realToFrac timeLeft
+        Style fg bg = progress (config st)
+        bgs         = Style bg bg
+        fgs         = Style fg fg
 
 ------------------------------------------------------------------------
 
 -- | Version info
-instance Element PVersion where
-    draw _ = PVersion $ P.pack versinfo
+pVersion :: ByteString
+pVersion = P.pack versinfo
 
 -- | Uptime
-instance Element PTime where
-    draw dd = PTime . uptime $ drawState dd
+pTime :: DrawData -> ByteString
+pTime = uptime . drawState
 
 -- | Play mode
-instance Element PMode where
-    draw dd = PMode case status $ drawState dd of
-                        Stopped -> "◼"
-                        Paused  -> "⏸"
-                        Playing -> "▶"
+pMode :: DrawData -> String
+pMode dd = case status (drawState dd) of
+    Stopped -> "◼"
+    Paused  -> "⏸"
+    Playing -> "▶"
 
 -- | Loop, normal, or random
-instance Element PMode2 where
-    draw dd = PMode2 case mode $ drawState dd of
-                        Random  -> "rand"
-                        Loop    -> "loop"
-                        Once    -> "once"
-                        Single  -> "sing"
+pMode2 :: DrawData -> String
+pMode2 dd = case mode (drawState dd) of
+    Random -> "rand"
+    Loop   -> "loop"
+    Once   -> "once"
+    Single -> "sing"
 
 ------------------------------------------------------------------------
 
-instance Element PlayModes where
-    draw dd = PlayModes $ m ++ ' ' : m'
-        where
-            PMode  m  = draw dd
-            PMode2 m' = draw dd
-
-instance Element PlayInfo where
-    draw dd = PlayInfo $ mconcat [
-           -- TODO pregenerate as template
-           spaces (P.length numd - P.length curd)
-         , curd
-         , "/", numd
-         , " dir"
-         , onPlural (snd . bounds $ folders st) "" "s"
-         , " "
-         , spaces (P.length numf - P.length curf)
-         , curf
-         , "/", numf
-         , " file"
-         , onPlural (size st) "" "s"
-         ]
-      where
-        st = drawState dd
-        tobs = P.pack . show
-        onPlural 1 s _ = s
-        onPlural _ _ p = p
-        curf = tobs $ 1 + cursor st
-        numf = tobs $ size st
-        mydir = fdir $ music st ! cursor st
-        curd = tobs $ 1 + mydir
-        numd = tobs $ 1 + snd (bounds $ folders st)
+-- | The two play-mode glyphs (e.g. "▶ rand") rendered together.
+playModes :: DrawData -> String
+playModes dd = pMode dd ++ ' ' : pMode2 dd
 
-instance Element PlayTitle where
-    draw dd =
-        PlayTitle $ FancyS $ map (,hl)
-            if gap >= 2
-            then [mconcat [" ", inf, spaces gapl], modesBS,
-                    mconcat [spaces gapr, time, " ", ver, " "]]
-            else let gap' = x - modlen; gapl' = gap' `div` 2
-                 in if gap' >= 2
-                    then [spaces gapl', modesBS, spaces $ gap' - gapl']
-                    else [" ", u $ take (x-2) modes, " "]
-      where
-        PlayInfo inf    = draw dd
-        PTime time      = draw dd
-        PlayModes modes = draw dd
-        PVersion ver    = draw dd
-        modesBS         = u modes
+-- | "x/n dir(s)  y/m file(s)" cursor position read-out.
+playInfo :: DrawData -> ByteString
+playInfo dd = mconcat
+    -- TODO pregenerate as template
+    [ spaces (P.length numd - P.length curd)
+    , curd, "/", numd, " dir", onPlural (snd . bounds $ folders st) "" "s"
+    , " "
+    , spaces (P.length numf - P.length curf)
+    , curf, "/", numf, " file", onPlural (size st) "" "s"
+    ]
+  where
+    st   = drawState dd
+    tobs = P.pack . show
+    onPlural 1 s _ = s
+    onPlural _ _ p = p
+    curf  = tobs $ 1 + cursor st
+    numf  = tobs $ size st
+    mydir = fdir $ music st ! cursor st
+    curd  = tobs $ 1 + mydir
+    numd  = tobs $ 1 + snd (bounds $ folders st)
 
-        x       = sizeW $ drawSize dd
-        lsize   = 1 + P.length inf
-        rsize   = 2 + P.length time + P.length ver
-        side    = (x - modlen) `div` 2
-        gap     = x - modlen - lsize - rsize
-        gapl    = 1 `max` ((side - lsize) `min` gap)
-        gapr    = 1 `max` (gap - gapl)
-        modlen  = 6 -- length modes
-        hl      = titlebar . config $ drawState dd
+-- | The top title bar: cursor position + play modes + uptime + version.
+playTitle :: DrawData -> StringA
+playTitle dd =
+    FancyS $ map (, hl)
+        if gap >= 2
+        then [mconcat [" ", inf, spaces gapl], modesBS,
+                mconcat [spaces gapr, time, " ", ver, " "]]
+        else let gap' = x - modlen; gapl' = gap' `div` 2
+             in if gap' >= 2
+                then [spaces gapl', modesBS, spaces $ gap' - gapl']
+                else [" ", u $ take (x-2) modes, " "]
+  where
+    inf     = playInfo dd
+    time    = pTime dd
+    modes   = playModes dd
+    ver     = pVersion
+    modesBS = u modes
 
--- | Playlist
-instance Element PlayList where
-    draw dd@DD{ drawSize=Size y x, drawPos=Pos{posY=o}, drawState=st } =
-        PlayList $
-            title
-            : list
-            ++ replicate (height - length list - 2) (Fast P.empty defaultSty)
-            ++ [minibuffer st]
-        where
-            PlayTitle title = draw dd
+    x       = sizeW $ drawSize dd
+    lsize   = 1 + P.length inf
+    rsize   = 2 + P.length time + P.length ver
+    side    = (x - modlen) `div` 2
+    gap     = x - modlen - lsize - rsize
+    gapl    = 1 `max` ((side - lsize) `min` (gap - 1))
+    gapr    = gap - gapl
+    modlen  = 6 -- length modes
+    hl      = titlebar . config $ drawState dd
 
-            songs  = music st
-            this   = current st
-            curr   = cursor  st
-            height = y - o
+-- | The scrolling playlist (title + visible tracks + minibuffer).
+playList :: DrawData -> [StringA]
+playList dd@DD{ drawSize=Size y x, drawPos=Pos{posY=o}, drawState=st } =
+    playTitle dd
+    : list
+    ++ replicate (height - length list - 2) (Fast P.empty defaultSty)
+    ++ [minibuffer st]
+  where
+    songs  = music st
+    this   = current st
+    curr   = cursor  st
+    height = y - o
 
-            -- number of screens down, and then offset
-            buflen   = height - 2
-            (screens, select) = quotRem curr buflen -- keep cursor in screen
+    -- number of screens down, and then offset
+    buflen = height - 2
+    (screens, select) = quotRem curr buflen -- keep cursor in screen
 
-            playing  = let top = screens * buflen
-                           bot = (screens + 1) * buflen
-                       in if this >= top && this < bot
-                            then this - top -- playing song is visible
-                            else (-1)
+    playing = let top = screens * buflen
+                  bot = (screens + 1) * buflen
+              in if this >= top && this < bot
+                    then this - top -- playing song is visible
+                    else (-1)
 
-            -- visible slice of the playlist
-            visible = slice off (off + buflen) songs
-                where off = screens * buflen
+    -- visible slice of the playlist
+    visible = slice off (off + buflen) songs
+        where off = screens * buflen
 
-            -- TODO rewrite as fold
-            visible' :: [(Maybe Int, ByteString)]
-            visible' = loop (-1) visible where
-                loop _ []     = []
-                loop n (v:vs) =
-                    let r = if fdir v > n then Just (fdir v) else Nothing
-                    in (r, toMaxWidth (x - indent - 1) $ fbase v)
-                            : loop (fdir v) vs
+    visible' :: [(Maybe Int, ByteString)]
+    visible' = loop (-1) visible where
+        loop _ []     = []
+        loop n (v:vs) =
+            let r = if fdir v > n then Just (fdir v) else Nothing
+            in (r, toMaxWidth (x - indent - 1) $ fbase v)
+                    : loop (fdir v) vs
 
-            list   = [ drawIt . color $ n | n <- zip visible' [0..] ]
+    list   = [ drawIt . color $ n | n <- zip visible' [0..] ]
 
-            indent = (round $ (0.334 :: Float) * fromIntegral x) :: Int
+    indent = (round $ (0.334 :: Float) * fromIntegral x) :: Int
 
-            color :: ((Maybe Int, ByteString), Int)
-                        -> (Maybe Int, Style, [ByteString])
-            color ((m,s),i)
-                | i == select && i == playing = f sty3
-                | i == select                 = f sty2
-                | i == playing                = f sty1
-                | otherwise                   = (m, defaultSty, [s])
-                where
-                    f sty = (m, sty,
-                        [s, spaces (x - indent - 1 - displayWidth s)])
+    color :: ((Maybe Int, ByteString), Int)
+                -> (Maybe Int, Style, [ByteString])
+    color ((m, s), i)
+        | i == select && i == playing = f sty3
+        | i == select                 = f sty2
+        | i == playing                = f sty1
+        | otherwise                   = (m, defaultSty, [s])
+        where
+            f sty = (m, sty,
+                [s, spaces (x - indent - 1 - displayWidth s)])
 
-            sty1 = selected . config $ st
-            sty2 = cursors  . config $ st
-            sty3 = combined . config $ st
+    sty1 = selected . config $ st
+    sty2 = cursors  . config $ st
+    sty3 = combined . config $ st
 
-            drawIt :: (Maybe Int, Style, [ByteString]) -> StringA
-            drawIt (Nothing, sty, v) =
-                FancyS $ map (, sty) $ spaces (1 + indent) : v
+    drawIt :: (Maybe Int, Style, [ByteString]) -> StringA
+    drawIt (Nothing, sty, v) =
+        FancyS $ map (, sty) $ spaces (1 + indent) : v
 
-            drawIt (Just i, sty, v) = FancyS
-                $ (d, sty')
-                : (spaces (indent + 1 - displayWidth d), sty')
-                : map (, sty) v
-              where
-                sty' = if sty == sty2 || sty == sty3 then sty2 else sty1
-                d = toMaxWidth (indent - 1) $ basenameP
-                        $ case size st of
-                            0 -> "(empty)"
-                            _ -> dname $ folders st ! i
+    drawIt (Just i, sty, v) = FancyS
+        $ (d, sty')
+        : (spaces (indent + 1 - displayWidth d), sty')
+        : map (, sty) v
+      where
+        sty' = if sty == sty2 || sty == sty3 then sty2 else sty1
+        d = toMaxWidth (indent - 1) $ takeFileName
+                $ case size st of
+                    0 -> "(empty)"
+                    _ -> dname $ folders st ! i
 
---
--- | Decode the list of current tracks
---
-printPlayList :: PlayList -> [StringA]
-printPlayList (PlayList s) = s
-{-# INLINE printPlayList #-}
-                
 ------------------------------------------------------------------------
 
 spaces :: Int -> ByteString
 spaces = flip P.replicate ' '
 
 ------------------------------------------------------------------------
---
 -- | Now write out just the clock line
--- Speed things up a bit, just use read State.
---
 redrawJustClock :: Draw
 redrawJustClock = Draw $ discardErrors do
-   st      <- getsHS id
-   let fr = clock st
-   (h, w) <- screenSize
-   let sz = Size h w
-   let (ProgressBar bar) = draw $ DD sz undefined st fr :: ProgressBar
-       (PTimes times)    = {-# SCC "redrawJustClock.times" #-}
-                           draw $ DD sz undefined st fr :: PTimes
-   Curses.wMove Curses.stdScr 1 0   -- hardcoded!
-   drawLine w bar
-   Curses.wMove Curses.stdScr 2 0   -- hardcoded!
-   drawLine w times
-   when (h<45) $ renderModals st sz -- small screen modals paint over clock
+    st     <- getsHS id
+    (h, w) <- screenSize
+    let dd = DD (Size h w) undefined st (clock st)
+    Curses.wMove Curses.stdScr 1 0   -- hardcoded!
+    drawLine $ progressBar dd
+    Curses.wMove Curses.stdScr 2 0   -- hardcoded!
+    drawLine $ pTimes dd
+    when (h < 45) $ renderModals st (Size h w) -- small screen modals paint over clock
 
 ------------------------------------------------------------------------
---
--- work for drawing help. draw the help screen if it is up
---
-renderModal :: forall me. ModalElement me => HState -> Size -> IO ()
-renderModal st (Size h w) = do
-   for_ (drawModal @me (modals $ config st) w st) \(mw, modal') -> do
-       let hoffset = max 0 $ (w - mw) `div` 2
-           mlines  = min h $ length modal'
-           voffset = (h - mlines) `div` 2
-       Curses.wMove Curses.stdScr voffset hoffset
-       for_ (take mlines modal') \t -> do
-            drawLine w t
-            (y', _) <- Curses.getYX Curses.stdScr
-            Curses.wMove Curses.stdScr (y'+1) hoffset
+-- | General modal renderer.
+renderModal :: HState -> Size -> ModalMaker -> IO ()
+renderModal st (Size h w) mkr = do
+    let (mw, modal') = mkr w
+        hoffset = max 0 $ (w - mw) `div` 2
+        mlines  = min h $ length modal'
+        voffset = (h - mlines) `div` 2
+        sty = modals $ config st
+    Curses.wMove Curses.stdScr voffset hoffset
+    for_ (take mlines modal') \t -> do
+        drawLine $ Fast (toWidth mw t) sty
+        (y', _) <- Curses.getYX Curses.stdScr
+        Curses.wMove Curses.stdScr (y'+1) hoffset
 
+-- | Choose modal to render based on state.
 renderModals :: HState -> Size -> IO ()
-renderModals s sz = do
-   renderModal @HelpModal s sz
-   renderModal @HistModal s sz
-   renderModal @ExitModal s sz
+renderModals st sz =
+    whenJust (modal st) $ renderModal st sz . \case
+        HelpModal h -> helpModal h
+        HistModal h -> histModal h
+        ExitModal   -> exitModal
 
 ------------------------------------------------------------------------
 --
 -- | Draw the screen
 --
 redraw :: Draw
-redraw = Draw $ discardErrors do
-   -- linux ncurses, in particular, seems to complain a lot. this is an easy solution
-   s <- getsHS id    -- another refresh could be triggered?
-   let f = clock s
-   (h, w) <- screenSize
-   let sz = Size h w
+redraw = Draw $ discardErrors {- TODO what errors are discarded? -} do
+    st <- getsHS id    -- another refresh could be triggered?
+    (h, w) <- screenSize
+    let sz     = Size h w
+        screen = playScreen (DD sz (Pos 0 0) st (clock st))
+        a      = screen ++ playList (DD sz (Pos (length screen) 0) st (clock st))
 
-   let a = let x = printPlayScreen (draw $ DD sz (Pos 0 0) s f :: PlayScreen)
-               y = printPlayList (draw $ DD sz (Pos (length x) 0) s f :: PlayList)
-           in x ++ y
+    setXterm st
 
-   when (xterm s) $ setXterm s
-   
-   gotoTop
-   for_ (take (h-1) (init a)) \t -> do
-       drawLine w t
-       (y, x) <- Curses.getYX Curses.stdScr
-       fillLine
-       maybeLineDown t h y x
-   renderModals s sz
+    gotoTop
+    for_ (take (h-1) (init a)) \t -> do
+        drawLine t
+        (y, x) <- Curses.getYX Curses.stdScr
+        fillLine
+        maybeLineDown t h y x
+    renderModals st sz
 
-   -- minibuffer
-   Curses.wMove Curses.stdScr (h-1) 0
-   fillLine 
-   Curses.wMove Curses.stdScr (h-1) 0
-   drawLine (w-1) (last a)
-   when (miniFocused s) do -- a fake cursor
-        drawLine 1 (Fast (spaces 1) (blockcursor . config $ s ))
+    -- minibuffer
+    Curses.wMove Curses.stdScr (h-1) 0
+    fillLine
+    Curses.wMove Curses.stdScr (h-1) 0
+    drawLine (last a)
+    when (miniFocused st) do -- a fake cursor
+        drawLine (Fast (spaces 1) (blockcursor . config $ st ))
+        -- XXX is this TODO from 2005 still relevant?
         -- todo rendering bug here when deleting backwards in minibuffer
 
 ------------------------------------------------------------------------
 --
 -- | Draw a coloured (or not) string to the screen
 --
-drawLine :: Int -> StringA -> IO ()
-drawLine _ (Fast ps sty) = drawSegment ps sty
-drawLine _ (FancyS ls)   = traverse_ (uncurry drawSegment) ls
+drawLine :: StringA -> IO ()
+drawLine (Fast ps sty) = drawSegment ps sty
+drawLine (FancyS ls)   = traverse_ (uncurry drawSegment) ls
 
 -- | Write a single styled UTF-8 segment.  Safe because C only reads the bytes.
 drawSegment :: ByteString -> Style -> IO ()
@@ -666,9 +564,6 @@
     in [unsafeAt arr n | n <- [max a i .. min b j] ]
 {-# INLINE slice #-}
 
--- isAscii :: ByteString -> Bool
--- isAscii = P.all (<'\128')
-
 ------------------------------------------------------------------------
 
 --
@@ -684,14 +579,11 @@
 
 ------------------------------------------------------------------------
 
--- set xterm title (should have an instance Element)
--- Don't need to do this on each refresh...
+-- set xterm title.  Don't need to do this on each refresh...
 setXterm :: HState -> IO ()
 setXterm s = setXtermTitle $ case status s of
     Playing -> case id3 s of
-        Nothing -> case size s of
-                        0 -> ["hmp3"]
-                        _ -> [fbase $ music s ! current s]
+        Nothing -> [fbase $ music s ! current s]
         Just ti -> id3artist ti :
                    if P.null (id3title ti)
                         then []
diff --git a/app/Main.hs b/app/Main.hs
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -9,6 +9,7 @@
 
 import Core     (start, shutdown, Options(..))
 import qualified Config
+import Keymap   (keyLoop)
 import Tree     (buildTree, isEmpty)
 
 import System.IO            (hPrint, stderr)
@@ -71,9 +72,12 @@
 main :: IO ()
 main = do
     (opts, args) <- customExecParser (prefs showHelpOnEmpty) parserInfo
-    initSignals
     tree <- buildTree args
-    if isEmpty tree
-        then putStrLn "Error: No music files found." *> exitFailure
-        else start opts tree -- never returns
+    when (isEmpty tree) $
+        errorWithoutStackTrace "Error: No music files found."
+    initSignals
+    err <- either id absurd <$> try @SomeException do
+        start opts tree
+        keyLoop
+    shutdown $ Just $ "Error: " ++ show err
 
diff --git a/hmp3-ng.cabal b/hmp3-ng.cabal
--- a/hmp3-ng.cabal
+++ b/hmp3-ng.cabal
@@ -1,23 +1,23 @@
 cabal-version: 3.0
+name: hmp3-ng
+version: 2.18.1
+synopsis: A 2019 fork of an ncurses mp3 player written in Haskell
+description:
+  An mp3 player with a curses frontend.  Playlists are populated by
+  passing file and directory names on the command line.  'h' displays
+  help.
 
-name:           hmp3-ng
-version:        2.18.0
-synopsis:       A 2019 fork of an ncurses mp3 player written in Haskell
-description:    An mp3 player with a curses frontend.  Playlists are populated by
-                passing file and directory names on the command line.  'h' displays
-                help.
-category:       Sound
-homepage:       https://github.com/galenhuntington/hmp3-ng#readme
-bug-reports:    https://github.com/galenhuntington/hmp3-ng/issues
-author:         Don Stewart, Galen Huntington
-maintainer:     Galen Huntington
-license:        GPL-2.0-or-later
-license-file:   LICENSE
-build-type:     Simple
-extra-source-files:
-    Keymap.hs-boot
+category: Sound
+homepage: https://github.com/galenhuntington/hmp3-ng#readme
+bug-reports: https://github.com/galenhuntington/hmp3-ng/issues
+author: Don Stewart, Galen Huntington
+maintainer: Galen Huntington
+license: GPL-2.0-or-later
+license-file: LICENSE
+build-type: Simple
+
 extra-doc-files:
-    README.md
+  README.md
 
 source-repository head
   type: git
@@ -26,57 +26,69 @@
 common opts
   default-language: Haskell2010
   default-extensions:
-      BangPatterns
-      BlockArguments
-      OverloadedStrings
-      ScopedTypeVariables
-      TypeApplications
-      DerivingStrategies
-      RecordWildCards
-      LambdaCase
-      MultiWayIf
-      StandaloneDeriving
-      NumericUnderscores
-      NamedFieldPuns
-  ghc-options: -Wall -funbox-strict-fields
+    BlockArguments
+    MultiWayIf
+    OverloadedStrings
+    RecordWildCards
+    -- In GHC2024
+    DerivingStrategies
+    LambdaCase
+    -- In GHC2021 (soon!)
+    BangPatterns
+    GeneralizedNewtypeDeriving
+    NamedFieldPuns
+    NumericUnderscores
+    ScopedTypeVariables
+    StandaloneDeriving
+    TupleSections
+    TypeApplications
 
+  ghc-options:
+    -Wall
+    -funbox-strict-fields
+
 library
   import: opts
   hs-source-dirs: ./
   exposed-modules:
-      Base
-      Config
-      Core
-      FastIO
-      Keymap
-      Lexer
-      State
-      Style
-      Syntax
-      Tree
-      UI
-      Width
+    Base
+    Config
+    Core
+    Keyboard
+    Keymap
+    Lexer
+    State
+    Style
+    Syntax
+    Tree
+    UI
+    Width
+
   other-modules:
-      Paths_hmp3_ng
+    Paths_hmp3_ng
+
   autogen-modules:
-      Paths_hmp3_ng
+    Paths_hmp3_ng
+
   pkgconfig-depends:
-      ncursesw
+    ncursesw
+
   build-depends:
-    , array
-    , base ==4.*
-    , bytestring >=0.10
-    , clock
-    , containers
-    , directory >=1.3.7.0
-    , filepath
-    , hscurses
-    , mtl
-    , pcre-light >=0.3
-    , process
-    , random
-    , unix >=2.7
-    , utf8-string
+    array,
+    base >=4.15 && <5,
+    bytestring >=0.10,
+    clock,
+    containers,
+    directory >=1.3.7.0,
+    filepath,
+    hscurses,
+    mtl,
+    pcre-light >=0.3,
+    posix-paths,
+    process,
+    random,
+    unix >=2.7,
+    utf8-string,
 
 executable hmp3
   import: opts
@@ -84,12 +96,12 @@
   hs-source-dirs: app
   ghc-options: -threaded
   build-depends:
-    , base
-    , bytestring
-    , hmp3-ng
-    , optparse-applicative
-    , unix
-    , utf8-string
+    base,
+    bytestring,
+    hmp3-ng,
+    optparse-applicative,
+    unix,
+    utf8-string,
 
 test-suite test
   import: opts
@@ -97,19 +109,19 @@
   main-is: Main.hs
   hs-source-dirs: test
   other-modules:
-      ConfigSpec
-      CoreSpec
-      FastIOSpec
-      LexerSpec
-      StyleSpec
-      TreeSpec
-      WidthSpec
+    ConfigSpec
+    CoreSpec
+    LexerSpec
+    StyleSpec
+    TreeSpec
+    WidthSpec
+
   build-depends:
-    , base
-    , bytestring
-    , clock
-    , hmp3-ng
-    , tasty           >=1.4
-    , tasty-hunit     >=0.10
-    , utf8-string
+    base,
+    bytestring,
+    clock,
+    hmp3-ng,
+    tasty >=1.4,
+    tasty-hunit >=0.10,
+    utf8-string,
 
diff --git a/test/FastIOSpec.hs b/test/FastIOSpec.hs
deleted file mode 100644
--- a/test/FastIOSpec.hs
+++ /dev/null
@@ -1,42 +0,0 @@
-module FastIOSpec (tests) where
-
-import Test.Tasty
-import Test.Tasty.HUnit
-
-import FastIO (basenameP, dirnameP, packedFileNameEndClean, trim)
-
-tests :: TestTree
-tests = testGroup "FastIO"
-    [ testGroup "basenameP"
-        [ testCase "no slash"           $ basenameP "foo"         @?= "foo"
-        , testCase "single dir"         $ basenameP "foo/bar"     @?= "bar"
-        , testCase "leading slash"      $ basenameP "/foo"        @?= "foo"
-        , testCase "nested"             $ basenameP "a/b/c/d.mp3" @?= "d.mp3"
-        , testCase "trailing slash"     $ basenameP "foo/"        @?= ""
-        , testCase "empty"              $ basenameP ""            @?= ""
-        ]
-    , testGroup "dirnameP"
-        [ testCase "no slash"           $ dirnameP "foo"          @?= "."
-        , testCase "single dir"         $ dirnameP "foo/bar"      @?= "foo"
-        , testCase "leading slash"      $ dirnameP "/foo"         @?= ""
-        , testCase "nested"             $ dirnameP "a/b/c/d.mp3"  @?= "a/b/c"
-        ]
-    , testGroup "trim"
-        [ testCase "no whitespace"      $ trim "foo"              @?= "foo"
-        , testCase "leading spaces"     $ trim "   foo"           @?= "foo"
-        , testCase "trailing spaces"    $ trim "foo   "           @?= "foo"
-        , testCase "both"               $ trim "   foo   "        @?= "foo"
-        , testCase "internal preserved" $ trim "  foo bar  "      @?= "foo bar"
-        , testCase "tabs and newlines"  $ trim "\t foo \n"        @?= "foo"
-        , testCase "whitespace only"    $ trim "   "              @?= ""
-        , testCase "empty"              $ trim ""                 @?= ""
-        ]
-    , testGroup "packedFileNameEndClean"
-        [ testCase "no trailing"        $ packedFileNameEndClean "foo"      @?= "foo"
-        , testCase "trailing slash"     $ packedFileNameEndClean "foo/"     @?= "foo"
-        , testCase "trailing backslash" $ packedFileNameEndClean "foo\\"    @?= "foo"
-        , testCase "multiple trailing"  $ packedFileNameEndClean "foo/\\/"  @?= "foo"
-        , testCase "internal preserved" $ packedFileNameEndClean "a/b/c/"   @?= "a/b/c"
-        , testCase "empty"              $ packedFileNameEndClean ""         @?= ""
-        ]
-    ]
diff --git a/test/LexerSpec.hs b/test/LexerSpec.hs
--- a/test/LexerSpec.hs
+++ b/test/LexerSpec.hs
@@ -5,55 +5,61 @@
 
 import qualified Data.ByteString.Char8 as P
 
-import Lexer (doP, doF, doS, doI)
+import Lexer (mpgParser)
 import Syntax
 
+-- These exercise the helpers doX, 'trim', and 'normalise'.
 tests :: TestTree
-tests = testGroup "Lexer"
-    [ testGroup "doP (status messages)"
-        [ testCase "0 is Stopped"        $ doP "0"   @?= S Stopped
-        , testCase "1 is Paused"         $ doP "1"   @?= S Paused
-        , testCase "2 is Playing"        $ doP "2"   @?= S Playing
-        , testCase "3 is Playing"        $ doP "3"   @?= S Playing
-        , testCase "empty is Playing"    $ doP ""    @?= S Playing
-        , testCase "garbage is Playing"  $ doP "xyz" @?= S Playing
+tests = testGroup "Lexer.mpgParser"
+    [ testGroup "status (@P)"
+        [ tc "@P 0"  $ Right (S Stopped)
+        , tc "@P 1"  $ Right (S Paused)
+        , tc "@P 2"  $ Right (S Playing)
+        , tc "@P 3"  $ Left Nothing   -- end-of-song marker: ignored (no double play)
+        , tc "@P 9"  $ Left Nothing   -- unknown code
+        , tc "@P "   $ Left Nothing   -- no payload
         ]
-    , testGroup "doF (frame messages)"
-        [ testCase "all four fields parse" $
-            doF "123 456 12.34 56.78" @?= R (Frame 123 456 12.34 56.78)
-        , testCase "negative timeLeft is clamped to zero" $
-            doF "0 0 0.00 -1.00"      @?= R (Frame 0 0 0.00 0)
+    , testGroup "frame (@F)"
+        [ tc "@F 123 456 12.34 56.78" $ Right (R (Frame 123 456 12.34 56.78))
+        , tc "@F 0 0 0.00 -1.00"      $ Right (R (Frame 0 0 0.00 0))  -- timeLeft clamped
+        , tc "@F 1 2 3.00"            $ Left Nothing   -- too few fields
+        , tc "@F a b c d"             $ Left Nothing   -- non-numeric
         ]
-    , testGroup "doS (info messages)"
-        [ testCase "userinfo combines version, bitrate, kHz" $
-            doS "1.0 1 44100 stereo 0 0 2 0 0 0 128 0"
-                @?= I (Info "mpeg 1.0 128kbit/s 44kHz")
+    , testGroup "stream info (@S)"
+        [ tc "@S 1.0 1 44100 stereo 0 0 2 0 0 0 128 0"
+                                      $ Right (I (Info "mpeg 1.0 128kbit/s 44kHz"))
+        , tc "@S 1.0 1 44100"         $ Left Nothing   -- too few fields
         ]
-    , testGroup "doI (track info / id3)"
-        [ testCase "non-id3 input becomes Left filename" $
-            doI "song.mp3"
-                @?= F (File (Left "song.mp3"))
-        , testCase "non-id3 input is trimmed" $
-            doI "  song.mp3  "
-                @?= F (File (Left "song.mp3"))
-        , testCase "id3 with title only" $
-            doI ("ID3:" <> field30 "Title")
-                @?= F (File (Right (Id3 "Title" "" "" "Title")))
-        , testCase "id3 with title and artist" $
-            doI ("ID3:" <> field30 "Title" <> field30 "Artist")
-                @?= F (File (Right (Id3 "Title" "Artist" "" "Artist : Title")))
-        , testCase "id3 with title, artist, and album" $
-            doI ("ID3:" <> field30 "Title" <> field30 "Artist" <> field30 "Album")
-                @?= F (File (Right (Id3 "Title" "Artist" "Album" "Artist : Album : Title")))
-        , testCase "id3 with empty title falls back to Left of trimmed input" $
-            -- mpg123 sometimes returns ID3 records with a blank title; rather than
-            -- present an empty track name, the parser exposes the raw line.
-            doI ("ID3:" <> field30 "" <> field30 "Artist")
-                @?= F (File (Left ("ID3:" <> P.replicate 30 ' ' <> "Artist")))
+    , testGroup "id3 (@I)" (let s = "n\195\182rmalise" in
+        [ tcId3 ["Title"]
+              $ Right (F (Id3 "Title" "" "" "Title"))
+        , tcId3 ["Title", "Artist"]
+              $ Right (F (Id3 "Title" "Artist" "" "Artist : Title"))
+        , tcId3 [" Title", "  Artist"]
+              $ Right (F (Id3 "Title" "Artist" "" "Artist : Title"))
+        , tcId3 ["Title", "Artist", "Album"]
+              $ Right (F (Id3 "Title" "Artist" "Album" "Artist : Album : Title"))
+        , tcId3 ["", "Artist"]       $ Left Nothing   -- blank title: skipped
+        , tc "@I song.mp3"           $ Left Nothing   -- non-ID3 @I: don't overwrite
+        , tc "@I {"                  $ Left Nothing   -- grouping marker: ignored
+        , tcId3 ["nörmalise"]        $ Right (F (Id3 s "" "" s))
+        , tcId3 [s]                  $ Right (F (Id3 s "" "" s))
+        ])
+    , testGroup "tagline, errors, junk"
+        [ tc "@R a tagline"          $ Right (T Tag)
+        , tc "@E some failure"       $ Left (Just "some failure")
+        , tc "garbage"               $ Left Nothing   -- no @ prefix
+        , tc "@F"                    $ Left Nothing   -- no space after code
+        , tc "@"                     $ Left Nothing
+        , tc ""                      $ Left Nothing
         ]
     ]
+  where
+    tc line = tc' (show line) line
+    tc' tag line expected = testCase tag $ mpgParser line @?= expected
+    tcId3 fields = tc' (show fields) (id3 fields)
 
--- Pad/truncate a ByteString to exactly 30 characters with trailing spaces,
--- matching the fixed-width field convention used by mpg123 ID3 output.
-field30 :: P.ByteString -> P.ByteString
-field30 b = P.take 30 (b <> P.replicate 30 ' ')
+-- | Build an "@I ID3:" line from fixed-width 30-char fields, as mpg123 emits.
+id3 :: [P.ByteString] -> P.ByteString
+id3 fields = "@I ID3:" <> mconcat [ P.take 30 (f <> P.replicate 30 ' ') | f <- fields ]
+
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -4,7 +4,6 @@
 
 import qualified ConfigSpec
 import qualified CoreSpec
-import qualified FastIOSpec
 import qualified LexerSpec
 import qualified StyleSpec
 import qualified TreeSpec
@@ -14,7 +13,6 @@
 main = defaultMain $ testGroup "hmp3-ng"
     [ ConfigSpec.tests
     , CoreSpec.tests
-    , FastIOSpec.tests
     , LexerSpec.tests
     , StyleSpec.tests
     , TreeSpec.tests