mirror of
https://github.com/danieljharvey/tmux-mate.git
synced 2024-09-11 16:46:40 +03:00
Add verbose mode, sanitise logging
This commit is contained in:
parent
61ad7110f5
commit
abf6c03566
15
app/Main.hs
15
app/Main.hs
@ -7,14 +7,15 @@ import TmuxMate
|
||||
main :: IO ()
|
||||
main = do
|
||||
options' <- execParser (info options fullDesc)
|
||||
didItWork <- loadTestSession (configPath options')
|
||||
didItWork <- loadTestSession options'
|
||||
case didItWork of
|
||||
Yeah -> exitWith ExitSuccess
|
||||
Nah i -> exitWith (ExitFailure i)
|
||||
|
||||
data Options
|
||||
= Options {configPath :: String}
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
options :: Parser Options
|
||||
options = Options <$> argument str (metavar "<path-to-config-file>")
|
||||
options :: Parser CLIOptions
|
||||
options =
|
||||
CLIOptions
|
||||
<$> ( ConfigFilePath
|
||||
<$> argument str (metavar "<path-to-config-file>")
|
||||
)
|
||||
<*> flag Silent Chatty (short 'v')
|
||||
|
@ -4,12 +4,16 @@
|
||||
module TmuxMate
|
||||
( loadTestSession,
|
||||
DidItWork (..),
|
||||
CLIOptions (..),
|
||||
ConfigFilePath (..),
|
||||
Verbosity (..),
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Dhall as Dhall
|
||||
import System.Process
|
||||
import TmuxMate.Commands
|
||||
import TmuxMate.Logger
|
||||
import TmuxMate.Running
|
||||
import TmuxMate.TmuxCommands
|
||||
import TmuxMate.Types
|
||||
@ -29,23 +33,26 @@ data DidItWork
|
||||
= Yeah
|
||||
| Nah Int
|
||||
|
||||
loadTestSession :: FilePath -> IO DidItWork
|
||||
loadTestSession path = do
|
||||
loadTestSession :: CLIOptions -> IO DidItWork
|
||||
loadTestSession options = do
|
||||
let (decoder :: Dhall.Decoder Session) = Dhall.auto
|
||||
let path = getConfigFilePath $ configFilePath options
|
||||
myLog = logger (verbosity options)
|
||||
config <- Dhall.inputFile decoder path
|
||||
case parseSession config of
|
||||
Left e -> do
|
||||
putStrLn $ "Error parsing config at " <> path
|
||||
print e
|
||||
myLog (show e)
|
||||
pure (Nah 1)
|
||||
Right config' -> do
|
||||
tmuxState <- askTmuxState
|
||||
-- print tmuxState
|
||||
myLog "Current tmux state"
|
||||
myLog (show tmuxState)
|
||||
let tmuxCommands = getTmuxCommands config' tmuxState
|
||||
-- putStrLn "Tmux Commands"
|
||||
-- print tmuxCommands
|
||||
myLog "Tmux Commands"
|
||||
_ <- traverse (myLog . show) tmuxCommands
|
||||
let commands = getCommands tmuxCommands
|
||||
-- putStrLn "Shell commands"
|
||||
-- print commands
|
||||
myLog "Shell commands"
|
||||
_ <- traverse (myLog . show) commands
|
||||
runCommands commands
|
||||
pure Yeah
|
||||
|
@ -69,7 +69,7 @@ quote s = "\"" <> s <> "\""
|
||||
|
||||
escape :: String -> String
|
||||
escape "" = ""
|
||||
escape ('\"':t) = "\\\"" <> escape t
|
||||
escape ('\"' : t) = "\\\"" <> escape t
|
||||
escape (x : xs) = x : escape xs
|
||||
|
||||
quoteAndEscape :: String -> String
|
||||
|
14
src/TmuxMate/Logger.hs
Normal file
14
src/TmuxMate/Logger.hs
Normal file
@ -0,0 +1,14 @@
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module TmuxMate.Logger
|
||||
( logger,
|
||||
)
|
||||
where
|
||||
|
||||
import TmuxMate.Types
|
||||
|
||||
logger :: Verbosity -> String -> IO ()
|
||||
logger Silent = const $ pure ()
|
||||
logger Chatty = putStrLn
|
@ -126,3 +126,22 @@ data VWindow
|
||||
vWindowPanes :: NonEmpty Pane
|
||||
}
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
|
||||
-------
|
||||
|
||||
data Verbosity
|
||||
= Silent
|
||||
| Chatty
|
||||
deriving
|
||||
(Eq, Ord, Show)
|
||||
|
||||
newtype ConfigFilePath
|
||||
= ConfigFilePath {getConfigFilePath :: String}
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data CLIOptions
|
||||
= CLIOptions
|
||||
{ configFilePath :: ConfigFilePath,
|
||||
verbosity :: Verbosity
|
||||
}
|
||||
deriving (Eq, Ord, Show)
|
||||
|
@ -1,8 +1,12 @@
|
||||
module TmuxMate.Validate where
|
||||
|
||||
import qualified Data.List as L
|
||||
import Data.List.NonEmpty
|
||||
import TmuxMate.Types
|
||||
|
||||
strip :: String -> String
|
||||
strip = L.reverse . L.dropWhile (== '\n') . L.reverse
|
||||
|
||||
parseSession :: Session -> Either ValidationError ValidatedSession
|
||||
parseSession sesh = do
|
||||
windows <- parseSessionWindows (sessionWindows sesh)
|
||||
@ -14,7 +18,7 @@ parseSession sesh = do
|
||||
|
||||
parseSessionName :: SessionName -> Either ValidationError VSessionName
|
||||
parseSessionName (SessionName str) =
|
||||
case nonEmpty str of
|
||||
case nonEmpty (strip str) of
|
||||
Just neStr -> Right (VSessionName neStr)
|
||||
_ -> Left EmptySessionName
|
||||
|
||||
@ -27,7 +31,7 @@ parseSessionWindows as = do
|
||||
|
||||
parseWindowName :: WindowName -> Either ValidationError VWindowName
|
||||
parseWindowName (WindowName str) =
|
||||
case nonEmpty str of
|
||||
case nonEmpty (strip str) of
|
||||
Just neStr -> Right (VWindowName neStr)
|
||||
_ -> Left EmptyWindowName
|
||||
|
||||
|
@ -20,6 +20,18 @@ spec = do
|
||||
}
|
||||
parseSession sesh
|
||||
`shouldBe` Left EmptySessionName
|
||||
it "Fails on just a newline" $ do
|
||||
let sesh = Session
|
||||
{ sessionTitle = SessionName "\n",
|
||||
sessionWindows =
|
||||
[ Window
|
||||
{ windowTitle = WindowName "OK",
|
||||
windowPanes = [Pane {paneCommand = PaneCommand ""}]
|
||||
}
|
||||
]
|
||||
}
|
||||
parseSession sesh
|
||||
`shouldBe` Left EmptySessionName
|
||||
it "Fails with no windows" $ do
|
||||
let sesh = Session
|
||||
{ sessionTitle = SessionName "Whoa",
|
||||
@ -39,6 +51,18 @@ spec = do
|
||||
}
|
||||
parseSession sesh
|
||||
`shouldBe` Left EmptyWindowName
|
||||
it "Fails on a newline" $ do
|
||||
let sesh = Session
|
||||
{ sessionTitle = SessionName "Whoa",
|
||||
sessionWindows =
|
||||
[ Window
|
||||
{ windowTitle = WindowName "\n",
|
||||
windowPanes = [Pane {paneCommand = PaneCommand ""}]
|
||||
}
|
||||
]
|
||||
}
|
||||
parseSession sesh
|
||||
`shouldBe` Left EmptyWindowName
|
||||
it "Fails with no window panes" $ do
|
||||
let sesh = Session
|
||||
{ sessionTitle = SessionName "Whoa",
|
||||
|
Loading…
Reference in New Issue
Block a user