State: add options for attachment saving

use Data.Default for Much.State.State, Much.State.ColorConfig, Much.API.Config
refactor saveAttachment and openAttachment actions

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) ]
+      }