summaryrefslogtreecommitdiffstats
path: root/src/Much/Core.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Much/Core.hs')
-rw-r--r--src/Much/Core.hs89
1 files changed, 66 insertions, 23 deletions
diff --git a/src/Much/Core.hs b/src/Much/Core.hs
index e6dec8a..20b7ee3 100644
--- a/src/Much/Core.hs
+++ b/src/Much/Core.hs
@@ -4,28 +4,34 @@
{-# LANGUAGE RecordWildCards #-}
module Much.Core where
-import Much.Action
-import Much.API
import Blessings.String (Blessings(Plain,SGR),pp)
import Control.Concurrent
import Control.Monad
+import Data.Aeson
import Data.Functor
+import Data.Maybe
import Data.Time
+import Debug.Trace
+import Much.API
+import Much.Action
import Much.Event
import Much.RenderTreeView (renderTreeView)
-import Scanner (scan,Scan(..))
import Much.Screen
import Much.State
-import System.Console.Docopt.NoTH (getArgWithDefault, parseArgsOrExit, parseUsageOrExit, shortOption)
-import System.Environment
-import System.IO
-import System.Posix.Signals
import Much.TreeSearch
import Much.TreeView
import Much.Utils
+import Options.Applicative
+import Scanner (scan,Scan(..))
+import System.Environment
+import System.Exit
+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
@@ -47,7 +53,7 @@ emptyState = State
, keymap = displayKey
, mousemap = displayMouse
, colorConfig = ColorConfig
- { tagMap =
+ { tagMap = M.fromList
[ ("killed", SGR [38,5,088])
, ("star", SGR [38,5,226])
, ("draft", SGR [38,5,202])
@@ -64,9 +70,41 @@ emptyState = State
, unreadMessage = SGR [38,5,117]
, unreadSearch = SGR [38,5,250]
}
- , tagSymbols = []
+ , tagSymbols = M.empty
}
+
+importConfig :: Config.Config -> State -> State
+importConfig config state = state
+ { tagSymbols = fromMaybe (tagSymbols state) (Config.tagSymbols config)
+ , query = fromMaybe (query state) (Config.query config)
+ , colorConfig =
+ let fromColorConfig key1 key2 = case Config.colorConfig config of
+ Just colorC -> maybe (key1 (colorConfig state)) SGR (key2 colorC)
+ Nothing -> key1 (colorConfig state)
+ in ColorConfig
+ { tagMap =
+ case tagMap <$> Config.colorConfig config of
+ Just tagMap' ->
+ M.foldlWithKey
+ (\previous k v -> maybe previous (\code -> M.insert k (SGR code) previous) v)
+ (tagMap (colorConfig state))
+ tagMap'
+ Nothing -> tagMap (colorConfig state)
+ , alt = fromColorConfig alt alt
+ , search = fromColorConfig search search
+ , focus = fromColorConfig focus focus
+ , quote = fromColorConfig quote quote
+ , boring = fromColorConfig boring boring
+ , prefix = fromColorConfig prefix prefix
+ , date = fromColorConfig date date
+ , tags = fromColorConfig tags tags
+ , boringMessage = fromColorConfig boringMessage boringMessage
+ , unreadSearch = fromColorConfig unreadSearch unreadSearch
+ , unreadMessage = fromColorConfig unreadMessage unreadMessage
+ }
+ }
+
notmuchSearch :: State -> IO State
notmuchSearch q@State{query} = do
r_ <- either error id <$> Notmuch.search
@@ -77,26 +115,31 @@ notmuchSearch q@State{query} = do
return q { cursor = Z.fromTree $ fromSearchResults query r_ }
+
mainWithState :: State -> IO ()
mainWithState state = mainWithStateAndArgs state =<< getArgs
mainWithStateAndArgs :: State -> [String] -> IO ()
mainWithStateAndArgs state@State{query = defaultSearch} args = do
- usage' <- parseUsageOrExit usage
- args' <- parseArgsOrExit usage' args
- let query = getArgWithDefault args' defaultSearch (shortOption 'q')
- withScreen s0 (\_-> notmuchSearch state { query = query } >>= runState)
+ (query, maybeConfigPath) <- execParser (options defaultSearch)
+ newState <- case maybeConfigPath of
+ Just configPath -> do
+ eitherConfig <- eitherDecodeFileStrict configPath
+ case eitherConfig of
+ Left err -> do
+ hPutStrLn stderr err
+ exitFailure
+ Right config -> return $ importConfig config state
+ Nothing -> return state
+ withScreen s0 (\_-> notmuchSearch newState { query = query } >>= runState)
where
- usage = unlines
- [ "Command-line MUA using notmuch."
- , ""
- , "Usage:"
- , " much [-q <search-term>]"
- , ""
- , "Options:"
- , " -q <search-term>, --query=<search-term>"
- , " Open specific search, defaults to " ++ show defaultSearch
- ]
+ options defaultQuery =
+ info (muchArgs <**> helper) (fullDesc <> progDesc "Command-line MUA using notmuch.")
+ where
+ muchArgs =
+ (,)
+ <$> strOption (long "query" <> short 'q' <> metavar "QUERY" <> help "Open specific search" <> value defaultQuery <> showDefault)
+ <*> optional (strOption (long "config" <> short 'c' <> metavar "PATH" <> help "Import settings from a JSON config"))
s0 = Screen False NoBuffering (BlockBuffering $ Just 4096)
[ 1000 -- X & Y on button press and release