diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Much/API/Config.hs | 6 | ||||
| -rw-r--r-- | src/Much/Config.hs | 2 | ||||
| -rw-r--r-- | src/Much/Core.hs | 45 | ||||
| -rw-r--r-- | src/Much/State.hs | 59 | 
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) ] +      } | 
