From e7aa266b6c73730b454ad48943b249c30bbb6e71 Mon Sep 17 00:00:00 2001 From: tv Date: Sun, 27 Jul 2025 13:51:34 +0200 Subject: app: drop kmein and make tv the default --- app/much.hs | 128 ++++++++++++++++++++++++++++++++++++++ config/kmein.hs | 186 -------------------------------------------------------- config/tv.hs | 128 -------------------------------------- much.cabal | 24 +------- 4 files changed, 131 insertions(+), 335 deletions(-) create mode 100644 app/much.hs delete mode 100644 config/kmein.hs delete mode 100644 config/tv.hs diff --git a/app/much.hs b/app/much.hs new file mode 100644 index 0000000..84eda6b --- /dev/null +++ b/app/much.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Main (main) where + +import Blessings.String.WCWidth +import Data.Default +import Data.Maybe +import Much.Action +import Much.Core +import Much.State +import Much.TreeView +import Scanner +import System.Environment (getEnv) +import System.IO.Unsafe (unsafePerformIO) +import Text.Hyphenation +import Text.LineBreak +import qualified Data.Tree as Tree +import qualified Data.Tree.Zipper as Z +import qualified Much.API +import qualified Notmuch.Message as Notmuch + + +scrollLines :: Int +scrollLines = + if unsafePerformIO (getEnv "TOUCHSCREEN") == "1" then + 1 + else + 3 + +main :: IO () +main = + mainWithState def + { apiConfig = def + { Much.API.socketPath = "/home/tv/tmp/much/warp.sock" + } + , keymap = myKeymap + , mousemap = myMousemap + } + +myKeymap :: String -> State -> IO State + +myKeymap "a" = toggleTagAtCursor "inbox" +myKeymap "s" = toggleTagAtCursor "unread" +myKeymap "g" = toggleTagAtCursor "killed" +myKeymap "f" = toggleTagAtCursor "star" +myKeymap "&" = toggleTagAtCursor "killed" +myKeymap "*" = toggleTagAtCursor "star" +myKeymap "k" = moveCursorUp 1 +myKeymap "j" = moveCursorDown 1 +myKeymap "K" = moveTreeDown 1 +myKeymap "J" = moveTreeUp 1 +myKeymap "H" = moveTreeRight 8 +myKeymap "L" = moveTreeLeft 8 +myKeymap "\ESC[A" = moveCursorUp 1 +myKeymap "\ESC[B" = moveCursorDown 1 +myKeymap "\ESC[a" = moveTreeDown 1 +myKeymap "\ESC[b" = moveTreeUp 1 +myKeymap "\ESC[c" = moveTreeLeft 8 -- S-Right +myKeymap "\ESC[d" = moveTreeRight 8 -- S-Left +myKeymap "\ESC[5~" = \q -> moveTreeDown (screenHeight q `div` 2) q -- PgUp +myKeymap "\ESC[6~" = \q -> moveTreeUp (screenHeight q `div` 2) q -- PgDn +myKeymap "\n" = toggleFold +myKeymap "\ESC[Z" = moveCursorUpToPrevUnread -- S-Tab +myKeymap "\t" = moveCursorDownToNextUnread +myKeymap "\DEL" = moveToParent -- backspace + +-- TODO wrap/unwrap to separate module +myKeymap "=" = \q@State{..} -> + let cursor' = case Z.label cursor of + TVMessageLine a b c s -> + wrap (TVMessageLine a b c) cursor s + _ -> cursor + in return q { cursor = cursor' } + where + + --unwrap = error "WIP" + -- 1. get current id (must be TVMessageLine) + -- 2. find first adjoined TVMessageLine with same id + -- 3. find last adjoined TVMessageLine with same id + -- 4. join lines (with space?) + + wrap ctor loc s = + fromMaybe (error "die hard") $ + Z.nextTree $ + foldr (insert . ctor) + (Z.delete loc) + $ hy s + + insert a = + Z.prevSpace . Z.insert (Tree.Node a []) + + hy s = + breakStringLn bf s + where + shy = '\173' + hyp = Just german_1996 + bf = BreakFormat 80 8 shy hyp + +-- +myKeymap "\ESC[11~" = \q@State{..} -> + return q { flashMessage = Plain $ show $ treeViewId $ Z.label cursor } + +-- +myKeymap "\ESC[12~" = \q@State{..} -> + return q { flashMessage = + Plain $ + show $ + maybe Nothing (Just . Notmuch.messageFilename) $ + getMessage $ + Z.label cursor + } + +-- TODO Stuff Vim sends after exit (also there is more...) +myKeymap "\ESC[2;2R" = \q -> return q { flashMessage = flashMessage q <> " " <> Plain "stupid" } +myKeymap "\ESC[>85;95;0c" = \q -> return q { flashMessage = flashMessage q <> " " <> Plain "stupid" } + +myKeymap s = displayKey s + + +myMousemap :: Scan -> State -> IO State +myMousemap ScanMouse{mouseButton=1,mouseY=y} = defaultMouse1Click y +myMousemap ScanMouse{mouseButton=3,mouseY=y} = \q -> defaultMouse1Click y q >>= toggleFold +myMousemap ScanMouse{mouseButton=4} = moveTreeDown scrollLines +myMousemap ScanMouse{mouseButton=5} = moveTreeUp scrollLines +myMousemap ScanMouse{mouseButton=0} = return +myMousemap info = displayMouse info diff --git a/config/kmein.hs b/config/kmein.hs deleted file mode 100644 index 361aecc..0000000 --- a/config/kmein.hs +++ /dev/null @@ -1,186 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - -module Main (main) where - -import Much.Action -import Much.Core (mainWithState, notmuchSearch) -import Much.State (State(..), ColorConfig(..)) -import Much.TreeView (TreeView(TVMessagePart), treeViewId, getMessage) -import Notmuch (notmuchShowPart) -import Notmuch.Message - -import Blessings.String.WCWidth (Blessings(..)) -import Control.Monad ((>=>), unless) -import Data.Default (Default(..)) -import Data.Functor (($>)) -import Data.Maybe (fromMaybe) -import Scanner (Scan(ScanMouse), mouseButton, mouseY) -import System.Directory (doesFileExist) -import System.FilePath (()) -import System.Posix.Signals (raiseSignal, sigINT) -import System.Process (callProcess, spawnCommand) -import qualified Data.ByteString.Lazy.Char8 as LBS8 (writeFile) -import qualified Data.Text as T (unpack) -import qualified Data.Text.IO as T (writeFile) -import qualified Data.Tree.Zipper as Z (label) - -{- notmuch's special tags are: - - synchonised to maildir: draft flagged passed replied unread - automatic: attachment signed encrypted - cli default tags: unread inbox deleted spam - - ref: https://notmuchmail.org/special-tags/ --} - -main :: IO () -main = - mainWithState def - { keymap = myKeymap - , mousemap = myMousemap - , colorConfig = def - { boring = pure [38,5,8] - , alt = pure [38,5,182] - , search = pure [38,5,13] - , focus = pure [38,5,4] - , quote = pure [38,5,7] - , prefix = pure [38,5,235] - , date = pure [38,5,1] - , tags = pure [38,5,14] - , boringMessage = pure [38,5,3] - , unreadMessage = pure [38,5,11] - , unreadSearch = pure [38,5,15] - , tagMap = pure - [ ("deleted", pure [38,5,088]) - , ("flagged", pure [38,5,226]) - , ("draft", pure [38,5,63]) - , ("spam", pure [38,5,202]) - ] - } - , aliases = - [ ("flagged", "🔖") - , ("attachment", "📎") - , ("signed", "🔒") - ] - , query = "tag:inbox" - } - -showCurrentMessagePart :: State -> IO (Maybe (Message, MessagePart)) -showCurrentMessagePart q = - case Z.label (cursor q) of - TVMessagePart message part -> do - let m_id = unMessageID (messageId message) - partResult <- notmuchShowPart m_id (partID part) - case partResult of - Right part' -> return $ Just (message, part') - Left _ -> return Nothing - _ -> return Nothing - -currentAttachmentPath :: State -> Message -> MessagePart -> FilePath -currentAttachmentPath q message part = - attachmentDirectory q attachmentFileName q message part - -saveAttachment :: State -> IO State -saveAttachment q = - showCurrentMessagePart q >>= \case - Nothing -> return q { flashMessage = "cursor not on attachment" } - Just (message, part) -> do - let destination = currentAttachmentPath q message part - alreadyDownloaded <- doesFileExist destination - if attachmentOverwrite q || not alreadyDownloaded - then case partContent part of - ContentText text -> - T.writeFile destination text $> - q { flashMessage = Plain destination } - ContentRaw raw _ -> - LBS8.writeFile destination raw $> - q { flashMessage = Plain destination } - _ -> return q { flashMessage = "this part cannot be saved" } - else return q { flashMessage = "not overwriting attachment" } - -openAttachment :: State -> IO State -openAttachment q = - showCurrentMessagePart q >>= \case - Nothing -> return q { flashMessage = "cursor not on attachment" } - Just (message, part) -> do - let destination = currentAttachmentPath q message part - alreadyDownloaded <- doesFileExist destination - unless alreadyDownloaded $ saveAttachment q $> () - callProcess "xdg-open" [destination] $> q - -reply :: State -> IO State -reply q = spawnCommand "alacritty -e nvim -c 'read! mail-reply' -c 'execute \"normal gg\" | set filetype=mail'" $> q - -myKeymap :: String -> State -> IO State -myKeymap "h" = closeFold -myKeymap "l" = openFold -myKeymap " " = toggleFold - -myKeymap "g" = moveCursorToThread >=> moveCursorToFirstOnSameLevel -myKeymap "G" = moveCursorToThread >=> moveCursorToLastOnSameLevel -myKeymap "k" = moveCursorUp 1 -myKeymap "j" = moveCursorDown 1 -myKeymap "\ESC[A" = moveCursorDown 1 -myKeymap "\ESC[B" = moveCursorUp 1 -myKeymap "\ESC[C" = moveTreeLeft 10 -- left -myKeymap "\ESC[D" = moveTreeRight 10 -- right - -myKeymap "H" = moveCursorToThread - -myKeymap "r" = notmuchSearch - -myKeymap "R" = reply -myKeymap "S" = saveAttachment -myKeymap "o" = openAttachment - -myKeymap "q" = \q -> raiseSignal sigINT $> q - -myKeymap "*" = toggleTagAtCursor "flagged" -myKeymap "a" = toggleTagAtCursor "inbox" -- mnemonic: Archive -myKeymap "s" = toggleTagAtCursor "unread" -- mnemonic: Seen -myKeymap "d" = toggleTagAtCursor "deleted" -myKeymap "!" = toggleTagAtCursor "spam" - -myKeymap "N" = moveCursorUpToPrevUnread -myKeymap "n" = moveCursorDownToNextUnread - -myKeymap "K" = moveTreeDown 1 -myKeymap "J" = moveTreeUp 1 -myKeymap "\ESC[a" = moveTreeDown 1 -myKeymap "\ESC[b" = moveTreeUp 1 -myKeymap "\ESC[5~" = \q -> moveTreeDown (screenHeight q `div` 2) q -- PgUp -myKeymap "\ESC[6~" = \q -> moveTreeUp (screenHeight q `div` 2) q -- PgDn -myKeymap "\ESC[Z" = moveCursorUpToPrevUnread -- S-Tab -myKeymap "\DEL" = moveToParent -- backspace - --- -myKeymap "\ESC[11~" = \q@State{..} -> - return q { flashMessage = Plain $ show $ treeViewId $ Z.label cursor } - --- -myKeymap "\ESC[12~" = \q@State{..} -> - return q { flashMessage = - Plain $ - show $ - fmap messageFilename $ - getMessage $ - Z.label cursor - } - --- TODO Stuff Vim sends after exit (also there is more...) -myKeymap "\ESC[2;2R" = \q -> return q { flashMessage = flashMessage q <> " " <> Plain "stupid" } -myKeymap "\ESC[>85;95;0c" = \q -> return q { flashMessage = flashMessage q <> " " <> Plain "stupid" } - -myKeymap s = displayKey s - - -myMousemap :: Scan -> State -> IO State -myMousemap ScanMouse{mouseButton=1,mouseY=y} = defaultMouse1Click y -myMousemap ScanMouse{mouseButton=3,mouseY=y} = defaultMouse1Click y >=> toggleFold -myMousemap ScanMouse{mouseButton=4} = moveTreeDown 3 -myMousemap ScanMouse{mouseButton=5} = moveTreeUp 3 -myMousemap ScanMouse{mouseButton=0} = return -myMousemap info = displayMouse info diff --git a/config/tv.hs b/config/tv.hs deleted file mode 100644 index 84eda6b..0000000 --- a/config/tv.hs +++ /dev/null @@ -1,128 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - -module Main (main) where - -import Blessings.String.WCWidth -import Data.Default -import Data.Maybe -import Much.Action -import Much.Core -import Much.State -import Much.TreeView -import Scanner -import System.Environment (getEnv) -import System.IO.Unsafe (unsafePerformIO) -import Text.Hyphenation -import Text.LineBreak -import qualified Data.Tree as Tree -import qualified Data.Tree.Zipper as Z -import qualified Much.API -import qualified Notmuch.Message as Notmuch - - -scrollLines :: Int -scrollLines = - if unsafePerformIO (getEnv "TOUCHSCREEN") == "1" then - 1 - else - 3 - -main :: IO () -main = - mainWithState def - { apiConfig = def - { Much.API.socketPath = "/home/tv/tmp/much/warp.sock" - } - , keymap = myKeymap - , mousemap = myMousemap - } - -myKeymap :: String -> State -> IO State - -myKeymap "a" = toggleTagAtCursor "inbox" -myKeymap "s" = toggleTagAtCursor "unread" -myKeymap "g" = toggleTagAtCursor "killed" -myKeymap "f" = toggleTagAtCursor "star" -myKeymap "&" = toggleTagAtCursor "killed" -myKeymap "*" = toggleTagAtCursor "star" -myKeymap "k" = moveCursorUp 1 -myKeymap "j" = moveCursorDown 1 -myKeymap "K" = moveTreeDown 1 -myKeymap "J" = moveTreeUp 1 -myKeymap "H" = moveTreeRight 8 -myKeymap "L" = moveTreeLeft 8 -myKeymap "\ESC[A" = moveCursorUp 1 -myKeymap "\ESC[B" = moveCursorDown 1 -myKeymap "\ESC[a" = moveTreeDown 1 -myKeymap "\ESC[b" = moveTreeUp 1 -myKeymap "\ESC[c" = moveTreeLeft 8 -- S-Right -myKeymap "\ESC[d" = moveTreeRight 8 -- S-Left -myKeymap "\ESC[5~" = \q -> moveTreeDown (screenHeight q `div` 2) q -- PgUp -myKeymap "\ESC[6~" = \q -> moveTreeUp (screenHeight q `div` 2) q -- PgDn -myKeymap "\n" = toggleFold -myKeymap "\ESC[Z" = moveCursorUpToPrevUnread -- S-Tab -myKeymap "\t" = moveCursorDownToNextUnread -myKeymap "\DEL" = moveToParent -- backspace - --- TODO wrap/unwrap to separate module -myKeymap "=" = \q@State{..} -> - let cursor' = case Z.label cursor of - TVMessageLine a b c s -> - wrap (TVMessageLine a b c) cursor s - _ -> cursor - in return q { cursor = cursor' } - where - - --unwrap = error "WIP" - -- 1. get current id (must be TVMessageLine) - -- 2. find first adjoined TVMessageLine with same id - -- 3. find last adjoined TVMessageLine with same id - -- 4. join lines (with space?) - - wrap ctor loc s = - fromMaybe (error "die hard") $ - Z.nextTree $ - foldr (insert . ctor) - (Z.delete loc) - $ hy s - - insert a = - Z.prevSpace . Z.insert (Tree.Node a []) - - hy s = - breakStringLn bf s - where - shy = '\173' - hyp = Just german_1996 - bf = BreakFormat 80 8 shy hyp - --- -myKeymap "\ESC[11~" = \q@State{..} -> - return q { flashMessage = Plain $ show $ treeViewId $ Z.label cursor } - --- -myKeymap "\ESC[12~" = \q@State{..} -> - return q { flashMessage = - Plain $ - show $ - maybe Nothing (Just . Notmuch.messageFilename) $ - getMessage $ - Z.label cursor - } - --- TODO Stuff Vim sends after exit (also there is more...) -myKeymap "\ESC[2;2R" = \q -> return q { flashMessage = flashMessage q <> " " <> Plain "stupid" } -myKeymap "\ESC[>85;95;0c" = \q -> return q { flashMessage = flashMessage q <> " " <> Plain "stupid" } - -myKeymap s = displayKey s - - -myMousemap :: Scan -> State -> IO State -myMousemap ScanMouse{mouseButton=1,mouseY=y} = defaultMouse1Click y -myMousemap ScanMouse{mouseButton=3,mouseY=y} = \q -> defaultMouse1Click y q >>= toggleFold -myMousemap ScanMouse{mouseButton=4} = moveTreeDown scrollLines -myMousemap ScanMouse{mouseButton=5} = moveTreeUp scrollLines -myMousemap ScanMouse{mouseButton=0} = return -myMousemap info = displayMouse info diff --git a/much.cabal b/much.cabal index 4df50ad..9aae2a2 100644 --- a/much.cabal +++ b/much.cabal @@ -10,10 +10,10 @@ common common-stuff build-depends: blessings >= 2.5.0 -executable much-tv +executable much import: common-stuff - hs-source-dirs: config - main-is: tv.hs + hs-source-dirs: app + main-is: much.hs default-language: Haskell2010 ghc-options: -O2 -threaded -with-rtsopts=-N build-depends: much @@ -35,24 +35,6 @@ executable much-tv , containers , rosezipper -executable much-kmein - import: common-stuff - hs-source-dirs: config - main-is: kmein.hs - default-language: Haskell2010 - ghc-options: -O2 -threaded -with-rtsopts=-N - build-depends: much - , base - , bytestring - , data-default - , directory - , filepath - , process - , rosezipper - , terminal-scanner - , text - , unix - library import: common-stuff hs-source-dirs: src -- cgit v1.2.3