diff --git a/Annex/Content.hs b/Annex/Content.hs index a78cf674c1..f91c1e72ae 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -110,10 +110,10 @@ inAnnexSafe key = inAnnex' (fromMaybe False) (Just False) go key ( checkOr is_unlocked lockfile , return is_missing ) - checkOr def lockfile = do + checkOr d lockfile = do v <- checkLocked lockfile return $ case v of - Nothing -> def + Nothing -> d Just True -> is_locked Just False -> is_unlocked #else diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs index c6a729a9cd..16ade922cd 100644 --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -28,12 +28,12 @@ checkFileMatcher :: (FileMatcher Annex) -> FilePath -> Annex Bool checkFileMatcher matcher file = checkMatcher matcher Nothing (Just file) S.empty True checkMatcher :: (FileMatcher Annex) -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool -checkMatcher matcher mkey afile notpresent def - | isEmpty matcher = return def +checkMatcher matcher mkey afile notpresent d + | isEmpty matcher = return d | otherwise = case (mkey, afile) of (_, Just file) -> go =<< fileMatchInfo file (Just key, _) -> go (MatchingKey key) - _ -> return def + _ -> return d where go mi = matchMrun matcher $ \a -> a notpresent mi diff --git a/Annex/Wanted.hs b/Annex/Wanted.hs index 87b4377c28..ba7df0a9cb 100644 --- a/Annex/Wanted.hs +++ b/Annex/Wanted.hs @@ -15,15 +15,15 @@ import qualified Data.Set as S {- Check if a file is preferred content for the local repository. -} 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. -} 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. - Don't drop files that are preferred content. -} 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 - not <$> isPreferredContent (Just u) (S.singleton u) key file def + not <$> isPreferredContent (Just u) (S.singleton u) key file d diff --git a/Assistant/Restart.hs b/Assistant/Restart.hs index 282e77fa1c..4120a46537 100644 --- a/Assistant/Restart.hs +++ b/Assistant/Restart.hs @@ -29,7 +29,6 @@ import System.Posix (signalProcess, sigTERM) #else import Utility.WinProcess #endif -import Data.Default import Network.URI {- Before the assistant can be restarted, have to remove our diff --git a/Assistant/WebApp/Configurators/Edit.hs b/Assistant/WebApp/Configurators/Edit.hs index 6a23139601..79f04dc067 100644 --- a/Assistant/WebApp/Configurators/Edit.hs +++ b/Assistant/WebApp/Configurators/Edit.hs @@ -144,13 +144,13 @@ setRepoConfig uuid mremote oldc newc = do legalName = makeLegalName . T.unpack . repoName editRepositoryAForm :: Maybe Remote -> RepoConfig -> MkAForm RepoConfig -editRepositoryAForm mremote def = RepoConfig +editRepositoryAForm mremote d = RepoConfig <$> areq (if ishere then readonlyTextField else textField) - (bfs "Name") (Just $ repoName def) - <*> aopt textField (bfs "Description") (Just $ repoDescription def) - <*> areq (selectFieldList groups `withNote` help) (bfs "Repository group") (Just $ repoGroup def) + (bfs "Name") (Just $ repoName d) + <*> aopt textField (bfs "Description") (Just $ repoDescription d) + <*> areq (selectFieldList groups `withNote` help) (bfs "Repository group") (Just $ repoGroup d) <*> associateddirectory - <*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def) + <*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable d) where ishere = isNothing mremote isspecial = fromMaybe False $ @@ -163,14 +163,14 @@ editRepositoryAForm mremote def = RepoConfig | isspecial = const True | otherwise = not . specialRemoteOnly customgroups :: [(Text, RepoGroup)] - customgroups = case repoGroup def of + customgroups = case repoGroup d of RepoGroupCustom s -> [(T.pack s, RepoGroupCustom s)] _ -> [] help = [whamlet|What's this?|] - associateddirectory = case repoAssociatedDirectory def of + associateddirectory = case repoAssociatedDirectory d of 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 = postEditRepositoryR diff --git a/Assistant/WebApp/Configurators/Fsck.hs b/Assistant/WebApp/Configurators/Fsck.hs index 9adb77b704..c70e5269a9 100644 --- a/Assistant/WebApp/Configurators/Fsck.hs +++ b/Assistant/WebApp/Configurators/Fsck.hs @@ -167,8 +167,8 @@ getFsckPreferences = FsckPreferences <$> (annexFsckNudge <$> Annex.getGitConfig) fsckPreferencesAForm :: FsckPreferences -> MkAForm FsckPreferences -fsckPreferencesAForm def = FsckPreferences - <$> areq (checkBoxField `withNote` nudgenote) "Reminders" (Just $ enableFsckNudge def) +fsckPreferencesAForm d = FsckPreferences + <$> areq (checkBoxField `withNote` nudgenote) "Reminders" (Just $ enableFsckNudge d) where nudgenote = [whamlet|Remind me when using repositories that lack consistency checks.|] diff --git a/Assistant/WebApp/Configurators/Preferences.hs b/Assistant/WebApp/Configurators/Preferences.hs index 5b762698e2..754b96a056 100644 --- a/Assistant/WebApp/Configurators/Preferences.hs +++ b/Assistant/WebApp/Configurators/Preferences.hs @@ -34,17 +34,17 @@ data PrefsForm = PrefsForm } prefsAForm :: PrefsForm -> MkAForm PrefsForm -prefsAForm def = PrefsForm +prefsAForm d = PrefsForm <$> areq (storageField `withNote` diskreservenote) - (bfs "Disk reserve") (Just $ diskReserve def) + (bfs "Disk reserve") (Just $ diskReserve d) <*> areq (positiveIntField `withNote` numcopiesnote) - (bfs "Number of copies") (Just $ numCopies def) + (bfs "Number of copies") (Just $ numCopies d) <*> areq (checkBoxField `withNote` autostartnote) - "Auto start" (Just $ autoStart def) + "Auto start" (Just $ autoStart d) <*> areq (selectFieldList autoUpgradeChoices) - (bfs autoUpgradeLabel) (Just $ autoUpgrade def) + (bfs autoUpgradeLabel) (Just $ autoUpgrade d) <*> areq (checkBoxField `withNote` debugnote) - "Enable debug logging" (Just $ debugEnabled def) + "Enable debug logging" (Just $ debugEnabled d) where diskreservenote = [whamlet|
Avoid downloading files from other repositories when there is too little free disk space.|] numcopiesnote = [whamlet|
Only drop a file after verifying that other repositories contain this many copies.|] diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index d55a3c716a..ca143c0eaf 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -91,15 +91,15 @@ sshInputAForm :: Field Handler Text -> SshInput -> AForm Handler SshInput #else sshInputAForm :: Field WebApp WebApp Text -> SshInput -> AForm WebApp WebApp SshInput #endif -sshInputAForm hostnamefield def = normalize <$> gen +sshInputAForm hostnamefield d = normalize <$> gen where gen = SshInput - <$> aopt check_hostname (bfs "Host name") (Just $ inputHostname def) - <*> aopt check_username (bfs "User name") (Just $ inputUsername def) - <*> areq (selectFieldList authmethods) (bfs "Authenticate with") (Just $ inputAuthMethod def) + <$> aopt check_hostname (bfs "Host name") (Just $ inputHostname d) + <*> aopt check_username (bfs "User name") (Just $ inputUsername d) + <*> areq (selectFieldList authmethods) (bfs "Authenticate with") (Just $ inputAuthMethod d) <*> aopt passwordField (bfs "Password") Nothing - <*> aopt textField (bfs "Directory") (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory def) - <*> areq intField (bfs "Port") (Just $ inputPort def) + <*> aopt textField (bfs "Directory") (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory d) + <*> areq intField (bfs "Port") (Just $ inputPort d) authmethods :: [(Text, AuthMethod)] authmethods = @@ -133,10 +133,10 @@ sshInputAForm hostnamefield def = normalize <$> gen -- The directory is implicitly in home, so remove any leading ~/ normalize i = i { inputDirectory = normalizedir <$> inputDirectory i } - normalizedir d - | "~/" `T.isPrefixOf` d = T.drop 2 d - | "/~/" `T.isPrefixOf` d = T.drop 3 d - | otherwise = d + normalizedir dir + | "~/" `T.isPrefixOf` dir = T.drop 2 dir + | "/~/" `T.isPrefixOf` dir = T.drop 3 dir + | otherwise = dir data ServerStatus = UntestedServer diff --git a/Assistant/WebApp/Configurators/Unused.hs b/Assistant/WebApp/Configurators/Unused.hs index d57e745efb..11f60e3127 100644 --- a/Assistant/WebApp/Configurators/Unused.hs +++ b/Assistant/WebApp/Configurators/Unused.hs @@ -26,11 +26,11 @@ data UnusedForm = UnusedForm } unusedForm :: UnusedForm -> Hamlet.Html -> MkMForm UnusedForm -unusedForm def msg = do +unusedForm d msg = do (enableRes, enableView) <- mreq (selectFieldList enabledisable) (bfs "") - (Just $ enableExpire def) + (Just $ enableExpire d) (whenRes, whenView) <- mreq intField (bfs "") - (Just $ expireWhen def) + (Just $ expireWhen d) let form = do webAppFormAuthToken $(widgetFile "configurators/unused/form") diff --git a/Assistant/WebApp/Configurators/XMPP.hs b/Assistant/WebApp/Configurators/XMPP.hs index d2e9ab6461..6075f1c2c4 100644 --- a/Assistant/WebApp/Configurators/XMPP.hs +++ b/Assistant/WebApp/Configurators/XMPP.hs @@ -161,8 +161,8 @@ creds2Form :: XMPPCreds -> XMPPForm creds2Form c = XMPPForm (xmppJID c) (xmppPassword c) xmppAForm :: (Maybe XMPPForm) -> MkAForm XMPPForm -xmppAForm def = XMPPForm - <$> areq jidField (bfs "Jabber address") (formJID <$> def) +xmppAForm d = XMPPForm + <$> areq jidField (bfs "Jabber address") (formJID <$> d) <*> areq passwordField (bfs "Password") Nothing jidField :: MkField Text diff --git a/Common.hs b/Common.hs index 9333a19d93..8272043c2a 100644 --- a/Common.hs +++ b/Common.hs @@ -11,6 +11,7 @@ import Data.Maybe as X import Data.List as X hiding (head, tail, init, last) import Data.String.Utils as X hiding (join) import Data.Monoid as X +import Data.Default as X import System.FilePath as X import System.Directory as X diff --git a/Config.hs b/Config.hs index 57ced78217..29135ed964 100644 --- a/Config.hs +++ b/Config.hs @@ -23,7 +23,7 @@ instance Show ConfigKey where {- Looks up a setting in git config. -} 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 key) = fromRepo $ Git.Config.getMaybe key @@ -58,7 +58,7 @@ annexConfig key = ConfigKey $ "annex." ++ key - by remote..annex-cost, or if remote..annex-cost-command - is set and prints a number, that is used. -} 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' c = case remoteAnnexCostCommand c of diff --git a/Logs.hs b/Logs.hs index 7e4a395337..b0f330e93c 100644 --- a/Logs.hs +++ b/Logs.hs @@ -10,8 +10,6 @@ module Logs where import Common.Annex import Types.Key -import Data.Default - {- There are several varieties of log file formats. -} data LogVariety = UUIDBasedLog diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs index 83269e6d76..6c885041a4 100644 --- a/Logs/PreferredContent.hs +++ b/Logs/PreferredContent.hs @@ -52,12 +52,12 @@ isRequiredContent :: Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFi isRequiredContent = checkMap requiredContentMap 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 m <- getmap case M.lookup u m of - Nothing -> return def - Just matcher -> checkMatcher matcher mkey afile notpresent def + Nothing -> return d + Just matcher -> checkMatcher matcher mkey afile notpresent d preferredContentMap :: Annex (FileMatcherMap Annex) preferredContentMap = maybe (fst <$> preferredRequiredMapsLoad) return diff --git a/Remote/External.hs b/Remote/External.hs index b660c4f1bb..0579400edb 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -28,7 +28,6 @@ import Creds import Control.Concurrent.STM import System.Log.Logger (debugM) import qualified Data.Map as M -import Data.Default remote :: RemoteType remote = RemoteType { diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 31b5ab7c53..592564772c 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -18,7 +18,6 @@ import Annex.UUID import Remote.Helper.Special import Utility.Env -import Data.Default import qualified Data.Map as M type Action = String diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 527bfb80ac..04bbb19a71 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -38,7 +38,6 @@ import Logs.Transfer import Types.Creds import Types.Key (isChunkKey) -import Data.Default import qualified Data.Map as M remote :: RemoteType diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 5ac524f450..ef8f2f2bdb 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -98,7 +98,7 @@ extractGitConfig r = GitConfig , annexDifferences = getDifferences r } where - getbool k def = fromMaybe def $ getmaybebool k + getbool k d = fromMaybe d $ getmaybebool k getmaybebool k = Git.Config.isTrue =<< getmaybe k getmayberead k = readish =<< getmaybe k getmaybe k = Git.Config.getMaybe k r @@ -178,7 +178,7 @@ extractRemoteGitConfig r remotename = RemoteGitConfig , remoteGitConfig = Nothing } where - getbool k def = fromMaybe def $ getmaybebool k + getbool k d = fromMaybe d $ getmaybebool k getmaybebool k = Git.Config.isTrue =<< getmaybe k getmayberead k = readish =<< getmaybe k getmaybe k = mplus (Git.Config.getMaybe (key k) r) diff --git a/Utility/Url.hs b/Utility/Url.hs index cb4fc7d379..ddf5eea408 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -28,7 +28,6 @@ import Common import Network.URI import Network.HTTP.Conduit import Network.HTTP.Types -import Data.Default import qualified Data.CaseInsensitive as CI import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as B8