import Data.Default in Common

This commit is contained in:
Joey Hess 2015-01-28 16:11:28 -04:00
parent 0fd5f257d0
commit e8c376e0ad
19 changed files with 48 additions and 54 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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.|]

View file

@ -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.|]

View file

@ -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

View file

@ -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")

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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 {

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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