{- SPDX-FileCopyrightText: 2018-2019 Serokell <https://serokell.io>
 -
 - SPDX-License-Identifier: MPL-2.0
 -}

{-# LANGUAGE ApplicativeDo #-}

module Xrefcheck.CLI
  ( VerifyMode (..)
  , ExclusionOptions (..)
  , Command (..)
  , DumpConfigMode (..)
  , Options (..)
  , NetworkingOptions (..)

  , addNetworkingOptions
  , shouldCheckLocal
  , shouldCheckExternal
  , addExclusionOptions
  , defaultConfigPaths
  , getCommand
  ) where

import Universum

import Data.Char qualified as C
import Data.List qualified as L
import Data.Text qualified as T
import Data.Version (showVersion)
import Options.Applicative
  (Mod, OptionFields, Parser, ReadM, auto, command, eitherReader, execParser, flag, flag',
  footerDoc, fullDesc, help, helpDoc, helper, hsubparser, info, infoOption, long, metavar, option,
  progDesc, short, strOption, switch, value)
import Options.Applicative.Help.Pretty (Doc, fill, fillSep, indent, pretty)
import Options.Applicative.Help.Pretty qualified as Pretty
import Text.Interpolation.Nyan

import Paths_xrefcheck (version)
import Xrefcheck.Config (NetworkingConfig, NetworkingConfig' (..))
import Xrefcheck.Core
import Xrefcheck.Scan
import Xrefcheck.System (CanonicalRelGlobPattern, PrintUnixPaths (..), mkCanonicalRelGlobPattern)
import Xrefcheck.Util (ColorMode (WithColors, WithoutColors))

modeReadM :: ReadM VerifyMode
modeReadM :: ReadM VerifyMode
modeReadM = (String -> Either String VerifyMode) -> ReadM VerifyMode
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String VerifyMode) -> ReadM VerifyMode)
-> (String -> Either String VerifyMode) -> ReadM VerifyMode
forall a b. (a -> b) -> a -> b
$ \String
s ->
  case (Element [ModeInfo] -> Bool)
-> [ModeInfo] -> Maybe (Element [ModeInfo])
forall t.
Container t =>
(Element t -> Bool) -> t -> Maybe (Element t)
find (\Element [ModeInfo]
mi -> ModeInfo -> String
miName Element [ModeInfo]
ModeInfo
mi String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s) [ModeInfo]
modes of
    Just Element [ModeInfo]
mi -> VerifyMode -> Either String VerifyMode
forall a b. b -> Either a b
Right (VerifyMode -> Either String VerifyMode)
-> VerifyMode -> Either String VerifyMode
forall a b. (a -> b) -> a -> b
$ ModeInfo -> VerifyMode
miMode Element [ModeInfo]
ModeInfo
mi
    Maybe (Element [ModeInfo])
Nothing -> String -> Either String VerifyMode
forall a b. a -> Either a b
Left
      [int||
      Unknown mode #s{s}.
      Allowed values: #{intercalate ", " $ map (show . miName) modes}.
      |]


data ModeInfo = ModeInfo
  { ModeInfo -> String
miName :: String
  , ModeInfo -> VerifyMode
miMode :: VerifyMode
  , ModeInfo -> String
miHelpText :: String
  }

modes :: [ModeInfo]
modes :: [ModeInfo]
modes =
  [ String -> VerifyMode -> String -> ModeInfo
ModeInfo String
"local-only" VerifyMode
LocalOnlyMode
      String
"Verify only references to local files."
  , String -> VerifyMode -> String -> ModeInfo
ModeInfo String
"external-only" VerifyMode
ExternalOnlyMode
      String
"Verify only external references (e.g. http or ftp URLs)."
  , String -> VerifyMode -> String -> ModeInfo
ModeInfo String
"full" VerifyMode
FullMode
      String
"Verify all references."
  ]

data Command
  = DefaultCommand Options
  | DumpConfig Flavor DumpConfigMode

data DumpConfigMode
  = DCMFile Bool FilePath
  | DCMStdout

data Options = Options
  { Options -> Maybe String
oConfigPath        :: Maybe FilePath
  , Options -> String
oRoot              :: FilePath
  , Options -> VerifyMode
oMode              :: VerifyMode
  , Options -> Bool
oVerbose           :: Bool
  , Options -> Maybe Bool
oShowProgressBar   :: Maybe Bool
  , Options -> Maybe ColorMode
oColorMode         :: Maybe ColorMode
  , Options -> PrintUnixPaths
oPrintUnixPaths    :: PrintUnixPaths
  , Options -> ExclusionOptions
oExclusionOptions  :: ExclusionOptions
  , Options -> NetworkingOptions
oNetworkingOptions :: NetworkingOptions
  , Options -> ScanPolicy
oScanPolicy        :: ScanPolicy
  }

data ExclusionOptions = ExclusionOptions
  { ExclusionOptions -> [CanonicalRelGlobPattern]
eoIgnore :: [CanonicalRelGlobPattern]
  }

addExclusionOptions :: ExclusionConfig -> ExclusionOptions -> ExclusionConfig
addExclusionOptions :: ExclusionConfig -> ExclusionOptions -> ExclusionConfig
addExclusionOptions ExclusionConfig{Field Identity [Regex]
Field Identity [CanonicalRelGlobPattern]
ecIgnore :: Field Identity [CanonicalRelGlobPattern]
ecIgnoreLocalRefsTo :: Field Identity [CanonicalRelGlobPattern]
ecIgnoreRefsFrom :: Field Identity [CanonicalRelGlobPattern]
ecIgnoreExternalRefsTo :: Field Identity [Regex]
ecIgnore :: forall (f :: * -> *).
ExclusionConfig' f -> Field f [CanonicalRelGlobPattern]
ecIgnoreLocalRefsTo :: forall (f :: * -> *).
ExclusionConfig' f -> Field f [CanonicalRelGlobPattern]
ecIgnoreRefsFrom :: forall (f :: * -> *).
ExclusionConfig' f -> Field f [CanonicalRelGlobPattern]
ecIgnoreExternalRefsTo :: forall (f :: * -> *). ExclusionConfig' f -> Field f [Regex]
..} (ExclusionOptions [CanonicalRelGlobPattern]
ignore) =
  ExclusionConfig
  { ecIgnore :: Field Identity [CanonicalRelGlobPattern]
ecIgnore = [CanonicalRelGlobPattern]
Field Identity [CanonicalRelGlobPattern]
ecIgnore [CanonicalRelGlobPattern]
-> [CanonicalRelGlobPattern] -> [CanonicalRelGlobPattern]
forall a. [a] -> [a] -> [a]
++ [CanonicalRelGlobPattern]
ignore
  , Field Identity [Regex]
Field Identity [CanonicalRelGlobPattern]
ecIgnoreLocalRefsTo :: Field Identity [CanonicalRelGlobPattern]
ecIgnoreRefsFrom :: Field Identity [CanonicalRelGlobPattern]
ecIgnoreExternalRefsTo :: Field Identity [Regex]
ecIgnoreLocalRefsTo :: Field Identity [CanonicalRelGlobPattern]
ecIgnoreRefsFrom :: Field Identity [CanonicalRelGlobPattern]
ecIgnoreExternalRefsTo :: Field Identity [Regex]
..
  }

data NetworkingOptions = NetworkingOptions
  { NetworkingOptions -> Maybe Int
noMaxRetries :: Maybe Int
  }

addNetworkingOptions :: NetworkingConfig -> NetworkingOptions -> NetworkingConfig
addNetworkingOptions :: NetworkingConfig -> NetworkingOptions -> NetworkingConfig
addNetworkingOptions NetworkingConfig{Field Identity Bool
Field Identity Int
Field Identity RedirectConfig
Field Identity (Time Second)
ncExternalRefCheckTimeout :: Field Identity (Time Second)
ncIgnoreAuthFailures :: Field Identity Bool
ncDefaultRetryAfter :: Field Identity (Time Second)
ncMaxRetries :: Field Identity Int
ncMaxTimeoutRetries :: Field Identity Int
ncMaxRedirectFollows :: Field Identity Int
ncExternalRefRedirects :: Field Identity RedirectConfig
ncExternalRefCheckTimeout :: forall (f :: * -> *). NetworkingConfig' f -> Field f (Time Second)
ncIgnoreAuthFailures :: forall (f :: * -> *). NetworkingConfig' f -> Field f Bool
ncDefaultRetryAfter :: forall (f :: * -> *). NetworkingConfig' f -> Field f (Time Second)
ncMaxRetries :: forall (f :: * -> *). NetworkingConfig' f -> Field f Int
ncMaxTimeoutRetries :: forall (f :: * -> *). NetworkingConfig' f -> Field f Int
ncMaxRedirectFollows :: forall (f :: * -> *). NetworkingConfig' f -> Field f Int
ncExternalRefRedirects :: forall (f :: * -> *). NetworkingConfig' f -> Field f RedirectConfig
..} (NetworkingOptions Maybe Int
maxRetries) =
  NetworkingConfig
  { ncMaxRetries :: Field Identity Int
ncMaxRetries = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
Field Identity Int
ncMaxRetries Maybe Int
maxRetries
  , Field Identity Bool
Field Identity Int
Field Identity RedirectConfig
Field Identity (Time Second)
ncExternalRefCheckTimeout :: Field Identity (Time Second)
ncIgnoreAuthFailures :: Field Identity Bool
ncDefaultRetryAfter :: Field Identity (Time Second)
ncMaxTimeoutRetries :: Field Identity Int
ncMaxRedirectFollows :: Field Identity Int
ncExternalRefRedirects :: Field Identity RedirectConfig
ncExternalRefCheckTimeout :: Field Identity (Time Second)
ncIgnoreAuthFailures :: Field Identity Bool
ncDefaultRetryAfter :: Field Identity (Time Second)
ncMaxTimeoutRetries :: Field Identity Int
ncMaxRedirectFollows :: Field Identity Int
ncExternalRefRedirects :: Field Identity RedirectConfig
..
  }

-- | Where to try to seek configuration if specific path is not set.
defaultConfigPaths :: [FilePath]
defaultConfigPaths :: [String]
defaultConfigPaths = [String
"./xrefcheck.yaml", String
"./.xrefcheck.yaml"]

-- | Strictly speaking, what config we will dump depends on the repository type:
-- this affects Markdown flavor, things excluded by default, e.t.c.
--
-- But at the moment there is one-to-one correspondence between repository types
-- and flavors, so we write a type alias here.
type RepoType = Flavor

filepathOption :: Mod OptionFields FilePath -> Parser FilePath
filepathOption :: Mod OptionFields String -> Parser String
filepathOption = Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption

globOption :: Mod OptionFields CanonicalRelGlobPattern -> Parser CanonicalRelGlobPattern
globOption :: Mod OptionFields CanonicalRelGlobPattern
-> Parser CanonicalRelGlobPattern
globOption = ReadM CanonicalRelGlobPattern
-> Mod OptionFields CanonicalRelGlobPattern
-> Parser CanonicalRelGlobPattern
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (ReadM CanonicalRelGlobPattern
 -> Mod OptionFields CanonicalRelGlobPattern
 -> Parser CanonicalRelGlobPattern)
-> ReadM CanonicalRelGlobPattern
-> Mod OptionFields CanonicalRelGlobPattern
-> Parser CanonicalRelGlobPattern
forall a b. (a -> b) -> a -> b
$ (String -> Either String CanonicalRelGlobPattern)
-> ReadM CanonicalRelGlobPattern
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String CanonicalRelGlobPattern
forall s. ToString s => s -> Either String CanonicalRelGlobPattern
mkCanonicalRelGlobPattern

repoTypeReadM :: ReadM RepoType
repoTypeReadM :: ReadM RepoType
repoTypeReadM = (String -> Either String RepoType) -> ReadM RepoType
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String RepoType) -> ReadM RepoType)
-> (String -> Either String RepoType) -> ReadM RepoType
forall a b. (a -> b) -> a -> b
$ \String
name ->
  String -> Maybe RepoType -> Either String RepoType
forall l r. l -> Maybe r -> Either l r
maybeToRight (String -> String
forall {a} {b}. (Show a, FromBuilder b) => a -> b
failureText String
name) (Maybe RepoType -> Either String RepoType)
-> Maybe RepoType -> Either String RepoType
forall a b. (a -> b) -> a -> b
$ String -> [(String, RepoType)] -> Maybe RepoType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup ((Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Char -> Char
C.toLower String
name) [(String, RepoType)]
allRepoTypesNamed
  where
    allRepoTypesNamed :: [(String, RepoType)]
allRepoTypesNamed =
      [RepoType]
allRepoTypes [RepoType]
-> (RepoType -> (String, RepoType)) -> [(String, RepoType)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \RepoType
ty -> (Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower (RepoType -> Text
forall b a. (Show a, IsString b) => a -> b
show RepoType
ty), RepoType
ty)
    failureText :: a -> b
failureText a
name =
      [int||
      Unknown repository type: #s{name}
      Expected one of: #{intercalate ", " $ map show allRepoTypes}.
      |]
    allRepoTypes :: [RepoType]
allRepoTypes = [RepoType]
allFlavors

optionsParser :: Parser Options
optionsParser :: Parser Options
optionsParser = do
  Maybe String
oConfigPath <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
filepathOption (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$
    Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"config" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help
      [int||
      Path to configuration file. \
      If not specified, tries to read config from one of \
      #{intercalate ", " $ map show defaultConfigPaths}. \
      If none of these files exist, default configuration is used.
      |]
  String
oRoot <- Mod OptionFields String -> Parser String
filepathOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$
    Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"root" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIRECTORY" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Path to repository root." Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"."
  VerifyMode
oMode <- ReadM VerifyMode
-> Mod OptionFields VerifyMode -> Parser VerifyMode
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM VerifyMode
modeReadM (Mod OptionFields VerifyMode -> Parser VerifyMode)
-> Mod OptionFields VerifyMode -> Parser VerifyMode
forall a b. (a -> b) -> a -> b
$
    Char -> Mod OptionFields VerifyMode
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm' Mod OptionFields VerifyMode
-> Mod OptionFields VerifyMode -> Mod OptionFields VerifyMode
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields VerifyMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"mode" Mod OptionFields VerifyMode
-> Mod OptionFields VerifyMode -> Mod OptionFields VerifyMode
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields VerifyMode
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"KEYWORD" Mod OptionFields VerifyMode
-> Mod OptionFields VerifyMode -> Mod OptionFields VerifyMode
forall a. Semigroup a => a -> a -> a
<>
    VerifyMode -> Mod OptionFields VerifyMode
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value VerifyMode
FullMode Mod OptionFields VerifyMode
-> Mod OptionFields VerifyMode -> Mod OptionFields VerifyMode
forall a. Semigroup a => a -> a -> a
<>
    Maybe Doc -> Mod OptionFields VerifyMode
forall (f :: * -> *) a. Maybe Doc -> Mod f a
helpDoc
      ( Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
Pretty.vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
          ([ModeInfo]
modes [ModeInfo] -> (ModeInfo -> Doc) -> [Doc]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ModeInfo
mi -> String -> Doc
forall a. IsString a => String -> a
fromString (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ ModeInfo -> String
miName ModeInfo
mi String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ModeInfo -> String
miHelpText ModeInfo
mi)
          [Doc] -> [Doc] -> [Doc]
forall a. Semigroup a => a -> a -> a
<>
          [ Doc
"Default mode: full."]
      )
  Bool
oVerbose <- Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"verbose" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Report repository scan and verification details."
  Maybe Bool
oShowProgressBar <- [Parser (Maybe Bool)] -> Parser (Maybe Bool)
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum
    [ Maybe Bool -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
forall a. a -> Mod FlagFields a -> Parser a
flag' (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool))
-> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
forall a b. (a -> b) -> a -> b
$
        String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"progress" Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help String
"Display progress bar during verification. \
             \This is enabled by default unless `CI` env var is set to true."
    , Maybe Bool -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
forall a. a -> Mod FlagFields a -> Parser a
flag' (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) (Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool))
-> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
forall a b. (a -> b) -> a -> b
$
        String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-progress" Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help String
"Do not display progress bar during verification."
    , Maybe Bool -> Parser (Maybe Bool)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
forall a. Maybe a
Nothing
    ]
  Maybe ColorMode
oColorMode <- [Parser (Maybe ColorMode)] -> Parser (Maybe ColorMode)
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum
    [ Maybe ColorMode
-> Mod FlagFields (Maybe ColorMode) -> Parser (Maybe ColorMode)
forall a. a -> Mod FlagFields a -> Parser a
flag' (ColorMode -> Maybe ColorMode
forall a. a -> Maybe a
Just ColorMode
WithColors) (Mod FlagFields (Maybe ColorMode) -> Parser (Maybe ColorMode))
-> Mod FlagFields (Maybe ColorMode) -> Parser (Maybe ColorMode)
forall a b. (a -> b) -> a -> b
$
        String -> Mod FlagFields (Maybe ColorMode)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"color" Mod FlagFields (Maybe ColorMode)
-> Mod FlagFields (Maybe ColorMode)
-> Mod FlagFields (Maybe ColorMode)
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod FlagFields (Maybe ColorMode)
forall (f :: * -> *) a. String -> Mod f a
help String
"Enable ANSI coloring of output. \
            \When `CI` env var is set to true or the command output corresponds to a terminal, \
            \this option will be enabled by default."
    , Maybe ColorMode
-> Mod FlagFields (Maybe ColorMode) -> Parser (Maybe ColorMode)
forall a. a -> Mod FlagFields a -> Parser a
flag' (ColorMode -> Maybe ColorMode
forall a. a -> Maybe a
Just ColorMode
WithoutColors) (Mod FlagFields (Maybe ColorMode) -> Parser (Maybe ColorMode))
-> Mod FlagFields (Maybe ColorMode) -> Parser (Maybe ColorMode)
forall a b. (a -> b) -> a -> b
$
        String -> Mod FlagFields (Maybe ColorMode)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-color" Mod FlagFields (Maybe ColorMode)
-> Mod FlagFields (Maybe ColorMode)
-> Mod FlagFields (Maybe ColorMode)
forall a. Semigroup a => a -> a -> a
<>
        String -> Mod FlagFields (Maybe ColorMode)
forall (f :: * -> *) a. String -> Mod f a
help String
"Disable ANSI coloring of output."
    , Maybe ColorMode -> Parser (Maybe ColorMode)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ColorMode
forall a. Maybe a
Nothing
    ]
  PrintUnixPaths
oPrintUnixPaths <- (Bool -> PrintUnixPaths) -> Parser Bool -> Parser PrintUnixPaths
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> PrintUnixPaths
PrintUnixPaths (Parser Bool -> Parser PrintUnixPaths)
-> Parser Bool -> Parser PrintUnixPaths
forall a b. (a -> b) -> a -> b
$ Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"--print-unix-paths" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Print paths in Unix style (with forward slashes) on all platforms."
  ExclusionOptions
oExclusionOptions <- Parser ExclusionOptions
exclusionOptionsParser
  NetworkingOptions
oNetworkingOptions <- Parser NetworkingOptions
networkingOptionsParser
  ScanPolicy
oScanPolicy <- ScanPolicy
-> ScanPolicy -> Mod FlagFields ScanPolicy -> Parser ScanPolicy
forall a. a -> a -> Mod FlagFields a -> Parser a
flag ScanPolicy
OnlyTracked ScanPolicy
IncludeUntracked (Mod FlagFields ScanPolicy -> Parser ScanPolicy)
-> Mod FlagFields ScanPolicy -> Parser ScanPolicy
forall a b. (a -> b) -> a -> b
$
    String -> Mod FlagFields ScanPolicy
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"include-untracked" Mod FlagFields ScanPolicy
-> Mod FlagFields ScanPolicy -> Mod FlagFields ScanPolicy
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod FlagFields ScanPolicy
forall (f :: * -> *) a. String -> Mod f a
help String
"Scan and treat as existing files that were not added to Git.\
         \ Files explicitly ignored by Git are always ignored by xrefcheck."
  return Options{Bool
String
Maybe Bool
Maybe String
Maybe ColorMode
PrintUnixPaths
VerifyMode
ScanPolicy
NetworkingOptions
ExclusionOptions
oConfigPath :: Maybe String
oRoot :: String
oMode :: VerifyMode
oVerbose :: Bool
oShowProgressBar :: Maybe Bool
oColorMode :: Maybe ColorMode
oPrintUnixPaths :: PrintUnixPaths
oExclusionOptions :: ExclusionOptions
oNetworkingOptions :: NetworkingOptions
oScanPolicy :: ScanPolicy
oConfigPath :: Maybe String
oRoot :: String
oMode :: VerifyMode
oVerbose :: Bool
oShowProgressBar :: Maybe Bool
oColorMode :: Maybe ColorMode
oPrintUnixPaths :: PrintUnixPaths
oExclusionOptions :: ExclusionOptions
oNetworkingOptions :: NetworkingOptions
oScanPolicy :: ScanPolicy
..}

exclusionOptionsParser :: Parser ExclusionOptions
exclusionOptionsParser :: Parser ExclusionOptions
exclusionOptionsParser = do
  [CanonicalRelGlobPattern]
eoIgnore <- Parser CanonicalRelGlobPattern -> Parser [CanonicalRelGlobPattern]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser CanonicalRelGlobPattern
 -> Parser [CanonicalRelGlobPattern])
-> (Mod OptionFields CanonicalRelGlobPattern
    -> Parser CanonicalRelGlobPattern)
-> Mod OptionFields CanonicalRelGlobPattern
-> Parser [CanonicalRelGlobPattern]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields CanonicalRelGlobPattern
-> Parser CanonicalRelGlobPattern
globOption (Mod OptionFields CanonicalRelGlobPattern
 -> Parser [CanonicalRelGlobPattern])
-> Mod OptionFields CanonicalRelGlobPattern
-> Parser [CanonicalRelGlobPattern]
forall a b. (a -> b) -> a -> b
$
    String -> Mod OptionFields CanonicalRelGlobPattern
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ignore" Mod OptionFields CanonicalRelGlobPattern
-> Mod OptionFields CanonicalRelGlobPattern
-> Mod OptionFields CanonicalRelGlobPattern
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields CanonicalRelGlobPattern
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"GLOB_PATTERN" Mod OptionFields CanonicalRelGlobPattern
-> Mod OptionFields CanonicalRelGlobPattern
-> Mod OptionFields CanonicalRelGlobPattern
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields CanonicalRelGlobPattern
forall (f :: * -> *) a. String -> Mod f a
help String
"Ignore these files. References to them will fail verification,\
         \ and references from them will not be verified.\
         \ Glob patterns that contain wildcards MUST be enclosed\
         \ in quotes to avoid being expanded by shell."
  return ExclusionOptions{[CanonicalRelGlobPattern]
eoIgnore :: [CanonicalRelGlobPattern]
eoIgnore :: [CanonicalRelGlobPattern]
..}

networkingOptionsParser :: Parser NetworkingOptions
networkingOptionsParser :: Parser NetworkingOptions
networkingOptionsParser = do
  Maybe Int
noMaxRetries <- ReadM (Maybe Int)
-> Mod OptionFields (Maybe Int) -> Parser (Maybe Int)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> ReadM Int -> ReadM (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int
forall a. Read a => ReadM a
auto) (Mod OptionFields (Maybe Int) -> Parser (Maybe Int))
-> Mod OptionFields (Maybe Int) -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$
    String -> Mod OptionFields (Maybe Int)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"retries" Mod OptionFields (Maybe Int)
-> Mod OptionFields (Maybe Int) -> Mod OptionFields (Maybe Int)
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields (Maybe Int)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT" Mod OptionFields (Maybe Int)
-> Mod OptionFields (Maybe Int) -> Mod OptionFields (Maybe Int)
forall a. Semigroup a => a -> a -> a
<>
    Maybe Int -> Mod OptionFields (Maybe Int)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Maybe Int
forall a. Maybe a
Nothing Mod OptionFields (Maybe Int)
-> Mod OptionFields (Maybe Int) -> Mod OptionFields (Maybe Int)
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields (Maybe Int)
forall (f :: * -> *) a. String -> Mod f a
help String
"How many attempts to retry an external link after getting \
         \a \"429 Too Many Requests\" response."
  return NetworkingOptions{Maybe Int
noMaxRetries :: Maybe Int
noMaxRetries :: Maybe Int
..}

dumpConfigOptions :: Parser Command
dumpConfigOptions :: Parser Command
dumpConfigOptions = Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser (Mod CommandFields Command -> Parser Command)
-> Mod CommandFields Command -> Parser Command
forall a b. (a -> b) -> a -> b
$
  String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"dump-config" (ParserInfo Command -> Mod CommandFields Command)
-> ParserInfo Command -> Mod CommandFields Command
forall a b. (a -> b) -> a -> b
$
    Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
parser (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$
    String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Dump default configuration into a file."
  where
    parser :: Parser Command
parser = RepoType -> DumpConfigMode -> Command
DumpConfig (RepoType -> DumpConfigMode -> Command)
-> Parser RepoType -> Parser (DumpConfigMode -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RepoType
repoTypeOption Parser (DumpConfigMode -> Command)
-> Parser DumpConfigMode -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DumpConfigMode
mode

    repoTypeOption :: Parser RepoType
repoTypeOption =
      ReadM RepoType -> Mod OptionFields RepoType -> Parser RepoType
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM RepoType
repoTypeReadM (Mod OptionFields RepoType -> Parser RepoType)
-> Mod OptionFields RepoType -> Parser RepoType
forall a b. (a -> b) -> a -> b
$
      Char -> Mod OptionFields RepoType
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't' Mod OptionFields RepoType
-> Mod OptionFields RepoType -> Mod OptionFields RepoType
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields RepoType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"type" Mod OptionFields RepoType
-> Mod OptionFields RepoType -> Mod OptionFields RepoType
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields RepoType
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"REPOSITORY_TYPE" Mod OptionFields RepoType
-> Mod OptionFields RepoType -> Mod OptionFields RepoType
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields RepoType
forall (f :: * -> *) a. String -> Mod f a
help [int||
      Git repository type. \
      Can be (#{intercalate " | " $ map show allFlavors}). \
      Case insensitive.
      |]

    mode :: Parser DumpConfigMode
mode =
      Parser DumpConfigMode
stdoutMode Parser DumpConfigMode
-> Parser DumpConfigMode -> Parser DumpConfigMode
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser DumpConfigMode
fileMode

    fileMode :: Parser DumpConfigMode
fileMode =
      Bool -> String -> DumpConfigMode
DCMFile (Bool -> String -> DumpConfigMode)
-> Parser Bool -> Parser (String -> DumpConfigMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
forceMode Parser (String -> DumpConfigMode)
-> Parser String -> Parser DumpConfigMode
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
outputOption

    stdoutMode :: Parser DumpConfigMode
stdoutMode =
      DumpConfigMode
-> Mod FlagFields DumpConfigMode -> Parser DumpConfigMode
forall a. a -> Mod FlagFields a -> Parser a
flag' DumpConfigMode
DCMStdout (Mod FlagFields DumpConfigMode -> Parser DumpConfigMode)
-> Mod FlagFields DumpConfigMode -> Parser DumpConfigMode
forall a b. (a -> b) -> a -> b
$
      String -> Mod FlagFields DumpConfigMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"stdout" Mod FlagFields DumpConfigMode
-> Mod FlagFields DumpConfigMode -> Mod FlagFields DumpConfigMode
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod FlagFields DumpConfigMode
forall (f :: * -> *) a. String -> Mod f a
help String
"Write the config file to stdout."

    forceMode :: Parser Bool
forceMode =
      Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
      String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"force" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Overwrite the config file if it already exists."

    outputOption :: Parser String
outputOption =
      Mod OptionFields String -> Parser String
filepathOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$
      Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
".xrefcheck.yaml" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
      String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Name of created config file."

totalParser :: Parser Command
totalParser :: Parser Command
totalParser = [Parser Command] -> Parser Command
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum
  [ Options -> Command
DefaultCommand (Options -> Command) -> Parser Options -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Options
optionsParser
  , Parser Command
dumpConfigOptions
  ]

versionOption :: Parser (a -> a)
versionOption :: forall a. Parser (a -> a)
versionOption = String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption (String
"xrefcheck-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Version -> String
showVersion Version
version) (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$
  String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<>
  String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help String
"Show version."

getCommand :: IO Command
getCommand :: IO Command
getCommand = do
  ParserInfo Command -> IO Command
forall a. ParserInfo a -> IO a
execParser (ParserInfo Command -> IO Command)
-> ParserInfo Command -> IO Command
forall a b. (a -> b) -> a -> b
$
    Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser ((Command -> Command) -> Command -> Command)
forall a. Parser (a -> a)
helper Parser ((Command -> Command) -> Command -> Command)
-> Parser (Command -> Command) -> Parser (Command -> Command)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Command -> Command)
forall a. Parser (a -> a)
versionOption Parser (Command -> Command) -> Parser Command -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
totalParser) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$
    InfoMod Command
forall a. InfoMod a
fullDesc InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<>
    String -> InfoMod Command
forall a. String -> InfoMod a
progDesc String
"Cross-references verifier for markdown documentation in \
             \Git repositories." InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<>
    Maybe Doc -> InfoMod Command
forall a. Maybe Doc -> InfoMod a
footerDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
ignoreModesMsg)

ignoreModesMsg :: Doc
ignoreModesMsg :: Doc
ignoreModesMsg = String -> Doc
text String
header Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
body
  where
    header :: String
header = String
"To ignore a link in your markdown, \
             \include \"<!-- xrefcheck: ignore <mode> -->\"\n\
             \comment with one of these modes:\n"

    body :: Doc
body = [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
fillSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((String, [String]) -> Doc) -> [(String, [String])] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (String, [String]) -> Doc
formatDesc [(String, [String])]
modeDescr

    modeDescr :: [(String, [String])]
modeDescr =
      [ (String
"  \"link\"",      String -> [String]
L.words String
"Ignore the link right after the comment.")
      , (String
"  \"paragraph\"", String -> [String]
L.words String
"Ignore the whole paragraph after the comment.")
      , (String
"  \"file\"",      String -> [String]
L.words String
"This mode can only be used at the top of \
                                    \markdown or right after comments at the top.")
      ]

    modeIndent :: Int
modeIndent = String -> Int
forall t. Container t => t -> Int
length (String
"\"paragraph\"" :: String) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
    descrIndent :: Int
descrIndent = Int
27 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
modeIndent

    formatDesc :: (String, [String]) -> Doc
formatDesc (String
mode, [String]
descr) =
      Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
fill Int
modeIndent (String -> Doc
text String
mode) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
      Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
indent Int
descrIndent ([Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
fillSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map String -> Doc
text [String]
descr)

text :: String -> Doc
text :: String -> Doc
text = String -> Doc
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty