import Data.Default in Common
This commit is contained in:
parent
0fd5f257d0
commit
e8c376e0ad
19 changed files with 48 additions and 54 deletions
|
@ -110,10 +110,10 @@ inAnnexSafe key = inAnnex' (fromMaybe False) (Just False) go key
|
||||||
( checkOr is_unlocked lockfile
|
( checkOr is_unlocked lockfile
|
||||||
, return is_missing
|
, return is_missing
|
||||||
)
|
)
|
||||||
checkOr def lockfile = do
|
checkOr d lockfile = do
|
||||||
v <- checkLocked lockfile
|
v <- checkLocked lockfile
|
||||||
return $ case v of
|
return $ case v of
|
||||||
Nothing -> def
|
Nothing -> d
|
||||||
Just True -> is_locked
|
Just True -> is_locked
|
||||||
Just False -> is_unlocked
|
Just False -> is_unlocked
|
||||||
#else
|
#else
|
||||||
|
|
|
@ -28,12 +28,12 @@ checkFileMatcher :: (FileMatcher Annex) -> FilePath -> Annex Bool
|
||||||
checkFileMatcher matcher file = checkMatcher matcher Nothing (Just file) S.empty True
|
checkFileMatcher matcher file = checkMatcher matcher Nothing (Just file) S.empty True
|
||||||
|
|
||||||
checkMatcher :: (FileMatcher Annex) -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool
|
checkMatcher :: (FileMatcher Annex) -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool
|
||||||
checkMatcher matcher mkey afile notpresent def
|
checkMatcher matcher mkey afile notpresent d
|
||||||
| isEmpty matcher = return def
|
| isEmpty matcher = return d
|
||||||
| otherwise = case (mkey, afile) of
|
| otherwise = case (mkey, afile) of
|
||||||
(_, Just file) -> go =<< fileMatchInfo file
|
(_, Just file) -> go =<< fileMatchInfo file
|
||||||
(Just key, _) -> go (MatchingKey key)
|
(Just key, _) -> go (MatchingKey key)
|
||||||
_ -> return def
|
_ -> return d
|
||||||
where
|
where
|
||||||
go mi = matchMrun matcher $ \a -> a notpresent mi
|
go mi = matchMrun matcher $ \a -> a notpresent mi
|
||||||
|
|
||||||
|
|
|
@ -15,15 +15,15 @@ import qualified Data.Set as S
|
||||||
|
|
||||||
{- Check if a file is preferred content for the local repository. -}
|
{- Check if a file is preferred content for the local repository. -}
|
||||||
wantGet :: Bool -> Maybe Key -> AssociatedFile -> Annex Bool
|
wantGet :: Bool -> Maybe Key -> AssociatedFile -> Annex Bool
|
||||||
wantGet def key file = isPreferredContent Nothing S.empty key file def
|
wantGet d key file = isPreferredContent Nothing S.empty key file d
|
||||||
|
|
||||||
{- Check if a file is preferred content for a remote. -}
|
{- Check if a file is preferred content for a remote. -}
|
||||||
wantSend :: Bool -> Maybe Key -> AssociatedFile -> UUID -> Annex Bool
|
wantSend :: Bool -> Maybe Key -> AssociatedFile -> UUID -> Annex Bool
|
||||||
wantSend def key file to = isPreferredContent (Just to) S.empty key file def
|
wantSend d key file to = isPreferredContent (Just to) S.empty key file d
|
||||||
|
|
||||||
{- Check if a file can be dropped, maybe from a remote.
|
{- Check if a file can be dropped, maybe from a remote.
|
||||||
- Don't drop files that are preferred content. -}
|
- Don't drop files that are preferred content. -}
|
||||||
wantDrop :: Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> Annex Bool
|
wantDrop :: Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> Annex Bool
|
||||||
wantDrop def from key file = do
|
wantDrop d from key file = do
|
||||||
u <- maybe getUUID (return . id) from
|
u <- maybe getUUID (return . id) from
|
||||||
not <$> isPreferredContent (Just u) (S.singleton u) key file def
|
not <$> isPreferredContent (Just u) (S.singleton u) key file d
|
||||||
|
|
|
@ -29,7 +29,6 @@ import System.Posix (signalProcess, sigTERM)
|
||||||
#else
|
#else
|
||||||
import Utility.WinProcess
|
import Utility.WinProcess
|
||||||
#endif
|
#endif
|
||||||
import Data.Default
|
|
||||||
import Network.URI
|
import Network.URI
|
||||||
|
|
||||||
{- Before the assistant can be restarted, have to remove our
|
{- Before the assistant can be restarted, have to remove our
|
||||||
|
|
|
@ -144,13 +144,13 @@ setRepoConfig uuid mremote oldc newc = do
|
||||||
legalName = makeLegalName . T.unpack . repoName
|
legalName = makeLegalName . T.unpack . repoName
|
||||||
|
|
||||||
editRepositoryAForm :: Maybe Remote -> RepoConfig -> MkAForm RepoConfig
|
editRepositoryAForm :: Maybe Remote -> RepoConfig -> MkAForm RepoConfig
|
||||||
editRepositoryAForm mremote def = RepoConfig
|
editRepositoryAForm mremote d = RepoConfig
|
||||||
<$> areq (if ishere then readonlyTextField else textField)
|
<$> areq (if ishere then readonlyTextField else textField)
|
||||||
(bfs "Name") (Just $ repoName def)
|
(bfs "Name") (Just $ repoName d)
|
||||||
<*> aopt textField (bfs "Description") (Just $ repoDescription def)
|
<*> aopt textField (bfs "Description") (Just $ repoDescription d)
|
||||||
<*> areq (selectFieldList groups `withNote` help) (bfs "Repository group") (Just $ repoGroup def)
|
<*> areq (selectFieldList groups `withNote` help) (bfs "Repository group") (Just $ repoGroup d)
|
||||||
<*> associateddirectory
|
<*> associateddirectory
|
||||||
<*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def)
|
<*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable d)
|
||||||
where
|
where
|
||||||
ishere = isNothing mremote
|
ishere = isNothing mremote
|
||||||
isspecial = fromMaybe False $
|
isspecial = fromMaybe False $
|
||||||
|
@ -163,14 +163,14 @@ editRepositoryAForm mremote def = RepoConfig
|
||||||
| isspecial = const True
|
| isspecial = const True
|
||||||
| otherwise = not . specialRemoteOnly
|
| otherwise = not . specialRemoteOnly
|
||||||
customgroups :: [(Text, RepoGroup)]
|
customgroups :: [(Text, RepoGroup)]
|
||||||
customgroups = case repoGroup def of
|
customgroups = case repoGroup d of
|
||||||
RepoGroupCustom s -> [(T.pack s, RepoGroupCustom s)]
|
RepoGroupCustom s -> [(T.pack s, RepoGroupCustom s)]
|
||||||
_ -> []
|
_ -> []
|
||||||
help = [whamlet|<a href="@{RepoGroupR}">What's this?</a>|]
|
help = [whamlet|<a href="@{RepoGroupR}">What's this?</a>|]
|
||||||
|
|
||||||
associateddirectory = case repoAssociatedDirectory def of
|
associateddirectory = case repoAssociatedDirectory d of
|
||||||
Nothing -> aopt hiddenField "" Nothing
|
Nothing -> aopt hiddenField "" Nothing
|
||||||
Just d -> aopt textField (bfs "Associated directory") (Just $ Just d)
|
Just dir -> aopt textField (bfs "Associated directory") (Just $ Just dir)
|
||||||
|
|
||||||
getEditRepositoryR :: RepoId -> Handler Html
|
getEditRepositoryR :: RepoId -> Handler Html
|
||||||
getEditRepositoryR = postEditRepositoryR
|
getEditRepositoryR = postEditRepositoryR
|
||||||
|
|
|
@ -167,8 +167,8 @@ getFsckPreferences = FsckPreferences
|
||||||
<$> (annexFsckNudge <$> Annex.getGitConfig)
|
<$> (annexFsckNudge <$> Annex.getGitConfig)
|
||||||
|
|
||||||
fsckPreferencesAForm :: FsckPreferences -> MkAForm FsckPreferences
|
fsckPreferencesAForm :: FsckPreferences -> MkAForm FsckPreferences
|
||||||
fsckPreferencesAForm def = FsckPreferences
|
fsckPreferencesAForm d = FsckPreferences
|
||||||
<$> areq (checkBoxField `withNote` nudgenote) "Reminders" (Just $ enableFsckNudge def)
|
<$> areq (checkBoxField `withNote` nudgenote) "Reminders" (Just $ enableFsckNudge d)
|
||||||
where
|
where
|
||||||
nudgenote = [whamlet|Remind me when using repositories that lack consistency checks.|]
|
nudgenote = [whamlet|Remind me when using repositories that lack consistency checks.|]
|
||||||
|
|
||||||
|
|
|
@ -34,17 +34,17 @@ data PrefsForm = PrefsForm
|
||||||
}
|
}
|
||||||
|
|
||||||
prefsAForm :: PrefsForm -> MkAForm PrefsForm
|
prefsAForm :: PrefsForm -> MkAForm PrefsForm
|
||||||
prefsAForm def = PrefsForm
|
prefsAForm d = PrefsForm
|
||||||
<$> areq (storageField `withNote` diskreservenote)
|
<$> areq (storageField `withNote` diskreservenote)
|
||||||
(bfs "Disk reserve") (Just $ diskReserve def)
|
(bfs "Disk reserve") (Just $ diskReserve d)
|
||||||
<*> areq (positiveIntField `withNote` numcopiesnote)
|
<*> areq (positiveIntField `withNote` numcopiesnote)
|
||||||
(bfs "Number of copies") (Just $ numCopies def)
|
(bfs "Number of copies") (Just $ numCopies d)
|
||||||
<*> areq (checkBoxField `withNote` autostartnote)
|
<*> areq (checkBoxField `withNote` autostartnote)
|
||||||
"Auto start" (Just $ autoStart def)
|
"Auto start" (Just $ autoStart d)
|
||||||
<*> areq (selectFieldList autoUpgradeChoices)
|
<*> areq (selectFieldList autoUpgradeChoices)
|
||||||
(bfs autoUpgradeLabel) (Just $ autoUpgrade def)
|
(bfs autoUpgradeLabel) (Just $ autoUpgrade d)
|
||||||
<*> areq (checkBoxField `withNote` debugnote)
|
<*> areq (checkBoxField `withNote` debugnote)
|
||||||
"Enable debug logging" (Just $ debugEnabled def)
|
"Enable debug logging" (Just $ debugEnabled d)
|
||||||
where
|
where
|
||||||
diskreservenote = [whamlet|<br>Avoid downloading files from other repositories when there is too little free disk space.|]
|
diskreservenote = [whamlet|<br>Avoid downloading files from other repositories when there is too little free disk space.|]
|
||||||
numcopiesnote = [whamlet|<br>Only drop a file after verifying that other repositories contain this many copies.|]
|
numcopiesnote = [whamlet|<br>Only drop a file after verifying that other repositories contain this many copies.|]
|
||||||
|
|
|
@ -91,15 +91,15 @@ sshInputAForm :: Field Handler Text -> SshInput -> AForm Handler SshInput
|
||||||
#else
|
#else
|
||||||
sshInputAForm :: Field WebApp WebApp Text -> SshInput -> AForm WebApp WebApp SshInput
|
sshInputAForm :: Field WebApp WebApp Text -> SshInput -> AForm WebApp WebApp SshInput
|
||||||
#endif
|
#endif
|
||||||
sshInputAForm hostnamefield def = normalize <$> gen
|
sshInputAForm hostnamefield d = normalize <$> gen
|
||||||
where
|
where
|
||||||
gen = SshInput
|
gen = SshInput
|
||||||
<$> aopt check_hostname (bfs "Host name") (Just $ inputHostname def)
|
<$> aopt check_hostname (bfs "Host name") (Just $ inputHostname d)
|
||||||
<*> aopt check_username (bfs "User name") (Just $ inputUsername def)
|
<*> aopt check_username (bfs "User name") (Just $ inputUsername d)
|
||||||
<*> areq (selectFieldList authmethods) (bfs "Authenticate with") (Just $ inputAuthMethod def)
|
<*> areq (selectFieldList authmethods) (bfs "Authenticate with") (Just $ inputAuthMethod d)
|
||||||
<*> aopt passwordField (bfs "Password") Nothing
|
<*> aopt passwordField (bfs "Password") Nothing
|
||||||
<*> aopt textField (bfs "Directory") (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory def)
|
<*> aopt textField (bfs "Directory") (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory d)
|
||||||
<*> areq intField (bfs "Port") (Just $ inputPort def)
|
<*> areq intField (bfs "Port") (Just $ inputPort d)
|
||||||
|
|
||||||
authmethods :: [(Text, AuthMethod)]
|
authmethods :: [(Text, AuthMethod)]
|
||||||
authmethods =
|
authmethods =
|
||||||
|
@ -133,10 +133,10 @@ sshInputAForm hostnamefield def = normalize <$> gen
|
||||||
|
|
||||||
-- The directory is implicitly in home, so remove any leading ~/
|
-- The directory is implicitly in home, so remove any leading ~/
|
||||||
normalize i = i { inputDirectory = normalizedir <$> inputDirectory i }
|
normalize i = i { inputDirectory = normalizedir <$> inputDirectory i }
|
||||||
normalizedir d
|
normalizedir dir
|
||||||
| "~/" `T.isPrefixOf` d = T.drop 2 d
|
| "~/" `T.isPrefixOf` dir = T.drop 2 dir
|
||||||
| "/~/" `T.isPrefixOf` d = T.drop 3 d
|
| "/~/" `T.isPrefixOf` dir = T.drop 3 dir
|
||||||
| otherwise = d
|
| otherwise = dir
|
||||||
|
|
||||||
data ServerStatus
|
data ServerStatus
|
||||||
= UntestedServer
|
= UntestedServer
|
||||||
|
|
|
@ -26,11 +26,11 @@ data UnusedForm = UnusedForm
|
||||||
}
|
}
|
||||||
|
|
||||||
unusedForm :: UnusedForm -> Hamlet.Html -> MkMForm UnusedForm
|
unusedForm :: UnusedForm -> Hamlet.Html -> MkMForm UnusedForm
|
||||||
unusedForm def msg = do
|
unusedForm d msg = do
|
||||||
(enableRes, enableView) <- mreq (selectFieldList enabledisable) (bfs "")
|
(enableRes, enableView) <- mreq (selectFieldList enabledisable) (bfs "")
|
||||||
(Just $ enableExpire def)
|
(Just $ enableExpire d)
|
||||||
(whenRes, whenView) <- mreq intField (bfs "")
|
(whenRes, whenView) <- mreq intField (bfs "")
|
||||||
(Just $ expireWhen def)
|
(Just $ expireWhen d)
|
||||||
let form = do
|
let form = do
|
||||||
webAppFormAuthToken
|
webAppFormAuthToken
|
||||||
$(widgetFile "configurators/unused/form")
|
$(widgetFile "configurators/unused/form")
|
||||||
|
|
|
@ -161,8 +161,8 @@ creds2Form :: XMPPCreds -> XMPPForm
|
||||||
creds2Form c = XMPPForm (xmppJID c) (xmppPassword c)
|
creds2Form c = XMPPForm (xmppJID c) (xmppPassword c)
|
||||||
|
|
||||||
xmppAForm :: (Maybe XMPPForm) -> MkAForm XMPPForm
|
xmppAForm :: (Maybe XMPPForm) -> MkAForm XMPPForm
|
||||||
xmppAForm def = XMPPForm
|
xmppAForm d = XMPPForm
|
||||||
<$> areq jidField (bfs "Jabber address") (formJID <$> def)
|
<$> areq jidField (bfs "Jabber address") (formJID <$> d)
|
||||||
<*> areq passwordField (bfs "Password") Nothing
|
<*> areq passwordField (bfs "Password") Nothing
|
||||||
|
|
||||||
jidField :: MkField Text
|
jidField :: MkField Text
|
||||||
|
|
|
@ -11,6 +11,7 @@ import Data.Maybe as X
|
||||||
import Data.List as X hiding (head, tail, init, last)
|
import Data.List as X hiding (head, tail, init, last)
|
||||||
import Data.String.Utils as X hiding (join)
|
import Data.String.Utils as X hiding (join)
|
||||||
import Data.Monoid as X
|
import Data.Monoid as X
|
||||||
|
import Data.Default as X
|
||||||
|
|
||||||
import System.FilePath as X
|
import System.FilePath as X
|
||||||
import System.Directory as X
|
import System.Directory as X
|
||||||
|
|
|
@ -23,7 +23,7 @@ instance Show ConfigKey where
|
||||||
|
|
||||||
{- Looks up a setting in git config. -}
|
{- Looks up a setting in git config. -}
|
||||||
getConfig :: ConfigKey -> String -> Annex String
|
getConfig :: ConfigKey -> String -> Annex String
|
||||||
getConfig (ConfigKey key) def = fromRepo $ Git.Config.get key def
|
getConfig (ConfigKey key) d = fromRepo $ Git.Config.get key d
|
||||||
|
|
||||||
getConfigMaybe :: ConfigKey -> Annex (Maybe String)
|
getConfigMaybe :: ConfigKey -> Annex (Maybe String)
|
||||||
getConfigMaybe (ConfigKey key) = fromRepo $ Git.Config.getMaybe key
|
getConfigMaybe (ConfigKey key) = fromRepo $ Git.Config.getMaybe key
|
||||||
|
@ -58,7 +58,7 @@ annexConfig key = ConfigKey $ "annex." ++ key
|
||||||
- by remote.<name>.annex-cost, or if remote.<name>.annex-cost-command
|
- by remote.<name>.annex-cost, or if remote.<name>.annex-cost-command
|
||||||
- is set and prints a number, that is used. -}
|
- is set and prints a number, that is used. -}
|
||||||
remoteCost :: RemoteGitConfig -> Cost -> Annex Cost
|
remoteCost :: RemoteGitConfig -> Cost -> Annex Cost
|
||||||
remoteCost c def = fromMaybe def <$> remoteCost' c
|
remoteCost c d = fromMaybe d <$> remoteCost' c
|
||||||
|
|
||||||
remoteCost' :: RemoteGitConfig -> Annex (Maybe Cost)
|
remoteCost' :: RemoteGitConfig -> Annex (Maybe Cost)
|
||||||
remoteCost' c = case remoteAnnexCostCommand c of
|
remoteCost' c = case remoteAnnexCostCommand c of
|
||||||
|
|
2
Logs.hs
2
Logs.hs
|
@ -10,8 +10,6 @@ module Logs where
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import Types.Key
|
import Types.Key
|
||||||
|
|
||||||
import Data.Default
|
|
||||||
|
|
||||||
{- There are several varieties of log file formats. -}
|
{- There are several varieties of log file formats. -}
|
||||||
data LogVariety
|
data LogVariety
|
||||||
= UUIDBasedLog
|
= UUIDBasedLog
|
||||||
|
|
|
@ -52,12 +52,12 @@ isRequiredContent :: Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFi
|
||||||
isRequiredContent = checkMap requiredContentMap
|
isRequiredContent = checkMap requiredContentMap
|
||||||
|
|
||||||
checkMap :: Annex (FileMatcherMap Annex) -> Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool
|
checkMap :: Annex (FileMatcherMap Annex) -> Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool
|
||||||
checkMap getmap mu notpresent mkey afile def = do
|
checkMap getmap mu notpresent mkey afile d = do
|
||||||
u <- maybe getUUID return mu
|
u <- maybe getUUID return mu
|
||||||
m <- getmap
|
m <- getmap
|
||||||
case M.lookup u m of
|
case M.lookup u m of
|
||||||
Nothing -> return def
|
Nothing -> return d
|
||||||
Just matcher -> checkMatcher matcher mkey afile notpresent def
|
Just matcher -> checkMatcher matcher mkey afile notpresent d
|
||||||
|
|
||||||
preferredContentMap :: Annex (FileMatcherMap Annex)
|
preferredContentMap :: Annex (FileMatcherMap Annex)
|
||||||
preferredContentMap = maybe (fst <$> preferredRequiredMapsLoad) return
|
preferredContentMap = maybe (fst <$> preferredRequiredMapsLoad) return
|
||||||
|
|
|
@ -28,7 +28,6 @@ import Creds
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
import System.Log.Logger (debugM)
|
import System.Log.Logger (debugM)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Default
|
|
||||||
|
|
||||||
remote :: RemoteType
|
remote :: RemoteType
|
||||||
remote = RemoteType {
|
remote = RemoteType {
|
||||||
|
|
|
@ -18,7 +18,6 @@ import Annex.UUID
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Utility.Env
|
import Utility.Env
|
||||||
|
|
||||||
import Data.Default
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
type Action = String
|
type Action = String
|
||||||
|
|
|
@ -38,7 +38,6 @@ import Logs.Transfer
|
||||||
import Types.Creds
|
import Types.Creds
|
||||||
import Types.Key (isChunkKey)
|
import Types.Key (isChunkKey)
|
||||||
|
|
||||||
import Data.Default
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
remote :: RemoteType
|
remote :: RemoteType
|
||||||
|
|
|
@ -98,7 +98,7 @@ extractGitConfig r = GitConfig
|
||||||
, annexDifferences = getDifferences r
|
, annexDifferences = getDifferences r
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
getbool k def = fromMaybe def $ getmaybebool k
|
getbool k d = fromMaybe d $ getmaybebool k
|
||||||
getmaybebool k = Git.Config.isTrue =<< getmaybe k
|
getmaybebool k = Git.Config.isTrue =<< getmaybe k
|
||||||
getmayberead k = readish =<< getmaybe k
|
getmayberead k = readish =<< getmaybe k
|
||||||
getmaybe k = Git.Config.getMaybe k r
|
getmaybe k = Git.Config.getMaybe k r
|
||||||
|
@ -178,7 +178,7 @@ extractRemoteGitConfig r remotename = RemoteGitConfig
|
||||||
, remoteGitConfig = Nothing
|
, remoteGitConfig = Nothing
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
getbool k def = fromMaybe def $ getmaybebool k
|
getbool k d = fromMaybe d $ getmaybebool k
|
||||||
getmaybebool k = Git.Config.isTrue =<< getmaybe k
|
getmaybebool k = Git.Config.isTrue =<< getmaybe k
|
||||||
getmayberead k = readish =<< getmaybe k
|
getmayberead k = readish =<< getmaybe k
|
||||||
getmaybe k = mplus (Git.Config.getMaybe (key k) r)
|
getmaybe k = mplus (Git.Config.getMaybe (key k) r)
|
||||||
|
|
|
@ -28,7 +28,6 @@ import Common
|
||||||
import Network.URI
|
import Network.URI
|
||||||
import Network.HTTP.Conduit
|
import Network.HTTP.Conduit
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
import Data.Default
|
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.ByteString.UTF8 as B8
|
import qualified Data.ByteString.UTF8 as B8
|
||||||
|
|
Loading…
Add table
Reference in a new issue