Add a /write-theme command to write the current theme to an INI file

Author: jtdaugherty

docs/commands.md

@@ -58,3 +58,4 @@
 | `/topic <topic>` | Set the current channel's topic (header) |
 | `/user` | Show users to initiate a private DM chat channel |
 | `/username-attribute <@user>` | Display the attribute used to color the specified username |
+| `/write-theme <path>` | Write the current theme to a theme settings file |

src/Matterhorn/Command.hs

@@ -12,6 +12,7 @@ import           Prelude ()
 import           Matterhorn.Prelude
 
 import           Brick.Main ( invalidateCache )
+import           Brick.Themes ( saveTheme )
 import qualified Control.Exception as Exn
 import qualified Data.Char as Char
 import qualified Data.Text as T
@@ -133,6 +134,12 @@ commandList =
     NoArg $ \ () -> do
         withCurrentTeam enterChannelMembersUserList
 
+  , Cmd "write-theme" "Write the current theme to a theme settings file"
+    (TokenArg "path" NoArg) $ \(path, ()) -> do
+        theme <- use (csResources.crThemeOriginal)
+        liftIO $ saveTheme (T.unpack path) theme
+        postInfoMessage $ "Current theme written to " <> path
+
   , Cmd "leave" "Leave a normal channel or hide a DM channel" NoArg $ \ () -> do
         withCurrentTeam startLeaveCurrentChannel
 

src/Matterhorn/State/Setup.hs

@@ -161,6 +161,7 @@ setupState mkVty mLogLocation config = do
                            , _crSubprocessLog       = slc
                            , _crWebsocketActionChan = wac
                            , _crTheme               = themeToAttrMap custTheme
+                           , _crThemeOriginal       = custTheme
                            , _crStatusUpdateChan    = userStatusChan
                            , _crConfiguration       = config
                            , _crFlaggedPosts        = mempty

src/Matterhorn/State/ThemeListWindow.hs

@@ -85,3 +85,4 @@ setTheme tId name =
         Just it -> do
             mh invalidateCache
             csResources.crTheme .= (themeToAttrMap $ internalTheme it)
+            csResources.crThemeOriginal .= internalTheme it

src/Matterhorn/Types.hs

@@ -235,6 +235,7 @@ module Matterhorn.Types
   , crUserPreferences
   , crEventQueue
   , crTheme
+  , crThemeOriginal
   , crStatusUpdateChan
   , crSubprocessLog
   , crWebsocketActionChan
@@ -1070,6 +1071,7 @@ data ChatResources =
                   , _crSubprocessLog       :: STM.TChan ProgramOutput
                   , _crWebsocketActionChan :: STM.TChan WebsocketAction
                   , _crTheme               :: AttrMap
+                  , _crThemeOriginal       :: Theme
                   , _crStatusUpdateChan    :: STM.TChan [UserId]
                   , _crConfiguration       :: Config
                   , _crFlaggedPosts        :: Set PostId