Add opener script in config

5 files changed, 52 insertions, 54 deletions

diff --git a/lib/Daffm/Action/Commands.hs b/lib/Daffm/Action/Commands.hs
index e904bf5..a9b706f 100644
--- a/lib/Daffm/Action/Commands.hs
+++ b/lib/Daffm/Action/Commands.hs
@@ -3,11 +3,7 @@
 {-# HLINT ignore "Use for_" #-}
 module Daffm.Action.Commands where
 
-import Brick (suspendAndResume')
 import qualified Brick as M
-import qualified Brick.Widgets.List as L
-import Control.Monad (void)
-import Control.Monad.State (get)
 import Daffm.Action.Cmdline
 import Daffm.Action.Core
 import Daffm.Types
@@ -15,11 +11,7 @@ import Daffm.Utils (trimStart)
 import Data.Bifunctor (Bifunctor (second))
 import Data.Char (isSpace)
 import Data.Maybe (fromMaybe)
-import qualified Data.Set as Set
 import qualified Data.Text as Text
-import qualified GHC.IO.Exception as Proc
-import System.Exit (ExitCode)
-import qualified System.Process as Proc
 
 runCmdline :: AppEvent ()
 runCmdline = do
@@ -51,20 +43,6 @@ parseCommand cmd = mkCmd . splitCmdArgs $ trimStart cmd
       ("selection-clear", _) -> Just CmdClearSelection
       _ -> Nothing
 
--- Suspend tui and run shell command
--- When waitForKey is true, it will prompt for a key press on success
--- When exit code is non-zero, it will print it and prompt for key press regardless of waitForKey
-suspendAndRunShellCommand :: Bool -> Text.Text -> AppEvent ()
-suspendAndRunShellCommand waitForKey cmd = do
-  suspendAndResume' $ do
-    exitCode <- shellCommand $ Text.unpack cmd
-    case exitCode of
-      Proc.ExitFailure code -> do
-        putStrLn $ "Process exited with " <> show code
-        putStrLn "Press any key to continue" >> void getChar
-      _ | waitForKey -> putStrLn "Press any key to continue" >> void getChar
-      _ -> pure ()
-
 processCommand :: Command -> AppEvent ()
 processCommand (CmdShell waitForKey cmd) = do
   cmdSubstitutions cmd >>= suspendAndRunShellCommand waitForKey
@@ -81,28 +59,6 @@ processCommand CmdClearSelection = clearFileSelections
 processCommand CmdGoBack = goBackToParentDir
 processCommand CmdNoop = pure ()
 
-shellCommand :: String -> IO ExitCode
-shellCommand cmd = do
-  Proc.withCreateProcess
-    (Proc.shell cmd) {Proc.delegate_ctlc = True}
-    $ \_ _ _ p -> Proc.waitForProcess p
-
-cmdSubstitutions :: Text.Text -> AppEvent Text.Text
-cmdSubstitutions cmd = do
-  (AppState {stateFiles, stateCwd, stateFileSelections}) <- get
-  let file = maybe "" (filePath . snd) . L.listSelectedElement $ stateFiles
-  let escape = (\s -> "'" <> s <> "'") . Text.replace "'" "\\'"
-  let selections = Set.elems stateFileSelections
-  let selectionsOrCurrent = if Set.null stateFileSelections then [file] else selections
-  let subst =
-        Text.replace "%" file
-          . Text.replace "%d" stateCwd
-          . Text.replace "%s" (Text.unwords $ map escape selections)
-          . Text.replace "%S" (Text.dropWhileEnd (== '\n') $ Text.unlines selections)
-          . Text.replace "%f" (Text.unwords $ map escape selectionsOrCurrent)
-          . Text.replace "%F" (Text.dropWhileEnd (== '\n') $ Text.unlines selectionsOrCurrent)
-  pure . subst $ cmd
-
 evaluateCommand :: Text.Text -> AppEvent ()
 evaluateCommand cmdtxt =
   case parseCommand cmdtxt of
diff --git a/lib/Daffm/Action/Core.hs b/lib/Daffm/Action/Core.hs
index fef6b36..f80e41a 100644
--- a/lib/Daffm/Action/Core.hs
+++ b/lib/Daffm/Action/Core.hs
@@ -6,14 +6,17 @@ module Daffm.Action.Core where
 
 import Brick (suspendAndResume')
 import qualified Brick.Widgets.List as L
+import Control.Monad (void)
 import Control.Monad.State (MonadIO (liftIO), MonadState, get, gets, modify, put)
 import Daffm.State
 import Daffm.Types (AppEvent, AppState (..), FileInfo (..), FilePathText, FileType (..))
+import Data.Maybe (fromMaybe)
 import qualified Data.Set as Set
 import qualified Data.Text as Text
 import System.Directory (getHomeDirectory)
+import qualified System.Exit as Proc
 import System.FilePath (takeDirectory)
-import System.Process (callProcess)
+import qualified System.Process as Proc
 
 modifyM :: (MonadState s m) => (s -> m s) -> m ()
 modifyM f = get >>= f >>= put
@@ -33,8 +36,7 @@ goBackToParentDir = do
   loadDir dir
 
 changeDir :: FilePathText -> AppEvent ()
-changeDir dir = do
-  loadDir dir
+changeDir = loadDir
 
 goHome :: AppEvent ()
 goHome = do
@@ -43,15 +45,47 @@ goHome = do
 openSelectedFile :: AppEvent ()
 openSelectedFile = do
   currentFile >>= \case
-    Just file -> openFile file
+    Just (FileInfo {filePath, fileType = Directory}) -> loadDir filePath
+    Just _ -> do
+      opener <- gets (fromMaybe "echo '%F' | xargs -i xdg-open {}" . stateOpenerScript)
+      cmdSubstitutions opener >>= suspendAndRunShellCommand False
     Nothing -> pure ()
 
-openFile :: FileInfo -> AppEvent ()
-openFile (FileInfo {filePath, fileType = Directory}) = loadDir filePath
-openFile (FileInfo {filePath, fileType}) = do
+shellCommand :: String -> IO Proc.ExitCode
+shellCommand cmd = do
+  Proc.withCreateProcess
+    (Proc.shell cmd) {Proc.delegate_ctlc = True}
+    $ \_ _ _ p -> Proc.waitForProcess p
+
+cmdSubstitutions :: Text.Text -> AppEvent Text.Text
+cmdSubstitutions cmd = do
+  (AppState {stateFiles, stateCwd, stateFileSelections}) <- get
+  let file = maybe "" (filePath . snd) . L.listSelectedElement $ stateFiles
+  let escape = (\s -> "'" <> s <> "'") . Text.replace "'" "\\'"
+  let selections = Set.elems stateFileSelections
+  let selectionsOrCurrent = if Set.null stateFileSelections then [file] else selections
+  let subst =
+        Text.replace "%" file
+          . Text.replace "%d" stateCwd
+          . Text.replace "%s" (Text.unwords $ map escape selections)
+          . Text.replace "%S" (Text.dropWhileEnd (== '\n') $ Text.unlines selections)
+          . Text.replace "%f" (Text.unwords $ map escape selectionsOrCurrent)
+          . Text.replace "%F" (Text.dropWhileEnd (== '\n') $ Text.unlines selectionsOrCurrent)
+  pure . subst $ cmd
+
+-- Suspend tui and run shell command
+-- When waitForKey is true, it will prompt for a key press on success
+-- When exit code is non-zero, it will print it and prompt for key press regardless of waitForKey
+suspendAndRunShellCommand :: Bool -> Text.Text -> AppEvent ()
+suspendAndRunShellCommand waitForKey cmd = do
   suspendAndResume' $ do
-    putStrLn $ "Opening " <> show fileType <> ": " <> Text.unpack filePath
-    callProcess "nvim" [Text.unpack filePath]
+    exitCode <- shellCommand $ Text.unpack cmd
+    case exitCode of
+      Proc.ExitFailure code -> do
+        putStrLn $ "Process exited with " <> show code
+        putStrLn "Press any key to continue" >> void getChar
+      _ | waitForKey -> putStrLn "Press any key to continue" >> void getChar
+      _ -> pure ()
 
 currentFile :: AppEvent (Maybe FileInfo)
 currentFile = do
diff --git a/lib/Daffm/Configuration.hs b/lib/Daffm/Configuration.hs
index a27d616..cc4749d 100644
--- a/lib/Daffm/Configuration.hs
+++ b/lib/Daffm/Configuration.hs
@@ -27,9 +27,14 @@ configurationCodec :: Toml.TomlCodec Configuration
 configurationCodec =
   Configuration
     <$> (keymapCodec "keymap" .= configKeymap)
+    <*> (openerCodec "opener" .= configOpener)
     <*> pure Map.empty .= configTheme
   where
-    keymapCodec = Toml.dimap (const Map.empty) toKeymap . keymapRawCodec
+    openerCodec = Toml.dioptional . Toml.text
+
+keymapCodec :: Toml.Key -> Toml.TomlCodec Keymap
+keymapCodec = Toml.dimap (const Map.empty) toKeymap . keymapRawCodec
+  where
     keymapRawCodec = Toml.tableMap Toml._KeyText Toml.text
     toKeymap = Map.fromList . map (bimap toKeys toCmd) . Map.toList
     toKeys = fromMaybe [] . parseKeySequence
diff --git a/lib/Daffm/State.hs b/lib/Daffm/State.hs
index f04ebc9..52ac7a0 100644
--- a/lib/Daffm/State.hs
+++ b/lib/Daffm/State.hs
@@ -31,6 +31,7 @@ mkEmptyAppState config =
       stateFileSelections = Set.empty,
       stateCwd = "",
       stateKeyMap = defaultKeymaps <> configKeymap config,
+      stateOpenerScript = configOpener config,
       stateKeySequence = []
     }
   where
diff --git a/lib/Daffm/Types.hs b/lib/Daffm/Types.hs
index bf98e1c..39ad5a0 100644
--- a/lib/Daffm/Types.hs
+++ b/lib/Daffm/Types.hs
@@ -41,6 +41,7 @@ data AppState = AppState
     stateCwd :: FilePathText,
     stateListPositionHistory :: Map.Map Text.Text Int,
     stateKeySequence :: KeySequence,
+    stateOpenerScript :: Maybe Text.Text,
     stateKeyMap :: Keymap
   }
   deriving (Show)
@@ -75,6 +76,7 @@ type KeySequence = [Key]
 
 data Configuration = Configuration
   { configKeymap :: !Keymap,
+    configOpener :: Maybe Text.Text,
     configTheme :: !(Map.Map Text.Text Text.Text)
   }
   deriving (Show)