summaryrefslogtreecommitdiffstats
path: root/src/Much
diff options
context:
space:
mode:
authorKierán Meinhardt <kieran.meinhardt@gmail.com>2020-10-01 20:58:23 +0200
committerKierán Meinhardt <kieran.meinhardt@gmail.com>2020-10-01 20:58:23 +0200
commit92a67aaa55f5fee4a2b9a7357f1b9956a84cd188 (patch)
tree6881b60bed64dc03aaf230a16b6762f3983a88ae /src/Much
parenteff6fdb05bd33f6842034f68e8cb4b83503fd5f3 (diff)
State: add options for attachment saving
use Data.Default for Much.State.State, Much.State.ColorConfig, Much.API.Config refactor saveAttachment and openAttachment actions
Diffstat (limited to 'src/Much')
-rw-r--r--src/Much/API/Config.hs6
-rw-r--r--src/Much/Config.hs2
-rw-r--r--src/Much/Core.hs45
-rw-r--r--src/Much/State.hs59
4 files changed, 65 insertions, 47 deletions
diff --git a/src/Much/API/Config.hs b/src/Much/API/Config.hs
index 2e3b1cc..0a45068 100644
--- a/src/Much/API/Config.hs
+++ b/src/Much/API/Config.hs
@@ -1,11 +1,13 @@
module Much.API.Config where
+import Data.Default
+
data Config = Config
{ socketPath :: FilePath
}
-emptyConfig :: Config
-emptyConfig =
+instance Default Config where
+ def =
Config
{ socketPath = "/tmp/much.api.sock"
}
diff --git a/src/Much/Config.hs b/src/Much/Config.hs
index 5f4d6db..53c2891 100644
--- a/src/Much/Config.hs
+++ b/src/Much/Config.hs
@@ -12,6 +12,8 @@ data Config = Config
{ colorConfig :: Maybe (ColorConfig (Maybe [Word8]))
, query :: Maybe String
, tagSymbols :: Maybe (M.Map T.Text T.Text)
+ , attachmentOverwrite :: Maybe Bool
+ , attachmentDirectory :: Maybe FilePath
} deriving (Generic, Show)
instance FromJSON Config
diff --git a/src/Much/Core.hs b/src/Much/Core.hs
index 47d6706..9fb1ed3 100644
--- a/src/Much/Core.hs
+++ b/src/Much/Core.hs
@@ -28,58 +28,17 @@ import System.IO
import System.Posix.Signals
import qualified Blessings.Internal as Blessings
import qualified Data.Map as M
-import qualified Data.Tree as Tree
import qualified Data.Tree.Zipper as Z
import qualified Much.Config as Config
import qualified Notmuch
import qualified System.Console.Terminal.Size as Term
-
-
-emptyState :: State
-emptyState = State
- { cursor = Z.fromTree (Tree.Node (TVSearch "<emptyState>") [])
- , xoffset = 0
- , yoffset = 0
- , flashMessage = "Welcome to much; quit with ^C"
- , screenWidth = 0
- , screenHeight = 0
- , headBuffer = []
- , treeBuffer = []
- , now = UTCTime (fromGregorian 1984 5 23) 49062
- , signalHandlers = []
- , query = "tag:inbox AND NOT tag:killed"
- , keymap = displayKey
- , mousemap = displayMouse
- , colorConfig = ColorConfig
- { tagMap = M.fromList
- [ ("killed", SGR [38,5,088])
- , ("star", SGR [38,5,226])
- , ("draft", SGR [38,5,202])
- ]
- , alt = SGR [38,5,182]
- , search = SGR [38,5,162]
- , focus = SGR [38,5,160]
- , unprintableFocus = SGR [38,5,204]
- , unprintableNormal = SGR [35]
- , quote = SGR [38,5,242]
- , boring = SGR [38,5,240]
- , prefix = SGR [38,5,235]
- , date = SGR [38,5,071]
- , tags = SGR [38,5,036]
- , boringMessage = SGR [38,5,023]
- , unreadMessage = SGR [38,5,117]
- , unreadSearch = SGR [38,5,250]
- }
- , tagSymbols = M.empty
- , apiConfig = Much.API.emptyConfig
- }
-
-
importConfig :: Config.Config -> State -> State
importConfig config state = state
{ tagSymbols = fromMaybe (tagSymbols state) (Config.tagSymbols config)
, query = fromMaybe (query state) (Config.query config)
+ , attachmentDirectory = fromMaybe (attachmentDirectory state) (Config.attachmentDirectory config)
+ , attachmentOverwrite = fromMaybe (attachmentOverwrite state) (Config.attachmentOverwrite config)
, colorConfig =
let fromColorConfig key1 key2 = case Config.colorConfig config of
Just colorC -> maybe (key1 (colorConfig state)) SGR (key2 colorC)
diff --git a/src/Much/State.hs b/src/Much/State.hs
index 8bc2de9..551cdd0 100644
--- a/src/Much/State.hs
+++ b/src/Much/State.hs
@@ -1,18 +1,22 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
module Much.State where
-import Blessings.String (Blessings)
+import Blessings
import Data.Aeson
+import Data.Default
import Data.Time
import GHC.Generics
-import Much.TreeView (TreeView)
+import Much.TreeView (TreeView(TVSearch))
import Scanner
import System.Posix.Signals
import qualified Data.Map as M
import qualified Data.Text as T
+import qualified Data.Tree as Tree
import qualified Data.Tree.Zipper as Z
import qualified Much.API.Config
+import qualified Notmuch.Message as Notmuch
data State = State
{ cursor :: Z.TreePos Z.Full TreeView
@@ -31,6 +35,9 @@ data State = State
, tagSymbols :: M.Map T.Text T.Text
, colorConfig :: ColorConfig (Blessings String -> Blessings String)
, apiConfig :: Much.API.Config.Config
+ , attachmentOverwrite :: Bool
+ , attachmentDirectory :: FilePath
+ , attachmentFileName :: Notmuch.Message -> Notmuch.MessagePart -> FilePath
}
instance Show (State -> IO ()) where
@@ -53,4 +60,52 @@ data ColorConfig a = ColorConfig
, unprintableNormal :: a
} deriving (Generic, Show)
+instance Default (ColorConfig (Blessings String -> Blessings String)) where
+ def = ColorConfig
+ { tagMap = M.fromList
+ [ ("killed", SGR [38,5,088])
+ , ("star", SGR [38,5,226])
+ , ("draft", SGR [38,5,202])
+ ]
+ , alt = SGR [38,5,182]
+ , search = SGR [38,5,162]
+ , focus = SGR [38,5,160]
+ , unprintableFocus = SGR [38,5,204]
+ , unprintableNormal = SGR [35]
+ , quote = SGR [38,5,242]
+ , boring = SGR [38,5,240]
+ , prefix = SGR [38,5,235]
+ , date = SGR [38,5,071]
+ , tags = SGR [38,5,036]
+ , boringMessage = SGR [38,5,023]
+ , unreadMessage = SGR [38,5,117]
+ , unreadSearch = SGR [38,5,250]
+ }
+
instance FromJSON a => FromJSON (ColorConfig a)
+
+instance Default State where
+ def = State
+ { cursor = Z.fromTree (Tree.Node (TVSearch "<emptyState>") [])
+ , xoffset = 0
+ , yoffset = 0
+ , flashMessage = "Welcome to much; quit with ^C"
+ , screenWidth = 0
+ , screenHeight = 0
+ , headBuffer = []
+ , treeBuffer = []
+ , now = UTCTime (fromGregorian 1984 5 23) 49062
+ , signalHandlers = []
+ , query = "tag:inbox AND NOT tag:killed"
+ , keymap = const return
+ , mousemap = const return
+ , colorConfig = def
+ , tagSymbols = M.empty
+ , apiConfig = def
+ , attachmentOverwrite = False
+ , attachmentDirectory = "/tmp"
+ , attachmentFileName = \message part ->
+ case Notmuch.partContentFilename part of
+ Just partFileName -> T.unpack partFileName
+ Nothing -> concat [ "much_" , formatTime defaultTimeLocale "%s" (Notmuch.messageTime message) , "_" , show (Notmuch.partID part) ]
+ }