{-# LANGUAGE OverloadedStrings #-}
module GitHUD
( githud,
githudd,
)
where
import Control.Monad (unless, void, when)
import Control.Monad.Reader (runReader)
import Data.Text
import GitHUD.Config.Parse
import GitHUD.Config.Types
import GitHUD.Daemon.Runner
import GitHUD.Git.Command
import GitHUD.Git.Parse.Base
import GitHUD.Terminal.Prompt
import GitHUD.Terminal.Types
import GitHUD.Types
import System.Directory (getCurrentDirectory)
import System.Environment (getArgs)
import System.Exit (ExitCode (ExitSuccess))
import System.FileLock (SharedExclusive (Exclusive), withTryFileLock)
import System.Posix.Files (fileExist)
import System.Posix.User (UserEntry (..), getRealUserID, getUserEntryForID)
import System.Process (readProcessWithExitCode)
githud :: IO ()
githud :: IO ()
githud = do
Bool
isGit <- IO Bool
checkInGitDirectory
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isGit (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Shell
shell <- IO [String] -> IO Shell
processArguments IO [String]
getArgs
Config
config <- IO Config
getAppConfig
String
curDir <- IO String
getCurrentDirectory
String -> String -> IO ()
tryRunFetcherDaemon String
curDir (Config -> String
confGithuddLockFilePath Config
config)
GitRepoState
repoState <- IO GitRepoState
getGitRepoState
let prompt :: String
prompt = Reader OutputConfig String -> OutputConfig -> String
forall r a. Reader r a -> r -> a
runReader Reader OutputConfig String
buildPromptWithConfig (OutputConfig -> String) -> OutputConfig -> String
forall a b. (a -> b) -> a -> b
$ Shell -> GitRepoState -> Config -> OutputConfig
buildOutputConfig Shell
shell GitRepoState
repoState Config
config
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> Text
strip (String -> Text
pack String
prompt))
tryRunFetcherDaemon ::
String ->
FilePath ->
IO ()
tryRunFetcherDaemon :: String -> String -> IO ()
tryRunFetcherDaemon String
dir String
lockPath = do
String -> SharedExclusive -> (FileLock -> IO ()) -> IO (Maybe ())
forall a.
String -> SharedExclusive -> (FileLock -> IO a) -> IO (Maybe a)
withTryFileLock String
lockPath SharedExclusive
Exclusive (\FileLock
f -> String -> IO ()
runFetcherDaemon String
dir)
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
runFetcherDaemon :: String -> IO ()
runFetcherDaemon String
dir = do
(ExitCode
code, String
out, String
err) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"githudd" [String
dir] String
""
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null String
err) (String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Issue with githudd: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
processArguments ::
IO [String] ->
IO Shell
processArguments :: IO [String] -> IO Shell
processArguments IO [String]
args = [String] -> Shell
getShell ([String] -> Shell) -> IO [String] -> IO Shell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
args
getShell ::
[String] ->
Shell
getShell :: [String] -> Shell
getShell (String
"zsh" : [String]
_) = Shell
ZSH
getShell (String
"bash" : [String]
_) = Shell
BASH
getShell (String
"tmux" : [String]
_) = Shell
TMUX
getShell (String
"none" : [String]
_) = Shell
NONE
getShell [String]
_ = Shell
Other
getAppConfig :: IO Config
getAppConfig :: IO Config
getAppConfig = do
UserEntry
userEntry <- IO UserID
getRealUserID IO UserID -> (UserID -> IO UserEntry) -> IO UserEntry
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UserID -> IO UserEntry
getUserEntryForID
let configFilePath :: String
configFilePath = (UserEntry -> String
homeDirectory UserEntry
userEntry) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/.githudrc"
Bool
configFilePresent <- String -> IO Bool
fileExist String
configFilePath
if Bool
configFilePresent
then String -> IO Config
parseConfigFile String
configFilePath
else Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
defaultConfig
githudd :: IO ()
githudd :: IO ()
githudd = do
Maybe String
mArg <- [String] -> Maybe String
processDaemonArguments ([String] -> Maybe String) -> IO [String] -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
getArgs
Config
config <- IO Config
getAppConfig
Config -> Maybe String -> IO ()
runDaemon Config
config Maybe String
mArg
processDaemonArguments ::
[String] ->
Maybe String
processDaemonArguments :: [String] -> Maybe String
processDaemonArguments [] = Maybe String
forall a. Maybe a
Nothing
processDaemonArguments (String
fst : [String]
_) = String -> Maybe String
forall a. a -> Maybe a
Just String
fst