full autostart support
git annex assistant --autostart will start separate daemons in each listed autostart repo running the webapp outside any git-annex repo will open it on the first listed autostart repo
This commit is contained in:
parent
23fe661d37
commit
60da0d6ad2
8 changed files with 134 additions and 23 deletions
|
@ -21,6 +21,7 @@ import Init
|
|||
import qualified Git.Construct
|
||||
import qualified Git.Config
|
||||
import qualified Annex
|
||||
import Locations.UserConfig
|
||||
|
||||
import Yesod
|
||||
import Data.Text (Text)
|
||||
|
@ -159,7 +160,10 @@ makeRepo path = do
|
|||
error "git init failed!"
|
||||
g <- Git.Config.read =<< Git.Construct.fromPath path
|
||||
state <- Annex.new g
|
||||
Annex.eval state $ initialize $ Just "new repo"
|
||||
Annex.eval state $ initialize $ Just "new repo" -- TODO better description
|
||||
autostart <- autoStartFile
|
||||
createDirectoryIfMissing True (parentDir autostart)
|
||||
appendFile autostart $ path ++ "\n"
|
||||
|
||||
getAddRepositoryR :: Handler RepHtml
|
||||
getAddRepositoryR = bootstrap (Just Config) $ do
|
||||
|
|
|
@ -46,6 +46,10 @@ writeDesktop command = do
|
|||
writeDesktopMenuFile (autostart command) $
|
||||
autoStartPath "git-annex" configdir
|
||||
|
||||
programfile <- programFile
|
||||
createDirectoryIfMissing True (parentDir programFile)
|
||||
writeFile programfile command
|
||||
|
||||
main = getArgs >>= go
|
||||
where
|
||||
go [] = error "specify git-annex command"
|
||||
|
|
|
@ -7,12 +7,66 @@
|
|||
|
||||
module Command.Assistant where
|
||||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import qualified Option
|
||||
import qualified Command.Watch
|
||||
import Init
|
||||
import Locations.UserConfig
|
||||
|
||||
import System.Environment
|
||||
import System.Posix.Directory
|
||||
|
||||
def :: [Command]
|
||||
def = [withOptions [Command.Watch.foregroundOption, Command.Watch.stopOption] $
|
||||
def = [noRepo checkAutoStart $ dontCheck repoExists $
|
||||
withOptions [Command.Watch.foregroundOption, Command.Watch.stopOption, autoStartOption] $
|
||||
command "assistant" paramNothing seek "automatically handle changes"]
|
||||
|
||||
autoStartOption :: Option
|
||||
autoStartOption = Option.flag [] "autostart" "start in known repositories"
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = Command.Watch.mkSeek True
|
||||
seek = [withFlag Command.Watch.stopOption $ \stopdaemon ->
|
||||
withFlag Command.Watch.foregroundOption $ \foreground ->
|
||||
withFlag autoStartOption $ \autostart ->
|
||||
withNothing $ start foreground stopdaemon autostart]
|
||||
|
||||
start :: Bool -> Bool -> Bool -> CommandStart
|
||||
start foreground stopdaemon autostart
|
||||
| autostart = do
|
||||
liftIO $ autoStart
|
||||
stop
|
||||
| otherwise = do
|
||||
ensureInitialized
|
||||
Command.Watch.start True foreground stopdaemon
|
||||
|
||||
{- Run outside a git repository. Check to see if any parameter is
|
||||
- --autostart and enter autostart mode. -}
|
||||
checkAutoStart :: IO ()
|
||||
checkAutoStart = ifM (any (== "--autostart") <$> getArgs)
|
||||
( autoStart
|
||||
, error "Not in a git repository."
|
||||
)
|
||||
|
||||
autoStart :: IO ()
|
||||
autoStart = do
|
||||
autostartfile <- autoStartFile
|
||||
let nothing = error $ "Nothing listed in " ++ autostartfile
|
||||
ifM (doesFileExist autostartfile)
|
||||
( do
|
||||
dirs <- lines <$> readFile autostartfile
|
||||
programfile <- programFile
|
||||
program <- catchDefaultIO (readFile programfile) "git-annex"
|
||||
when (null dirs) nothing
|
||||
forM_ dirs $ \d -> do
|
||||
putStrLn $ "git-annex autostart in " ++ d
|
||||
ifM (catchBoolIO $ go program d)
|
||||
( putStrLn "ok"
|
||||
, putStrLn "failed"
|
||||
)
|
||||
, nothing
|
||||
)
|
||||
where
|
||||
go program dir = do
|
||||
changeWorkingDirectory dir
|
||||
boolSystem program [Param "assistant"]
|
||||
|
|
|
@ -16,13 +16,10 @@ def :: [Command]
|
|||
def = [withOptions [foregroundOption, stopOption] $
|
||||
command "watch" paramNothing seek "watch for changes"]
|
||||
|
||||
mkSeek :: Bool -> [CommandSeek]
|
||||
mkSeek assistant = [withFlag stopOption $ \stopdaemon ->
|
||||
withFlag foregroundOption $ \foreground ->
|
||||
withNothing $ start assistant foreground stopdaemon]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = mkSeek False
|
||||
seek = [withFlag stopOption $ \stopdaemon ->
|
||||
withFlag foregroundOption $ \foreground ->
|
||||
withNothing $ start False foreground stopdaemon]
|
||||
|
||||
foregroundOption :: Option
|
||||
foregroundOption = Option.flag [] "foreground" "do not daemonize"
|
||||
|
|
|
@ -18,12 +18,14 @@ import Utility.Daemon (checkDaemon, lockPidFile)
|
|||
import Init
|
||||
import qualified Git.CurrentRepo
|
||||
import qualified Annex
|
||||
import Locations.UserConfig
|
||||
|
||||
import System.Posix.Directory
|
||||
import Control.Concurrent
|
||||
import Control.Concurrent.STM
|
||||
|
||||
def :: [Command]
|
||||
def = [oneShot $ noRepo firstRun $ dontCheck repoExists $
|
||||
def = [oneShot $ noRepo startNoRepo $ dontCheck repoExists $
|
||||
command "webapp" paramNothing seek "launch webapp"]
|
||||
|
||||
seek :: [CommandSeek]
|
||||
|
@ -31,7 +33,7 @@ seek = [withNothing start]
|
|||
|
||||
start :: CommandStart
|
||||
start = notBareRepo $ do
|
||||
ifM (isInitialized) ( go , liftIO firstRun )
|
||||
ifM (isInitialized) ( go , liftIO startNoRepo )
|
||||
stop
|
||||
where
|
||||
go = do
|
||||
|
@ -46,14 +48,24 @@ start = notBareRepo $ do
|
|||
liftIO $ isJust <$> checkDaemon pidfile
|
||||
checkshim f = liftIO $ doesFileExist f
|
||||
|
||||
openBrowser :: FilePath -> IO ()
|
||||
openBrowser htmlshim = unlessM (runBrowser url) $
|
||||
error $ "failed to start web browser on url " ++ url
|
||||
where
|
||||
url = fileUrl htmlshim
|
||||
{- When run without a repo, see if there is an autoStartFile,
|
||||
- and if so, start the first available listed repository.
|
||||
- If not, it's our first time being run! -}
|
||||
startNoRepo :: IO ()
|
||||
startNoRepo = do
|
||||
autostartfile <- autoStartFile
|
||||
ifM (doesFileExist autostartfile) ( autoStart autostartfile , firstRun )
|
||||
|
||||
fileUrl :: FilePath -> String
|
||||
fileUrl file = "file://" ++ file
|
||||
autoStart :: FilePath -> IO ()
|
||||
autoStart autostartfile = do
|
||||
dirs <- lines <$> readFile autostartfile
|
||||
edirs <- filterM doesDirectoryExist dirs
|
||||
case edirs of
|
||||
[] -> firstRun -- what else can I do? Nothing works..
|
||||
(d:_) -> do
|
||||
changeWorkingDirectory d
|
||||
state <- Annex.new =<< Git.CurrentRepo.get
|
||||
void $ Annex.eval state $ doCommand start
|
||||
|
||||
{- Run the webapp without a repository, which prompts the user, makes one,
|
||||
- changes to it, starts the regular assistant, and redirects the
|
||||
|
@ -92,3 +104,12 @@ firstRun = do
|
|||
{- Set up the pid file in the new repo. -}
|
||||
dummydaemonize = do
|
||||
liftIO . lockPidFile =<< fromRepo gitAnnexPidFile
|
||||
|
||||
openBrowser :: FilePath -> IO ()
|
||||
openBrowser htmlshim = unlessM (runBrowser url) $
|
||||
error $ "failed to start web browser on url " ++ url
|
||||
where
|
||||
url = fileUrl htmlshim
|
||||
|
||||
fileUrl :: FilePath -> String
|
||||
fileUrl file = "file://" ++ file
|
||||
|
|
26
Locations/UserConfig.hs
Normal file
26
Locations/UserConfig.hs
Normal file
|
@ -0,0 +1,26 @@
|
|||
{- git-annex user config files
|
||||
-
|
||||
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Locations.UserConfig where
|
||||
|
||||
import Utility.FreeDesktop
|
||||
|
||||
import System.FilePath
|
||||
|
||||
{- ~/.config/git-annex/file -}
|
||||
userConfigFile :: FilePath -> IO FilePath
|
||||
userConfigFile file = do
|
||||
dir <- userConfigDir
|
||||
return $ dir </> "git-annex" </> file
|
||||
|
||||
autoStartFile :: IO FilePath
|
||||
autoStartFile = userConfigFile "autostart"
|
||||
|
||||
{- The path to git-annex is written here; which is useful when cabal
|
||||
- has installed it to some aweful non-PATH location. -}
|
||||
programFile :: IO FilePath
|
||||
programFile = userConfigFile "program"
|
|
@ -23,10 +23,8 @@ module Utility.FreeDesktop (
|
|||
) where
|
||||
|
||||
import Utility.Exception
|
||||
import Utility.Directory
|
||||
import Utility.Path
|
||||
|
||||
import System.IO
|
||||
import System.Environment
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
|
|
|
@ -809,10 +809,17 @@ For example, this makes two copies be needed for wav files:
|
|||
|
||||
# FILES
|
||||
|
||||
These files are used by git-annex, in your git repository:
|
||||
These files are used by git-annex:
|
||||
|
||||
`.git/annex/objects/` contains the annexed file contents that are currently
|
||||
available. Annexed files in your git repository symlink to that content.
|
||||
`.git/annex/objects/` in your git repository contains the annexed file
|
||||
contents that are currently available. Annexed files in your git
|
||||
repository symlink to that content.
|
||||
|
||||
`.git/annex/` in your git repository contains other run-time information
|
||||
used by git-annex.
|
||||
|
||||
`~/.config/git-annex/autostart` is a list of git repositories
|
||||
to start the git-annex assistant in.
|
||||
|
||||
# SEE ALSO
|
||||
|
||||
|
|
Loading…
Reference in a new issue