app: drop kmein and make tv the default

3 files changed, 3 insertions, 207 deletions

diff --git a/config/tv.hs b/app/much.hs
index 84eda6b..84eda6b 100644
--- a/config/tv.hs
+++ b/app/much.hs
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
-
--- <F1>
-myKeymap "\ESC[11~" = \q@State{..} ->
-    return q { flashMessage = Plain $ show $ treeViewId $ Z.label cursor }
-
--- <F2>
-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/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