[#156] Make all config options optional

Problem: In #126 we made the `ignoreRefs` option required (to match the
other options). However, having it optional is better for
backwards-compatibility and to help users migrate to newer xrefcheck
versions.

Solution: Make all config options optional.

CHANGES.md

@@ -49,6 +49,8 @@ Unreleased
 * [#141](https://github.com/serokell/xrefcheck/pull/141)
   + Dump all the errors from different files.
   + Fix bug where no errors were reported about broken link annotation and unrecognised annotation.
+* [#159](https://github.com/serokell/xrefcheck/pull/159)
+  + Make all config options optional.
 
 0.2
 ==========

links-tests/Test/Xrefcheck/FtpLinks.hs

@@ -15,7 +15,7 @@ import Test.Tasty (TestTree, askOption, testGroup)
 import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))
 import Test.Tasty.Options as Tasty (IsOption (..), OptionDescription (Option), safeRead)
 
-import Xrefcheck.Config (Config (cVerification), VerifyConfig (vcIgnoreRefs), defConfig)
+import Xrefcheck.Config (Config' (cVerification), VerifyConfig, VerifyConfig' (vcIgnoreRefs), defConfig)
 import Xrefcheck.Core (Flavor (GitHub))
 import Xrefcheck.Verify
   (VerifyError (..), VerifyResult (VerifyResult), checkExternalResource, verifyErrors)

src/Xrefcheck/CLI.hs

@@ -33,7 +33,7 @@ import Options.Applicative.Help.Pretty (Doc, displayS, fill, fillSep, indent, re
 import Options.Applicative.Help.Pretty qualified as Pretty
 
 import Paths_xrefcheck (version)
-import Xrefcheck.Config (VerifyConfig (..))
+import Xrefcheck.Config (VerifyConfig, VerifyConfig' (..))
 import Xrefcheck.Core
 import Xrefcheck.Scan
 import Xrefcheck.Util (normaliseWithNoTrailing)

src/Xrefcheck/Command.hs

@@ -14,7 +14,9 @@ import Fmt (blockListF', build, fmt, fmtLn, indentF)
 import System.Directory (doesFileExist)
 
 import Xrefcheck.CLI (Options (..), addTraversalOptions, addVerifyOptions, defaultConfigPaths)
-import Xrefcheck.Config (Config (..), ScannersConfig (..), defConfig, normaliseConfigFilePaths)
+import Xrefcheck.Config
+  (Config, Config' (..), ScannersConfig, ScannersConfig' (..), defConfig, normaliseConfigFilePaths,
+  overrideConfig)
 import Xrefcheck.Core (Flavor (..))
 import Xrefcheck.Progress (allowRewrite)
 import Xrefcheck.Scan (FormatsSupport, scanRepo, specificFormatsSupport, ScanResult (..), ScanError (..))
@@ -23,7 +25,7 @@ import Xrefcheck.System (askWithinCI)
 import Xrefcheck.Verify (verifyErrors, verifyRepo)
 
 readConfig :: FilePath -> IO Config
-readConfig path = fmap normaliseConfigFilePaths do
+readConfig path = fmap (normaliseConfigFilePaths . overrideConfig) do
   decodeFileEither path
     >>= either (error . toText . prettyPrintParseException) pure
 

src/Xrefcheck/Config.hs

@@ -13,7 +13,7 @@ import Universum
 
 import Control.Exception (assert)
 import Control.Lens (makeLensesWith)
-import Data.Aeson.TH (deriveFromJSON)
+import Data.Aeson (genericParseJSON)
 import Data.ByteString qualified as BS
 import Data.Map qualified as Map
 import Data.Yaml (FromJSON (..), decodeEither', prettyPrintParseException, withText)
@@ -28,16 +28,22 @@ import Xrefcheck.Core
 import Xrefcheck.Scan
 import Xrefcheck.Scanners.Markdown
 import Xrefcheck.System (RelGlobPattern, normaliseGlobPattern)
-import Xrefcheck.Util (aesonConfigOption, postfixFields, (-:))
+import Xrefcheck.Util (aesonConfigOption, postfixFields, (-:), Field)
 import Xrefcheck.Config.Default
 import Text.Regex.TDFA.Common
 
+-- | Type alias for Config' with all required fields.
+type Config = Config' Identity
+
+-- | Type alias for Config' with optional fields.
+type ConfigOptional = Config' Maybe
+
 -- | Overall config.
-data Config = Config
+data Config' f = Config
-  { cTraversal    :: TraversalConfig
+  { cTraversal    :: Field f (TraversalConfig' f)
-  , cVerification :: VerifyConfig
+  , cVerification :: Field f (VerifyConfig' f)
-  , cScanners     :: ScannersConfig
+  , cScanners     :: Field f (ScannersConfig' f)
-  }
+  } deriving stock (Generic)
 
 normaliseConfigFilePaths :: Config -> Config
 normaliseConfigFilePaths Config{..}
@@ -47,24 +53,27 @@ normaliseConfigFilePaths Config{..}
     , cScanners
     }
 
+-- | Type alias for VerifyConfig' with all required fields.
+type VerifyConfig = VerifyConfig' Identity
+
 -- | Config of verification.
-data VerifyConfig = VerifyConfig
+data VerifyConfig' f = VerifyConfig
-  { vcAnchorSimilarityThreshold :: Double
+  { vcAnchorSimilarityThreshold :: Field f Double
-  , vcExternalRefCheckTimeout   :: Time Second
+  , vcExternalRefCheckTimeout   :: Field f (Time Second)
-  , vcVirtualFiles              :: [RelGlobPattern]
+  , vcVirtualFiles              :: Field f [RelGlobPattern]
     -- ^ Files which we pretend do exist.
-  , vcNotScanned                :: [RelGlobPattern]
+  , vcNotScanned                :: Field f [RelGlobPattern]
     -- ^ Files, references in which we should not analyze.
-  , vcIgnoreRefs                :: [Regex]
+  , vcIgnoreRefs                :: Field f [Regex]
     -- ^ Regular expressions that match external references we should not verify.
-  , vcIgnoreAuthFailures        :: Bool
+  , vcIgnoreAuthFailures        :: Field f Bool
     -- ^ If True - links which return 403 or 401 code will be skipped,
     -- otherwise – will be marked as broken, because we can't check it.
-  , vcDefaultRetryAfter         :: Time Second
+  , vcDefaultRetryAfter         :: Field f (Time Second)
     -- ^ Default Retry-After delay, applicable when we receive a 429 response
     -- and it does not contain a @Retry-After@ header.
-  , vcMaxRetries                :: Int
+  , vcMaxRetries                :: Field f Int
-  }
+  } deriving stock (Generic)
 
 normaliseVerifyConfigFilePaths :: VerifyConfig -> VerifyConfig
 normaliseVerifyConfigFilePaths vc@VerifyConfig{ vcVirtualFiles, vcNotScanned}
@@ -73,13 +82,16 @@ normaliseVerifyConfigFilePaths vc@VerifyConfig{ vcVirtualFiles, vcNotScanned}
     , vcNotScanned = map normaliseGlobPattern vcNotScanned
     }
 
--- | Configs for all the supported scanners.
+-- | Type alias for ScannersConfig' with all required fields.
-data ScannersConfig = ScannersConfig
+type ScannersConfig = ScannersConfig' Identity
-  { scMarkdown :: MarkdownConfig
-  }
 
-makeLensesWith postfixFields ''Config
+-- | Configs for all the supported scanners.
-makeLensesWith postfixFields ''VerifyConfig
+data ScannersConfig' f = ScannersConfig
+  { scMarkdown :: Field f (MarkdownConfig' f)
+  } deriving stock (Generic)
+
+makeLensesWith postfixFields ''Config'
+makeLensesWith postfixFields ''VerifyConfig'
 
 -- | Picks raw config with @:PLACEHOLDER:<key>:@ and fills the specified fields
 -- in it, picking a replacement suitable for the given key. Only strings and lists
@@ -188,17 +200,49 @@ defConfigText flavor =
           ]
     ]
 
-foldMap (deriveFromJSON aesonConfigOption)
-  [ ''VerifyConfig
-  , ''Config
-  , ''ScannersConfig
-  ]
-
 defConfig :: HasCallStack => Flavor -> Config
 defConfig flavor = normaliseConfigFilePaths $
   either (error . toText . prettyPrintParseException) id $
   decodeEither' (defConfigText flavor)
 
+-- | Override missed fields with default values.
+overrideConfig :: ConfigOptional -> Config
+overrideConfig config
+  = Config
+    { cTraversal = TraversalConfig ignored
+    , cVerification = maybe defVerification overrideVerify $ cVerification config
+    , cScanners = ScannersConfig (MarkdownConfig flavor)
+    }
+  where
+    flavor = fromMaybe GitHub
+      $ mcFlavor =<< scMarkdown =<< cScanners config
+
+    defTraversal = cTraversal $ defConfig flavor
+
+    ignored = fromMaybe (tcIgnored defTraversal) $ tcIgnored =<< cTraversal config
+
+    defVerification = cVerification $ defConfig flavor
+
+    overrideVerify verifyConfig
+      = VerifyConfig
+        { vcAnchorSimilarityThreshold = fromMaybe (vcAnchorSimilarityThreshold defVerification)
+            $ vcAnchorSimilarityThreshold verifyConfig
+        , vcExternalRefCheckTimeout   = fromMaybe (vcExternalRefCheckTimeout defVerification)
+            $ vcExternalRefCheckTimeout verifyConfig
+        , vcVirtualFiles              = fromMaybe (vcVirtualFiles defVerification)
+            $ vcVirtualFiles verifyConfig
+        , vcNotScanned                = fromMaybe (vcNotScanned defVerification)
+            $ vcNotScanned verifyConfig
+        , vcIgnoreRefs                = fromMaybe (vcIgnoreRefs defVerification)
+            $ vcIgnoreRefs verifyConfig
+        , vcIgnoreAuthFailures        = fromMaybe (vcIgnoreAuthFailures defVerification)
+            $ vcIgnoreAuthFailures verifyConfig
+        , vcDefaultRetryAfter         = fromMaybe (vcDefaultRetryAfter defVerification)
+            $ vcDefaultRetryAfter verifyConfig
+        , vcMaxRetries                = fromMaybe (vcMaxRetries defVerification)
+            $ vcMaxRetries verifyConfig
+        }
+
 -----------------------------------------------------------
 -- Yaml instances
 -----------------------------------------------------------
@@ -226,3 +270,21 @@ defaultCompOption = CompOption
 -- ExecOption value to improve speed
 defaultExecOption :: ExecOption
 defaultExecOption = ExecOption {captureGroups = False}
+
+instance FromJSON (ConfigOptional) where
+  parseJSON = genericParseJSON aesonConfigOption
+
+instance FromJSON (Config) where
+  parseJSON = genericParseJSON aesonConfigOption
+
+instance FromJSON (VerifyConfig' Maybe) where
+  parseJSON = genericParseJSON aesonConfigOption
+
+instance FromJSON (VerifyConfig) where
+  parseJSON = genericParseJSON aesonConfigOption
+
+instance FromJSON (ScannersConfig' Maybe) where
+  parseJSON = genericParseJSON aesonConfigOption
+
+instance FromJSON (ScannersConfig) where
+  parseJSON = genericParseJSON aesonConfigOption

src/Xrefcheck/Scan.hs

@@ -6,7 +6,8 @@
 -- | Generalised repo scanner and analyser.
 
 module Xrefcheck.Scan
-  ( TraversalConfig (..)
+  ( TraversalConfig
+  , TraversalConfig' (..)
   , Extension
   , ScanAction
   , FormatsSupport
@@ -21,7 +22,7 @@ module Xrefcheck.Scan
 
 import Universum
 
-import Data.Aeson.TH (deriveFromJSON)
+import Data.Aeson(FromJSON (..), genericParseJSON)
 import Data.Foldable qualified as F
 import Data.Map qualified as M
 import Fmt (Buildable (..), (+|), (|+), nameF)
@@ -33,19 +34,26 @@ import System.FilePath (dropTrailingPathSeparator, takeDirectory, takeExtension,
 import Xrefcheck.Core
 import Xrefcheck.Progress
 import Xrefcheck.System (readingSystem, RelGlobPattern, normaliseGlobPattern, matchesGlobPatterns)
-import Xrefcheck.Util (aesonConfigOption, normaliseWithNoTrailing)
+import Xrefcheck.Util (aesonConfigOption, normaliseWithNoTrailing, Field)
+
+-- | Type alias for TraversalConfig' with all required fields.
+type TraversalConfig = TraversalConfig' Identity
 
 -- | Config of repositry traversal.
-data TraversalConfig = TraversalConfig
+data TraversalConfig' f = TraversalConfig
-  { tcIgnored   :: [RelGlobPattern]
+  { tcIgnored :: Field f [RelGlobPattern]
     -- ^ Files and folders, files in which we completely ignore.
-  }
+  } deriving stock (Generic)
+
+instance FromJSON (TraversalConfig' Maybe) where
+  parseJSON = genericParseJSON aesonConfigOption
+
+instance FromJSON (TraversalConfig) where
+  parseJSON = genericParseJSON aesonConfigOption
 
 normaliseTraversalConfigFilePaths :: TraversalConfig -> TraversalConfig
 normaliseTraversalConfigFilePaths = TraversalConfig . map normaliseGlobPattern . tcIgnored
 
-deriveFromJSON aesonConfigOption ''TraversalConfig
-
 -- | File extension, dot included.
 type Extension = String
 

src/Xrefcheck/Scanners/Markdown.hs

@@ -8,7 +8,8 @@
 -- | Markdown documents markdownScanner.
 
 module Xrefcheck.Scanners.Markdown
-  ( MarkdownConfig (..)
+  ( MarkdownConfig' (..)
+  , MarkdownConfig
   , IgnoreMode (..)
   , defGithubMdConfig
   , markdownScanner
@@ -21,7 +22,7 @@ import Universum
 
 import CMarkGFM (Node (..), NodeType (..), PosInfo (..), commonmarkToNode)
 import Control.Monad.Trans.Writer.CPS (Writer, runWriter, tell)
-import Data.Aeson.TH (deriveFromJSON)
+import Data.Aeson (FromJSON (..), genericParseJSON)
 import Data.ByteString.Lazy qualified as BSL
 import Data.DList qualified as DList
 import Data.Default (def)
@@ -34,11 +35,18 @@ import Xrefcheck.Core
 import Xrefcheck.Scan
 import Xrefcheck.Util
 
-data MarkdownConfig = MarkdownConfig
+-- | Type alias for MarkdownConfig' with all required fields.
-  { mcFlavor :: Flavor
+type MarkdownConfig = MarkdownConfig' Identity
-  }
 
-deriveFromJSON aesonConfigOption ''MarkdownConfig
+data MarkdownConfig' f = MarkdownConfig
+  { mcFlavor :: Field f Flavor
+  } deriving stock (Generic)
+
+instance FromJSON (MarkdownConfig' Maybe) where
+  parseJSON = genericParseJSON aesonConfigOption
+
+instance FromJSON (MarkdownConfig) where
+  parseJSON = genericParseJSON aesonConfigOption
 
 defGithubMdConfig :: MarkdownConfig
 defGithubMdConfig = MarkdownConfig

src/Xrefcheck/Util.hs

@@ -6,7 +6,8 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Xrefcheck.Util
-  ( nameF'
+  ( Field
+  , nameF'
   , paren
   , postfixFields
   , (-:)
@@ -54,6 +55,11 @@ infixr 0 -:
 aesonConfigOption :: Aeson.Options
 aesonConfigOption = aesonPrefix camelCase
 
+-- | Config fields that may be abscent.
+type family Field f a where
+  Field Identity a = a
+  Field Maybe a = Maybe a
+
 normaliseWithNoTrailing :: FilePath -> FilePath
 normaliseWithNoTrailing =  dropTrailingPathSeparator . normalise
 

tests/Test/Xrefcheck/ConfigSpec.hs

@@ -16,7 +16,7 @@ import Test.Hspec (Spec, before, describe, it, shouldBe)
 import Test.Hspec.Expectations (expectationFailure)
 import Test.QuickCheck (ioProperty, once)
 
-import Xrefcheck.Config (Config (..), VerifyConfig (..), defConfig, defConfigText)
+import Xrefcheck.Config (Config, Config' (..), VerifyConfig' (..), defConfig, defConfigText)
 import Xrefcheck.Core (Flavor (GitHub), allFlavors)
 import Xrefcheck.Verify (VerifyError (..), VerifyResult (..), checkExternalResource)
 

tests/Test/Xrefcheck/Util.hs

@@ -12,7 +12,7 @@ import Web.Firefly (ToResponse (..), route, run)
 
 import Xrefcheck.Core (FileInfo, Flavor)
 import Xrefcheck.Scan (ScanError)
-import Xrefcheck.Scanners.Markdown (MarkdownConfig (MarkdownConfig, mcFlavor), markdownScanner)
+import Xrefcheck.Scanners.Markdown (MarkdownConfig' (MarkdownConfig, mcFlavor), markdownScanner)
 
 parse :: Flavor -> FilePath -> IO (FileInfo, [ScanError])
 parse fl path = markdownScanner MarkdownConfig { mcFlavor = fl } path