everything is building again
However, the test suite fails some quickchecks, so this branch is not yet in a mergeable state.
This commit is contained in:
parent
c20f4704a7
commit
3266ad3ff7
14 changed files with 51 additions and 35 deletions
|
@ -5,6 +5,8 @@
|
||||||
- Licensed under the GNU AGPL version 3 or higher.
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Assistant.MakeRemote where
|
module Assistant.MakeRemote where
|
||||||
|
|
||||||
import Assistant.Common
|
import Assistant.Common
|
||||||
|
|
|
@ -5,6 +5,8 @@
|
||||||
- Licensed under the GNU AGPL version 3 or higher.
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Assistant.MakeRepo where
|
module Assistant.MakeRepo where
|
||||||
|
|
||||||
import Assistant.WebApp.Common
|
import Assistant.WebApp.Common
|
||||||
|
|
|
@ -5,6 +5,8 @@
|
||||||
- Licensed under the GNU AGPL version 3 or higher.
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Assistant.Sync where
|
module Assistant.Sync where
|
||||||
|
|
||||||
import Assistant.Common
|
import Assistant.Common
|
||||||
|
|
|
@ -286,7 +286,7 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do
|
||||||
ks = keySource ld
|
ks = keySource ld
|
||||||
doadd = sanitycheck ks $ do
|
doadd = sanitycheck ks $ do
|
||||||
(mkey, _mcache) <- liftAnnex $ do
|
(mkey, _mcache) <- liftAnnex $ do
|
||||||
showStart "add" $ keyFilename ks
|
showStart "add" $ toRawFilePath $ keyFilename ks
|
||||||
ingest nullMeterUpdate (Just $ LockedDown lockdownconfig ks) Nothing
|
ingest nullMeterUpdate (Just $ LockedDown lockdownconfig ks) Nothing
|
||||||
maybe (failedingest change) (done change $ keyFilename ks) mkey
|
maybe (failedingest change) (done change $ keyFilename ks) mkey
|
||||||
add _ _ = return Nothing
|
add _ _ = return Nothing
|
||||||
|
@ -325,7 +325,7 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do
|
||||||
removedKeysMap :: InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key)
|
removedKeysMap :: InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key)
|
||||||
removedKeysMap ct l = do
|
removedKeysMap ct l = do
|
||||||
mks <- forM (filter isRmChange l) $ \c ->
|
mks <- forM (filter isRmChange l) $ \c ->
|
||||||
catKeyFile $ changeFile c
|
catKeyFile $ toRawFilePath $ changeFile c
|
||||||
M.fromList . concat <$> mapM mkpairs (catMaybes mks)
|
M.fromList . concat <$> mapM mkpairs (catMaybes mks)
|
||||||
where
|
where
|
||||||
mkpairs k = map (\c -> (inodeCacheToKey ct c, k)) <$>
|
mkpairs k = map (\c -> (inodeCacheToKey ct c, k)) <$>
|
||||||
|
@ -339,7 +339,7 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do
|
||||||
done change file key = liftAnnex $ do
|
done change file key = liftAnnex $ do
|
||||||
logStatus key InfoPresent
|
logStatus key InfoPresent
|
||||||
mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
|
mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
|
||||||
stagePointerFile file mode =<< hashPointerFile key
|
stagePointerFile (toRawFilePath file) mode =<< hashPointerFile key
|
||||||
showEndOk
|
showEndOk
|
||||||
return $ Just $ finishedChange change key
|
return $ Just $ finishedChange change key
|
||||||
|
|
||||||
|
@ -457,5 +457,5 @@ checkChangeContent change@(Change { changeInfo = i }) =
|
||||||
handleDrops "file renamed" present k af []
|
handleDrops "file renamed" present k af []
|
||||||
where
|
where
|
||||||
f = changeFile change
|
f = changeFile change
|
||||||
af = AssociatedFile (Just f)
|
af = AssociatedFile (Just (toRawFilePath f))
|
||||||
checkChangeContent _ = noop
|
checkChangeContent _ = noop
|
||||||
|
|
|
@ -44,7 +44,8 @@ configMonitorThread = namedThread "ConfigMonitor" $ loop =<< getConfigs
|
||||||
when (old /= new) $ do
|
when (old /= new) $ do
|
||||||
let changedconfigs = new `S.difference` old
|
let changedconfigs = new `S.difference` old
|
||||||
debug $ "reloading config" :
|
debug $ "reloading config" :
|
||||||
map fst (S.toList changedconfigs)
|
map (fromRawFilePath . fst)
|
||||||
|
(S.toList changedconfigs)
|
||||||
reloadConfigs new
|
reloadConfigs new
|
||||||
{- Record a commit to get this config
|
{- Record a commit to get this config
|
||||||
- change pushed out to remotes. -}
|
- change pushed out to remotes. -}
|
||||||
|
@ -53,10 +54,10 @@ configMonitorThread = namedThread "ConfigMonitor" $ loop =<< getConfigs
|
||||||
loop new
|
loop new
|
||||||
|
|
||||||
{- Config files, and their checksums. -}
|
{- Config files, and their checksums. -}
|
||||||
type Configs = S.Set (FilePath, Sha)
|
type Configs = S.Set (RawFilePath, Sha)
|
||||||
|
|
||||||
{- All git-annex's config files, and actions to run when they change. -}
|
{- All git-annex's config files, and actions to run when they change. -}
|
||||||
configFilesActions :: [(FilePath, Assistant ())]
|
configFilesActions :: [(RawFilePath, Assistant ())]
|
||||||
configFilesActions =
|
configFilesActions =
|
||||||
[ (uuidLog, void $ liftAnnex uuidDescMapLoad)
|
[ (uuidLog, void $ liftAnnex uuidDescMapLoad)
|
||||||
, (remoteLog, void $ liftAnnex remoteListRefresh)
|
, (remoteLog, void $ liftAnnex remoteListRefresh)
|
||||||
|
@ -89,5 +90,5 @@ getConfigs :: Assistant Configs
|
||||||
getConfigs = S.fromList . map extract
|
getConfigs = S.fromList . map extract
|
||||||
<$> liftAnnex (inRepo $ LsTree.lsTreeFiles Annex.Branch.fullname files)
|
<$> liftAnnex (inRepo $ LsTree.lsTreeFiles Annex.Branch.fullname files)
|
||||||
where
|
where
|
||||||
files = map fst configFilesActions
|
files = map (fromRawFilePath . fst) configFilesActions
|
||||||
extract treeitem = (getTopFilePath $ LsTree.file treeitem, LsTree.sha treeitem)
|
extract treeitem = (toRawFilePath $ getTopFilePath $ LsTree.file treeitem, LsTree.sha treeitem)
|
||||||
|
|
|
@ -155,10 +155,11 @@ dailyCheck urlrenderer = do
|
||||||
(unstaged, cleanup) <- liftIO $ Git.LsFiles.notInRepo False ["."] g
|
(unstaged, cleanup) <- liftIO $ Git.LsFiles.notInRepo False ["."] g
|
||||||
now <- liftIO getPOSIXTime
|
now <- liftIO getPOSIXTime
|
||||||
forM_ unstaged $ \file -> do
|
forM_ unstaged $ \file -> do
|
||||||
ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
|
let file' = fromRawFilePath file
|
||||||
|
ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file'
|
||||||
case ms of
|
case ms of
|
||||||
Just s | toonew (statusChangeTime s) now -> noop
|
Just s | toonew (statusChangeTime s) now -> noop
|
||||||
| isSymbolicLink s -> addsymlink file ms
|
| isSymbolicLink s -> addsymlink file' ms
|
||||||
_ -> noop
|
_ -> noop
|
||||||
liftIO $ void cleanup
|
liftIO $ void cleanup
|
||||||
|
|
||||||
|
|
|
@ -136,10 +136,12 @@ startupScan scanner = do
|
||||||
-- Notice any files that were deleted before
|
-- Notice any files that were deleted before
|
||||||
-- watching was started.
|
-- watching was started.
|
||||||
top <- liftAnnex $ fromRepo Git.repoPath
|
top <- liftAnnex $ fromRepo Git.repoPath
|
||||||
(fs, cleanup) <- liftAnnex $ inRepo $ LsFiles.deleted [top]
|
(fs, cleanup) <- liftAnnex $ inRepo $ LsFiles.deleted
|
||||||
|
[toRawFilePath top]
|
||||||
forM_ fs $ \f -> do
|
forM_ fs $ \f -> do
|
||||||
liftAnnex $ onDel' f
|
let f' = fromRawFilePath f
|
||||||
maybe noop recordChange =<< madeChange f RmChange
|
liftAnnex $ onDel' f'
|
||||||
|
maybe noop recordChange =<< madeChange f' RmChange
|
||||||
void $ liftIO cleanup
|
void $ liftIO cleanup
|
||||||
|
|
||||||
liftAnnex $ showAction "started"
|
liftAnnex $ showAction "started"
|
||||||
|
@ -206,7 +208,7 @@ shouldRestage ds = scanComplete ds || forceRestage ds
|
||||||
|
|
||||||
onAddUnlocked :: Bool -> GetFileMatcher -> Handler
|
onAddUnlocked :: Bool -> GetFileMatcher -> Handler
|
||||||
onAddUnlocked symlinkssupported matcher f fs = do
|
onAddUnlocked symlinkssupported matcher f fs = do
|
||||||
mk <- liftIO $ isPointerFile f
|
mk <- liftIO $ isPointerFile $ toRawFilePath f
|
||||||
case mk of
|
case mk of
|
||||||
Nothing -> onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkssupported matcher f fs
|
Nothing -> onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkssupported matcher f fs
|
||||||
Just k -> addlink f k
|
Just k -> addlink f k
|
||||||
|
@ -228,7 +230,7 @@ onAddUnlocked symlinkssupported matcher f fs = do
|
||||||
logStatus oldkey InfoMissing
|
logStatus oldkey InfoMissing
|
||||||
addlink file key = do
|
addlink file key = do
|
||||||
mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
|
mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
|
||||||
liftAnnex $ stagePointerFile file mode =<< hashPointerFile key
|
liftAnnex $ stagePointerFile (toRawFilePath file) mode =<< hashPointerFile key
|
||||||
madeChange file $ LinkChange (Just key)
|
madeChange file $ LinkChange (Just key)
|
||||||
|
|
||||||
onAddUnlocked'
|
onAddUnlocked'
|
||||||
|
@ -240,7 +242,7 @@ onAddUnlocked'
|
||||||
-> GetFileMatcher
|
-> GetFileMatcher
|
||||||
-> Handler
|
-> Handler
|
||||||
onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkssupported matcher file fs = do
|
onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkssupported matcher file fs = do
|
||||||
v <- liftAnnex $ catKeyFile file
|
v <- liftAnnex $ catKeyFile (toRawFilePath file)
|
||||||
case (v, fs) of
|
case (v, fs) of
|
||||||
(Just key, Just filestatus) ->
|
(Just key, Just filestatus) ->
|
||||||
ifM (liftAnnex $ samefilestatus key file filestatus)
|
ifM (liftAnnex $ samefilestatus key file filestatus)
|
||||||
|
@ -270,7 +272,8 @@ onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkss
|
||||||
guardSymlinkStandin mk a
|
guardSymlinkStandin mk a
|
||||||
| symlinkssupported = a
|
| symlinkssupported = a
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
linktarget <- liftAnnex $ getAnnexLinkTarget file
|
linktarget <- liftAnnex $ getAnnexLinkTarget $
|
||||||
|
toRawFilePath file
|
||||||
case linktarget of
|
case linktarget of
|
||||||
Nothing -> a
|
Nothing -> a
|
||||||
Just lt -> do
|
Just lt -> do
|
||||||
|
@ -287,7 +290,7 @@ onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkss
|
||||||
onAddSymlink :: Handler
|
onAddSymlink :: Handler
|
||||||
onAddSymlink file filestatus = unlessIgnored file $ do
|
onAddSymlink file filestatus = unlessIgnored file $ do
|
||||||
linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file)
|
linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file)
|
||||||
kv <- liftAnnex (lookupFile file)
|
kv <- liftAnnex (lookupFile (toRawFilePath file))
|
||||||
onAddSymlink' linktarget kv file filestatus
|
onAddSymlink' linktarget kv file filestatus
|
||||||
|
|
||||||
onAddSymlink' :: Maybe String -> Maybe Key -> Handler
|
onAddSymlink' :: Maybe String -> Maybe Key -> Handler
|
||||||
|
@ -299,7 +302,7 @@ onAddSymlink' linktarget mk file filestatus = go mk
|
||||||
then ensurestaged (Just link) =<< getDaemonStatus
|
then ensurestaged (Just link) =<< getDaemonStatus
|
||||||
else do
|
else do
|
||||||
liftAnnex $ replaceFile file $
|
liftAnnex $ replaceFile file $
|
||||||
makeAnnexLink link
|
makeAnnexLink link . toRawFilePath
|
||||||
addLink file link (Just key)
|
addLink file link (Just key)
|
||||||
-- other symlink, not git-annex
|
-- other symlink, not git-annex
|
||||||
go Nothing = ensurestaged linktarget =<< getDaemonStatus
|
go Nothing = ensurestaged linktarget =<< getDaemonStatus
|
||||||
|
@ -332,8 +335,8 @@ addLink file link mk = do
|
||||||
case v of
|
case v of
|
||||||
Just (currlink, sha, _type)
|
Just (currlink, sha, _type)
|
||||||
| s2w8 link == L.unpack currlink ->
|
| s2w8 link == L.unpack currlink ->
|
||||||
stageSymlink file sha
|
stageSymlink (toRawFilePath file) sha
|
||||||
_ -> stageSymlink file =<< hashSymlink link
|
_ -> stageSymlink (toRawFilePath file) =<< hashSymlink link
|
||||||
madeChange file $ LinkChange mk
|
madeChange file $ LinkChange mk
|
||||||
|
|
||||||
onDel :: Handler
|
onDel :: Handler
|
||||||
|
@ -349,7 +352,7 @@ onDel' file = do
|
||||||
Annex.Queue.addUpdateIndex =<<
|
Annex.Queue.addUpdateIndex =<<
|
||||||
inRepo (Git.UpdateIndex.unstageFile file)
|
inRepo (Git.UpdateIndex.unstageFile file)
|
||||||
where
|
where
|
||||||
withkey a = maybe noop a =<< catKeyFile file
|
withkey a = maybe noop a =<< catKeyFile (toRawFilePath file)
|
||||||
|
|
||||||
{- A directory has been deleted, or moved, so tell git to remove anything
|
{- A directory has been deleted, or moved, so tell git to remove anything
|
||||||
- that was inside it from its cache. Since it could reappear at any time,
|
- that was inside it from its cache. Since it could reappear at any time,
|
||||||
|
@ -360,14 +363,15 @@ onDel' file = do
|
||||||
onDelDir :: Handler
|
onDelDir :: Handler
|
||||||
onDelDir dir _ = do
|
onDelDir dir _ = do
|
||||||
debug ["directory deleted", dir]
|
debug ["directory deleted", dir]
|
||||||
(fs, clean) <- liftAnnex $ inRepo $ LsFiles.deleted [dir]
|
(fs, clean) <- liftAnnex $ inRepo $ LsFiles.deleted [toRawFilePath dir]
|
||||||
|
let fs' = map fromRawFilePath fs
|
||||||
|
|
||||||
liftAnnex $ mapM_ onDel' fs
|
liftAnnex $ mapM_ onDel' fs'
|
||||||
|
|
||||||
-- Get the events queued up as fast as possible, so the
|
-- Get the events queued up as fast as possible, so the
|
||||||
-- committer sees them all in one block.
|
-- committer sees them all in one block.
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
recordChanges $ map (\f -> Change now f RmChange) fs
|
recordChanges $ map (\f -> Change now f RmChange) fs'
|
||||||
|
|
||||||
void $ liftIO clean
|
void $ liftIO clean
|
||||||
noChange
|
noChange
|
||||||
|
|
|
@ -161,7 +161,7 @@ genTransfer t info = case transferRemote info of
|
||||||
AssociatedFile Nothing -> noop
|
AssociatedFile Nothing -> noop
|
||||||
AssociatedFile (Just af) -> void $
|
AssociatedFile (Just af) -> void $
|
||||||
addAlert $ makeAlertFiller True $
|
addAlert $ makeAlertFiller True $
|
||||||
transferFileAlert direction True af
|
transferFileAlert direction True (fromRawFilePath af)
|
||||||
unless isdownload $
|
unless isdownload $
|
||||||
handleDrops
|
handleDrops
|
||||||
("object uploaded to " ++ show remote)
|
("object uploaded to " ++ show remote)
|
||||||
|
|
|
@ -87,7 +87,7 @@ startDistributionDownload d = go =<< liftIO . newVersionLocation d =<< liftIO ol
|
||||||
hook <- asIO1 $ distributionDownloadComplete d dest cleanup
|
hook <- asIO1 $ distributionDownloadComplete d dest cleanup
|
||||||
modifyDaemonStatus_ $ \s -> s
|
modifyDaemonStatus_ $ \s -> s
|
||||||
{ transferHook = M.insert k hook (transferHook s) }
|
{ transferHook = M.insert k hook (transferHook s) }
|
||||||
maybe noop (queueTransfer "upgrade" Next (AssociatedFile (Just f)) t)
|
maybe noop (queueTransfer "upgrade" Next (AssociatedFile (Just (toRawFilePath f))) t)
|
||||||
=<< liftAnnex (remoteFromUUID webUUID)
|
=<< liftAnnex (remoteFromUUID webUUID)
|
||||||
startTransfer t
|
startTransfer t
|
||||||
k = mkKey $ const $ distributionKey d
|
k = mkKey $ const $ distributionKey d
|
||||||
|
|
|
@ -101,11 +101,12 @@ setRepoConfig uuid mremote oldc newc = do
|
||||||
- there's not. Special remotes don't normally
|
- there's not. Special remotes don't normally
|
||||||
- have that, and don't use it. Temporarily add
|
- have that, and don't use it. Temporarily add
|
||||||
- it if it's missing. -}
|
- it if it's missing. -}
|
||||||
let remotefetch = "remote." ++ T.unpack (repoName oldc) ++ ".fetch"
|
let remotefetch = Git.ConfigKey $ encodeBS' $
|
||||||
|
"remote." ++ T.unpack (repoName oldc) ++ ".fetch"
|
||||||
needfetch <- isNothing <$> fromRepo (Git.Config.getMaybe remotefetch)
|
needfetch <- isNothing <$> fromRepo (Git.Config.getMaybe remotefetch)
|
||||||
when needfetch $
|
when needfetch $
|
||||||
inRepo $ Git.Command.run
|
inRepo $ Git.Command.run
|
||||||
[Param "config", Param remotefetch, Param ""]
|
[Param "config", Param (Git.fromConfigKey remotefetch), Param ""]
|
||||||
inRepo $ Git.Command.run
|
inRepo $ Git.Command.run
|
||||||
[ Param "remote"
|
[ Param "remote"
|
||||||
, Param "rename"
|
, Param "rename"
|
||||||
|
|
|
@ -336,7 +336,7 @@ getFinishAddDriveR drive = go
|
||||||
isnew <- liftIO $ makeRepo dir True
|
isnew <- liftIO $ makeRepo dir True
|
||||||
{- Removable drives are not reliable media, so enable fsync. -}
|
{- Removable drives are not reliable media, so enable fsync. -}
|
||||||
liftIO $ inDir dir $
|
liftIO $ inDir dir $
|
||||||
setConfig (ConfigKey "core.fsyncobjectfiles")
|
setConfig "core.fsyncobjectfiles"
|
||||||
(Git.Config.boolConfig True)
|
(Git.Config.boolConfig True)
|
||||||
(u, r) <- a isnew
|
(u, r) <- a isnew
|
||||||
when isnew $
|
when isnew $
|
||||||
|
|
|
@ -20,7 +20,7 @@ import Types.StandardGroups
|
||||||
import Utility.UserInfo
|
import Utility.UserInfo
|
||||||
import Utility.Gpg
|
import Utility.Gpg
|
||||||
import Types.Remote (RemoteConfig)
|
import Types.Remote (RemoteConfig)
|
||||||
import Git.Types (RemoteName, fromRef)
|
import Git.Types (RemoteName, fromRef, fromConfigKey)
|
||||||
import qualified Remote.GCrypt as GCrypt
|
import qualified Remote.GCrypt as GCrypt
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Git.Command
|
import qualified Git.Command
|
||||||
|
@ -317,7 +317,8 @@ testServer sshinput@(SshInput { inputHostname = Just hn }) = do
|
||||||
else T.pack $ "Failed to ssh to the server. Transcript: " ++ s
|
else T.pack $ "Failed to ssh to the server. Transcript: " ++ s
|
||||||
finduuid (k, v)
|
finduuid (k, v)
|
||||||
| k == "annex.uuid" = Just $ toUUID v
|
| k == "annex.uuid" = Just $ toUUID v
|
||||||
| k == GCrypt.coreGCryptId = Just $ genUUIDInNameSpace gCryptNameSpace v
|
| k == fromConfigKey GCrypt.coreGCryptId =
|
||||||
|
Just $ genUUIDInNameSpace gCryptNameSpace v
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
|
|
||||||
checkcommand c = "if which " ++ c ++ "; then " ++ report c ++ "; fi"
|
checkcommand c = "if which " ++ c ++ "; then " ++ report c ++ "; fi"
|
||||||
|
|
|
@ -45,7 +45,7 @@ transfersDisplay = do
|
||||||
transferPaused info || isNothing (startedTime info)
|
transferPaused info || isNothing (startedTime info)
|
||||||
desc transfer info = case associatedFile info of
|
desc transfer info = case associatedFile info of
|
||||||
AssociatedFile Nothing -> serializeKey $ transferKey transfer
|
AssociatedFile Nothing -> serializeKey $ transferKey transfer
|
||||||
AssociatedFile (Just af) -> af
|
AssociatedFile (Just af) -> fromRawFilePath af
|
||||||
|
|
||||||
{- Simplifies a list of transfers, avoiding display of redundant
|
{- Simplifies a list of transfers, avoiding display of redundant
|
||||||
- equivilant transfers. -}
|
- equivilant transfers. -}
|
||||||
|
|
|
@ -6,6 +6,7 @@
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Command.WebApp where
|
module Command.WebApp where
|
||||||
|
|
||||||
|
@ -22,6 +23,7 @@ import Utility.Daemon (checkDaemon)
|
||||||
import Utility.UserInfo
|
import Utility.UserInfo
|
||||||
import Annex.Init
|
import Annex.Init
|
||||||
import qualified Git
|
import qualified Git
|
||||||
|
import Git.Types (fromConfigValue)
|
||||||
import qualified Git.Config
|
import qualified Git.Config
|
||||||
import qualified Git.CurrentRepo
|
import qualified Git.CurrentRepo
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
|
@ -229,7 +231,7 @@ openBrowser' mcmd htmlshim realurl outh errh =
|
||||||
|
|
||||||
{- web.browser is a generic git config setting for a web browser program -}
|
{- web.browser is a generic git config setting for a web browser program -}
|
||||||
webBrowser :: Git.Repo -> Maybe FilePath
|
webBrowser :: Git.Repo -> Maybe FilePath
|
||||||
webBrowser = Git.Config.getMaybe "web.browser"
|
webBrowser = fmap fromConfigValue <$> Git.Config.getMaybe "web.browser"
|
||||||
|
|
||||||
fileUrl :: FilePath -> String
|
fileUrl :: FilePath -> String
|
||||||
fileUrl file = "file://" ++ file
|
fileUrl file = "file://" ++ file
|
||||||
|
|
Loading…
Add table
Reference in a new issue