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

{-# LANGUAGE PatternSynonyms #-}

-- | Various primitives.

module Xrefcheck.Core where

import Universum hiding ((^..))

import Control.Lens (folded, makeLenses, makePrisms, to, united, (^..))
import Data.Aeson (FromJSON (..), withText)
import Data.Char (isAlphaNum)
import Data.Char qualified as C
import Data.DList (DList)
import Data.DList qualified as DList
import Data.Map qualified as M
import Data.Reflection (Given)
import Data.Text qualified as T
import Fmt (Buildable (..), Builder)
import System.FilePath.Posix (isPathSeparator)
import Text.Interpolation.Nyan
import Time (Second, Time)

import Xrefcheck.Progress
import Xrefcheck.System
import Xrefcheck.Util

-----------------------------------------------------------
-- Types
-----------------------------------------------------------

-- | Markdown flavor.
--
-- Unfortunatelly, CMark renderers used on different sites slightly differ,
-- we have to account for that.
data Flavor
  = GitHub
  | GitLab
  deriving stock (Int -> Flavor -> ShowS
[Flavor] -> ShowS
Flavor -> String
(Int -> Flavor -> ShowS)
-> (Flavor -> String) -> ([Flavor] -> ShowS) -> Show Flavor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Flavor -> ShowS
showsPrec :: Int -> Flavor -> ShowS
$cshow :: Flavor -> String
show :: Flavor -> String
$cshowList :: [Flavor] -> ShowS
showList :: [Flavor] -> ShowS
Show, Int -> Flavor
Flavor -> Int
Flavor -> [Flavor]
Flavor -> Flavor
Flavor -> Flavor -> [Flavor]
Flavor -> Flavor -> Flavor -> [Flavor]
(Flavor -> Flavor)
-> (Flavor -> Flavor)
-> (Int -> Flavor)
-> (Flavor -> Int)
-> (Flavor -> [Flavor])
-> (Flavor -> Flavor -> [Flavor])
-> (Flavor -> Flavor -> [Flavor])
-> (Flavor -> Flavor -> Flavor -> [Flavor])
-> Enum Flavor
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Flavor -> Flavor
succ :: Flavor -> Flavor
$cpred :: Flavor -> Flavor
pred :: Flavor -> Flavor
$ctoEnum :: Int -> Flavor
toEnum :: Int -> Flavor
$cfromEnum :: Flavor -> Int
fromEnum :: Flavor -> Int
$cenumFrom :: Flavor -> [Flavor]
enumFrom :: Flavor -> [Flavor]
$cenumFromThen :: Flavor -> Flavor -> [Flavor]
enumFromThen :: Flavor -> Flavor -> [Flavor]
$cenumFromTo :: Flavor -> Flavor -> [Flavor]
enumFromTo :: Flavor -> Flavor -> [Flavor]
$cenumFromThenTo :: Flavor -> Flavor -> Flavor -> [Flavor]
enumFromThenTo :: Flavor -> Flavor -> Flavor -> [Flavor]
Enum, Flavor
Flavor -> Flavor -> Bounded Flavor
forall a. a -> a -> Bounded a
$cminBound :: Flavor
minBound :: Flavor
$cmaxBound :: Flavor
maxBound :: Flavor
Bounded)

allFlavors :: [Flavor]
allFlavors :: [Flavor]
allFlavors = [Flavor
forall a. Bounded a => a
minBound .. Flavor
forall a. Bounded a => a
maxBound]

-- | Whether anchors are case-sensitive for a given Markdown flavour or not.
caseInsensitiveAnchors :: Flavor -> Bool
caseInsensitiveAnchors :: Flavor -> Bool
caseInsensitiveAnchors Flavor
GitHub = Bool
True
caseInsensitiveAnchors Flavor
GitLab = Bool
False

instance FromJSON Flavor where
  parseJSON :: Value -> Parser Flavor
parseJSON = String -> (Text -> Parser Flavor) -> Value -> Parser Flavor
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"flavor" ((Text -> Parser Flavor) -> Value -> Parser Flavor)
-> (Text -> Parser Flavor) -> Value -> Parser Flavor
forall a b. (a -> b) -> a -> b
$ \Text
txt ->
    case Text -> Text
T.toLower Text
txt of
      Text
"github" -> Flavor -> Parser Flavor
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Flavor
GitHub
      Text
"gitlab" -> Flavor -> Parser Flavor
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Flavor
GitLab
      Text
_ -> String -> Parser Flavor
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Flavor) -> String -> Parser Flavor
forall a b. (a -> b) -> a -> b
$ String
"Unknown flavor " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
txt

-- | Description of element position in source file.
-- We keep this in text because scanners for different formats use different
-- representation of this thing, and it actually appears in reports only.
newtype Position = Position Text
  deriving stock (Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
(Int -> Position -> ShowS)
-> (Position -> String) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Position -> ShowS
showsPrec :: Int -> Position -> ShowS
$cshow :: Position -> String
show :: Position -> String
$cshowList :: [Position] -> ShowS
showList :: [Position] -> ShowS
Show, Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
/= :: Position -> Position -> Bool
Eq, (forall x. Position -> Rep Position x)
-> (forall x. Rep Position x -> Position) -> Generic Position
forall x. Rep Position x -> Position
forall x. Position -> Rep Position x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Position -> Rep Position x
from :: forall x. Position -> Rep Position x
$cto :: forall x. Rep Position x -> Position
to :: forall x. Rep Position x -> Position
Generic)

instance Buildable Position where
  build :: Position -> Builder
build (Position Text
pos) = Text -> Builder
forall p. Buildable p => p -> Builder
build Text
pos

-- | Full info about a reference.
data Reference = Reference
  { Reference -> Text
rName :: Text
    -- ^ Text displayed as reference.
  , Reference -> Position
rPos :: Position
    -- ^ Position in source file.
  , Reference -> ReferenceInfo
rInfo :: ReferenceInfo
    -- ^ More info about the reference.
  } deriving stock (Int -> Reference -> ShowS
[Reference] -> ShowS
Reference -> String
(Int -> Reference -> ShowS)
-> (Reference -> String)
-> ([Reference] -> ShowS)
-> Show Reference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reference -> ShowS
showsPrec :: Int -> Reference -> ShowS
$cshow :: Reference -> String
show :: Reference -> String
$cshowList :: [Reference] -> ShowS
showList :: [Reference] -> ShowS
Show, (forall x. Reference -> Rep Reference x)
-> (forall x. Rep Reference x -> Reference) -> Generic Reference
forall x. Rep Reference x -> Reference
forall x. Reference -> Rep Reference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Reference -> Rep Reference x
from :: forall x. Reference -> Rep Reference x
$cto :: forall x. Rep Reference x -> Reference
to :: forall x. Rep Reference x -> Reference
Generic)

-- | Info about the reference.
data ReferenceInfo
  = RIExternal ExternalLink
  | RIFile ReferenceInfoFile
  deriving stock (Int -> ReferenceInfo -> ShowS
[ReferenceInfo] -> ShowS
ReferenceInfo -> String
(Int -> ReferenceInfo -> ShowS)
-> (ReferenceInfo -> String)
-> ([ReferenceInfo] -> ShowS)
-> Show ReferenceInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReferenceInfo -> ShowS
showsPrec :: Int -> ReferenceInfo -> ShowS
$cshow :: ReferenceInfo -> String
show :: ReferenceInfo -> String
$cshowList :: [ReferenceInfo] -> ShowS
showList :: [ReferenceInfo] -> ShowS
Show, (forall x. ReferenceInfo -> Rep ReferenceInfo x)
-> (forall x. Rep ReferenceInfo x -> ReferenceInfo)
-> Generic ReferenceInfo
forall x. Rep ReferenceInfo x -> ReferenceInfo
forall x. ReferenceInfo -> Rep ReferenceInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReferenceInfo -> Rep ReferenceInfo x
from :: forall x. ReferenceInfo -> Rep ReferenceInfo x
$cto :: forall x. Rep ReferenceInfo x -> ReferenceInfo
to :: forall x. Rep ReferenceInfo x -> ReferenceInfo
Generic)

data ReferenceInfoFile = ReferenceInfoFile
  { ReferenceInfoFile -> Maybe Text
rifAnchor :: Maybe Text
    -- ^ Section or custom anchor tag.
  , ReferenceInfoFile -> FileLink
rifLink :: FileLink
    -- ^ More info about the link.
  } deriving stock (Int -> ReferenceInfoFile -> ShowS
[ReferenceInfoFile] -> ShowS
ReferenceInfoFile -> String
(Int -> ReferenceInfoFile -> ShowS)
-> (ReferenceInfoFile -> String)
-> ([ReferenceInfoFile] -> ShowS)
-> Show ReferenceInfoFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReferenceInfoFile -> ShowS
showsPrec :: Int -> ReferenceInfoFile -> ShowS
$cshow :: ReferenceInfoFile -> String
show :: ReferenceInfoFile -> String
$cshowList :: [ReferenceInfoFile] -> ShowS
showList :: [ReferenceInfoFile] -> ShowS
Show, (forall x. ReferenceInfoFile -> Rep ReferenceInfoFile x)
-> (forall x. Rep ReferenceInfoFile x -> ReferenceInfoFile)
-> Generic ReferenceInfoFile
forall x. Rep ReferenceInfoFile x -> ReferenceInfoFile
forall x. ReferenceInfoFile -> Rep ReferenceInfoFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReferenceInfoFile -> Rep ReferenceInfoFile x
from :: forall x. ReferenceInfoFile -> Rep ReferenceInfoFile x
$cto :: forall x. Rep ReferenceInfoFile x -> ReferenceInfoFile
to :: forall x. Rep ReferenceInfoFile x -> ReferenceInfoFile
Generic)

data ExternalLink
  = ELUrl Text
    -- ^ Reference to a file at outer site, e.g @[d](http://www.google.com/doodles)@.
  | ELOther Text
    -- ^ Entry not to be processed, e.g. @mailto:e-mail@.
  deriving stock (Int -> ExternalLink -> ShowS
[ExternalLink] -> ShowS
ExternalLink -> String
(Int -> ExternalLink -> ShowS)
-> (ExternalLink -> String)
-> ([ExternalLink] -> ShowS)
-> Show ExternalLink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExternalLink -> ShowS
showsPrec :: Int -> ExternalLink -> ShowS
$cshow :: ExternalLink -> String
show :: ExternalLink -> String
$cshowList :: [ExternalLink] -> ShowS
showList :: [ExternalLink] -> ShowS
Show, (forall x. ExternalLink -> Rep ExternalLink x)
-> (forall x. Rep ExternalLink x -> ExternalLink)
-> Generic ExternalLink
forall x. Rep ExternalLink x -> ExternalLink
forall x. ExternalLink -> Rep ExternalLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExternalLink -> Rep ExternalLink x
from :: forall x. ExternalLink -> Rep ExternalLink x
$cto :: forall x. Rep ExternalLink x -> ExternalLink
to :: forall x. Rep ExternalLink x -> ExternalLink
Generic)

data FileLink
  = FLAbsolute RelPosixLink
    -- ^ Reference to a file or directory relative to the repository root.
  | FLRelative RelPosixLink
    -- ^ Reference to a file or directory relative to the given one.
  | FLLocal
    -- ^ Reference to this file.
  deriving stock (Int -> FileLink -> ShowS
[FileLink] -> ShowS
FileLink -> String
(Int -> FileLink -> ShowS)
-> (FileLink -> String) -> ([FileLink] -> ShowS) -> Show FileLink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileLink -> ShowS
showsPrec :: Int -> FileLink -> ShowS
$cshow :: FileLink -> String
show :: FileLink -> String
$cshowList :: [FileLink] -> ShowS
showList :: [FileLink] -> ShowS
Show, (forall x. FileLink -> Rep FileLink x)
-> (forall x. Rep FileLink x -> FileLink) -> Generic FileLink
forall x. Rep FileLink x -> FileLink
forall x. FileLink -> Rep FileLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FileLink -> Rep FileLink x
from :: forall x. FileLink -> Rep FileLink x
$cto :: forall x. Rep FileLink x -> FileLink
to :: forall x. Rep FileLink x -> FileLink
Generic)

makePrisms ''ReferenceInfo
makePrisms ''ExternalLink

pattern PathSep :: Char
pattern $mPathSep :: forall {r}. Char -> ((# #) -> r) -> ((# #) -> r) -> r
PathSep <- (isPathSeparator -> True)

-- | Compute the 'ReferenceInfo' corresponding to a given link.
referenceInfo :: Text -> ReferenceInfo
referenceInfo :: Text -> ReferenceInfo
referenceInfo Text
url
  | Bool
hasUrlProtocol = ExternalLink -> ReferenceInfo
RIExternal (ExternalLink -> ReferenceInfo) -> ExternalLink -> ReferenceInfo
forall a b. (a -> b) -> a -> b
$ Text -> ExternalLink
ELUrl Text
url
  | Bool
hasProtocol = ExternalLink -> ReferenceInfo
RIExternal (ExternalLink -> ReferenceInfo) -> ExternalLink -> ReferenceInfo
forall a b. (a -> b) -> a -> b
$ Text -> ExternalLink
ELOther Text
url
  | Text -> Bool
forall t. Container t => t -> Bool
null Text
link = ReferenceInfoFile -> ReferenceInfo
RIFile (ReferenceInfoFile -> ReferenceInfo)
-> ReferenceInfoFile -> ReferenceInfo
forall a b. (a -> b) -> a -> b
$ Maybe Text -> FileLink -> ReferenceInfoFile
ReferenceInfoFile Maybe Text
anchor FileLink
FLLocal
  | Bool
otherwise = case Text -> Maybe (Char, Text)
T.uncons Text
link of
      Just (Char
PathSep, Text
path) ->
        ReferenceInfoFile -> ReferenceInfo
RIFile (ReferenceInfoFile -> ReferenceInfo)
-> ReferenceInfoFile -> ReferenceInfo
forall a b. (a -> b) -> a -> b
$ Maybe Text -> FileLink -> ReferenceInfoFile
ReferenceInfoFile Maybe Text
anchor (FileLink -> ReferenceInfoFile) -> FileLink -> ReferenceInfoFile
forall a b. (a -> b) -> a -> b
$ RelPosixLink -> FileLink
FLAbsolute (RelPosixLink -> FileLink) -> RelPosixLink -> FileLink
forall a b. (a -> b) -> a -> b
$ Text -> RelPosixLink
RelPosixLink Text
path
      Maybe (Char, Text)
_ ->
        ReferenceInfoFile -> ReferenceInfo
RIFile (ReferenceInfoFile -> ReferenceInfo)
-> ReferenceInfoFile -> ReferenceInfo
forall a b. (a -> b) -> a -> b
$ Maybe Text -> FileLink -> ReferenceInfoFile
ReferenceInfoFile Maybe Text
anchor (FileLink -> ReferenceInfoFile) -> FileLink -> ReferenceInfoFile
forall a b. (a -> b) -> a -> b
$ RelPosixLink -> FileLink
FLRelative (RelPosixLink -> FileLink) -> RelPosixLink -> FileLink
forall a b. (a -> b) -> a -> b
$ Text -> RelPosixLink
RelPosixLink Text
link
  where
    hasUrlProtocol :: Bool
hasUrlProtocol = Text
"://" Text -> Text -> Bool
`T.isInfixOf` Int -> Text -> Text
T.take Int
10 Text
url
    hasProtocol :: Bool
hasProtocol = Text
":" Text -> Text -> Bool
`T.isInfixOf` Int -> Text -> Text
T.take Int
10 Text
url
    (Text
link, Maybe Text
anchor) = case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"#" Text
url of
      [Text
t] -> (Text
t, Maybe Text
forall a. Maybe a
Nothing)
      Text
t : [Text]
ts -> (Text
t, Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"#" [Text]
ts)
      [] -> (Text
url, Maybe Text
forall a. Maybe a
Nothing)

-- | Context of anchor.
data AnchorType
  = HeaderAnchor Int
    -- ^ Every section header is usually an anchor
  | HandAnchor
    -- ^ They can be set up manually
  | BiblioAnchor
    -- ^ Id of entry in bibliography
  deriving stock (Int -> AnchorType -> ShowS
[AnchorType] -> ShowS
AnchorType -> String
(Int -> AnchorType -> ShowS)
-> (AnchorType -> String)
-> ([AnchorType] -> ShowS)
-> Show AnchorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnchorType -> ShowS
showsPrec :: Int -> AnchorType -> ShowS
$cshow :: AnchorType -> String
show :: AnchorType -> String
$cshowList :: [AnchorType] -> ShowS
showList :: [AnchorType] -> ShowS
Show, AnchorType -> AnchorType -> Bool
(AnchorType -> AnchorType -> Bool)
-> (AnchorType -> AnchorType -> Bool) -> Eq AnchorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnchorType -> AnchorType -> Bool
== :: AnchorType -> AnchorType -> Bool
$c/= :: AnchorType -> AnchorType -> Bool
/= :: AnchorType -> AnchorType -> Bool
Eq, (forall x. AnchorType -> Rep AnchorType x)
-> (forall x. Rep AnchorType x -> AnchorType) -> Generic AnchorType
forall x. Rep AnchorType x -> AnchorType
forall x. AnchorType -> Rep AnchorType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AnchorType -> Rep AnchorType x
from :: forall x. AnchorType -> Rep AnchorType x
$cto :: forall x. Rep AnchorType x -> AnchorType
to :: forall x. Rep AnchorType x -> AnchorType
Generic)

-- | A referable anchor.
data Anchor = Anchor
  { Anchor -> AnchorType
aType :: AnchorType
  , Anchor -> Text
aName :: Text
  , Anchor -> Position
aPos  :: Position
  } deriving stock (Int -> Anchor -> ShowS
[Anchor] -> ShowS
Anchor -> String
(Int -> Anchor -> ShowS)
-> (Anchor -> String) -> ([Anchor] -> ShowS) -> Show Anchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Anchor -> ShowS
showsPrec :: Int -> Anchor -> ShowS
$cshow :: Anchor -> String
show :: Anchor -> String
$cshowList :: [Anchor] -> ShowS
showList :: [Anchor] -> ShowS
Show, Anchor -> Anchor -> Bool
(Anchor -> Anchor -> Bool)
-> (Anchor -> Anchor -> Bool) -> Eq Anchor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Anchor -> Anchor -> Bool
== :: Anchor -> Anchor -> Bool
$c/= :: Anchor -> Anchor -> Bool
/= :: Anchor -> Anchor -> Bool
Eq, (forall x. Anchor -> Rep Anchor x)
-> (forall x. Rep Anchor x -> Anchor) -> Generic Anchor
forall x. Rep Anchor x -> Anchor
forall x. Anchor -> Rep Anchor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Anchor -> Rep Anchor x
from :: forall x. Anchor -> Rep Anchor x
$cto :: forall x. Rep Anchor x -> Anchor
to :: forall x. Rep Anchor x -> Anchor
Generic)

data FileInfoDiff = FileInfoDiff
  { FileInfoDiff -> DList Reference
_fidReferences :: DList Reference
  , FileInfoDiff -> DList Anchor
_fidAnchors    :: DList Anchor
  }
makeLenses ''FileInfoDiff

diffToFileInfo :: FileInfoDiff -> FileInfo
diffToFileInfo :: FileInfoDiff -> FileInfo
diffToFileInfo (FileInfoDiff DList Reference
refs DList Anchor
anchors) =
    [Reference] -> [Anchor] -> FileInfo
FileInfo (DList Reference -> [Reference]
forall a. DList a -> [a]
DList.toList DList Reference
refs) (DList Anchor -> [Anchor]
forall a. DList a -> [a]
DList.toList DList Anchor
anchors)

instance Semigroup FileInfoDiff where
  FileInfoDiff DList Reference
a DList Anchor
b <> :: FileInfoDiff -> FileInfoDiff -> FileInfoDiff
<> FileInfoDiff DList Reference
c DList Anchor
d = DList Reference -> DList Anchor -> FileInfoDiff
FileInfoDiff (DList Reference
a DList Reference -> DList Reference -> DList Reference
forall a. Semigroup a => a -> a -> a
<> DList Reference
c) (DList Anchor
b DList Anchor -> DList Anchor -> DList Anchor
forall a. Semigroup a => a -> a -> a
<> DList Anchor
d)

instance Monoid FileInfoDiff where
  mempty :: FileInfoDiff
mempty = DList Reference -> DList Anchor -> FileInfoDiff
FileInfoDiff DList Reference
forall a. Monoid a => a
mempty DList Anchor
forall a. Monoid a => a
mempty

-- | All information regarding a single file we care about.
data FileInfo = FileInfo
  { FileInfo -> [Reference]
_fiReferences :: [Reference]
  , FileInfo -> [Anchor]
_fiAnchors    :: [Anchor]
  } deriving stock (Int -> FileInfo -> ShowS
[FileInfo] -> ShowS
FileInfo -> String
(Int -> FileInfo -> ShowS)
-> (FileInfo -> String) -> ([FileInfo] -> ShowS) -> Show FileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileInfo -> ShowS
showsPrec :: Int -> FileInfo -> ShowS
$cshow :: FileInfo -> String
show :: FileInfo -> String
$cshowList :: [FileInfo] -> ShowS
showList :: [FileInfo] -> ShowS
Show, (forall x. FileInfo -> Rep FileInfo x)
-> (forall x. Rep FileInfo x -> FileInfo) -> Generic FileInfo
forall x. Rep FileInfo x -> FileInfo
forall x. FileInfo -> Rep FileInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FileInfo -> Rep FileInfo x
from :: forall x. FileInfo -> Rep FileInfo x
$cto :: forall x. Rep FileInfo x -> FileInfo
to :: forall x. Rep FileInfo x -> FileInfo
Generic)
makeLenses ''FileInfo

data ScanPolicy
  = OnlyTracked
  -- ^ Scan and treat as existing only files tracked by Git.
  -- Warn when there are scannable files not added to Git yet.
  | IncludeUntracked
  -- ^ Also scan and treat as existing
  -- files that were neither tracked nor ignored by Git.
  deriving stock (Int -> ScanPolicy -> ShowS
[ScanPolicy] -> ShowS
ScanPolicy -> String
(Int -> ScanPolicy -> ShowS)
-> (ScanPolicy -> String)
-> ([ScanPolicy] -> ShowS)
-> Show ScanPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScanPolicy -> ShowS
showsPrec :: Int -> ScanPolicy -> ShowS
$cshow :: ScanPolicy -> String
show :: ScanPolicy -> String
$cshowList :: [ScanPolicy] -> ShowS
showList :: [ScanPolicy] -> ShowS
Show, ScanPolicy -> ScanPolicy -> Bool
(ScanPolicy -> ScanPolicy -> Bool)
-> (ScanPolicy -> ScanPolicy -> Bool) -> Eq ScanPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScanPolicy -> ScanPolicy -> Bool
== :: ScanPolicy -> ScanPolicy -> Bool
$c/= :: ScanPolicy -> ScanPolicy -> Bool
/= :: ScanPolicy -> ScanPolicy -> Bool
Eq)

data FileStatus
  = Scanned FileInfo
  | NotScannable
  -- ^ Files that are not supported by our scanners.
  | NotAddedToGit
  -- ^ We are not scanning files that are not added to git
  -- unless --include-untracked CLI option was enabled, but we're
  -- gathering information about them to improve reports.
  deriving stock (Int -> FileStatus -> ShowS
[FileStatus] -> ShowS
FileStatus -> String
(Int -> FileStatus -> ShowS)
-> (FileStatus -> String)
-> ([FileStatus] -> ShowS)
-> Show FileStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileStatus -> ShowS
showsPrec :: Int -> FileStatus -> ShowS
$cshow :: FileStatus -> String
show :: FileStatus -> String
$cshowList :: [FileStatus] -> ShowS
showList :: [FileStatus] -> ShowS
Show)

data DirectoryStatus
  = TrackedDirectory
  | UntrackedDirectory
  deriving stock (Int -> DirectoryStatus -> ShowS
[DirectoryStatus] -> ShowS
DirectoryStatus -> String
(Int -> DirectoryStatus -> ShowS)
-> (DirectoryStatus -> String)
-> ([DirectoryStatus] -> ShowS)
-> Show DirectoryStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DirectoryStatus -> ShowS
showsPrec :: Int -> DirectoryStatus -> ShowS
$cshow :: DirectoryStatus -> String
show :: DirectoryStatus -> String
$cshowList :: [DirectoryStatus] -> ShowS
showList :: [DirectoryStatus] -> ShowS
Show)

-- | All tracked files and directories.
data RepoInfo = RepoInfo
  { RepoInfo -> Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
riFiles :: Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
    -- ^ Files from the repo with `FileInfo` attached to files that we've scanned.
  , RepoInfo
-> Map CanonicalRelPosixLink (RelPosixLink, DirectoryStatus)
riDirectories :: Map CanonicalRelPosixLink (RelPosixLink, DirectoryStatus)
    -- ^ Directories containing those files.
  }

-- Search for a file in the repository.
lookupFile :: CanonicalRelPosixLink -> RepoInfo -> Maybe FileStatus
lookupFile :: CanonicalRelPosixLink -> RepoInfo -> Maybe FileStatus
lookupFile CanonicalRelPosixLink
path RepoInfo{Map CanonicalRelPosixLink (RelPosixLink, DirectoryStatus)
Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
riFiles :: RepoInfo -> Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
riDirectories :: RepoInfo
-> Map CanonicalRelPosixLink (RelPosixLink, DirectoryStatus)
riFiles :: Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
riDirectories :: Map CanonicalRelPosixLink (RelPosixLink, DirectoryStatus)
..} =
  (RelPosixLink, FileStatus) -> FileStatus
forall a b. (a, b) -> b
snd ((RelPosixLink, FileStatus) -> FileStatus)
-> Maybe (RelPosixLink, FileStatus) -> Maybe FileStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CanonicalRelPosixLink
-> Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
-> Maybe (RelPosixLink, FileStatus)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup CanonicalRelPosixLink
path Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
riFiles

-- Search for a directory in the repository.
lookupDirectory :: CanonicalRelPosixLink -> RepoInfo -> Maybe DirectoryStatus
lookupDirectory :: CanonicalRelPosixLink -> RepoInfo -> Maybe DirectoryStatus
lookupDirectory CanonicalRelPosixLink
path RepoInfo{Map CanonicalRelPosixLink (RelPosixLink, DirectoryStatus)
Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
riFiles :: RepoInfo -> Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
riDirectories :: RepoInfo
-> Map CanonicalRelPosixLink (RelPosixLink, DirectoryStatus)
riFiles :: Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
riDirectories :: Map CanonicalRelPosixLink (RelPosixLink, DirectoryStatus)
..} =
  (RelPosixLink, DirectoryStatus) -> DirectoryStatus
forall a b. (a, b) -> b
snd ((RelPosixLink, DirectoryStatus) -> DirectoryStatus)
-> Maybe (RelPosixLink, DirectoryStatus) -> Maybe DirectoryStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CanonicalRelPosixLink
-> Map CanonicalRelPosixLink (RelPosixLink, DirectoryStatus)
-> Maybe (RelPosixLink, DirectoryStatus)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup CanonicalRelPosixLink
path Map CanonicalRelPosixLink (RelPosixLink, DirectoryStatus)
riDirectories

-----------------------------------------------------------
-- Instances
-----------------------------------------------------------

instance NFData ReferenceInfo
instance NFData Anchor
instance NFData AnchorType
instance NFData ExternalLink
instance NFData FileInfo
instance NFData FileLink
instance NFData Position
instance NFData Reference
instance NFData ReferenceInfoFile

instance Given ColorMode => Buildable Reference where
  build :: Reference -> Builder
build Reference{Text
ReferenceInfo
Position
rName :: Reference -> Text
rPos :: Reference -> Position
rInfo :: Reference -> ReferenceInfo
rName :: Text
rPos :: Position
rInfo :: ReferenceInfo
..} =
    case ReferenceInfo
rInfo of
      RIFile ReferenceInfoFile{Maybe Text
FileLink
rifAnchor :: ReferenceInfoFile -> Maybe Text
rifLink :: ReferenceInfoFile -> FileLink
rifAnchor :: Maybe Text
rifLink :: FileLink
..} ->
        case FileLink
rifLink of
          FileLink
FLLocal ->
            [int||
            reference #{paren $ colorIfNeeded Green "file-local"} at #{rPos}:
              - text: #s{rName}
              - anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
            |]
          FLRelative RelPosixLink
link ->
            [int||
            reference #{paren $ colorIfNeeded Yellow "relative"} at #{rPos}:
              - text: #s{rName}
              - link: #{link}
              - anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
            |]
          FLAbsolute RelPosixLink
link ->
            [int||
            reference #{paren $ colorIfNeeded Yellow "absolute"} at #{rPos}:
              - text: #s{rName}
              - link: /#{link}
              - anchor: #{rifAnchor ?: styleIfNeeded Faint "-"}
            |]
      RIExternal (ELUrl Text
url) ->
        [int||
        reference #{paren $ colorIfNeeded Red "external"} at #{rPos}:
          - text: #s{rName}
          - link: #{url}
        |]
      RIExternal (ELOther Text
url) ->
        [int||
        reference (other) at #{rPos}:
          - text: #s{rName}
          - link: #{url}
        |]

instance Given ColorMode => Buildable AnchorType where
  build :: AnchorType -> Builder
build = Style -> Builder -> Builder
forall a. (Pretty a, Given ColorMode) => Style -> a -> a
styleIfNeeded Style
Faint (Builder -> Builder)
-> (AnchorType -> Builder) -> AnchorType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    HeaderAnchor Int
l -> Color -> Builder -> Builder
forall a. (Pretty a, Given ColorMode) => Color -> a -> a
colorIfNeeded Color
Green (Builder
"header " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
headerLevelToRoman Int
l)
    AnchorType
HandAnchor -> Color -> Builder -> Builder
forall a. (Pretty a, Given ColorMode) => Color -> a -> a
colorIfNeeded Color
Yellow Builder
"handmade"
    AnchorType
BiblioAnchor -> Color -> Builder -> Builder
forall a. (Pretty a, Given ColorMode) => Color -> a -> a
colorIfNeeded Color
Cyan Builder
"biblio"
    where
      headerLevelToRoman :: Int -> Builder
headerLevelToRoman = \case
        Int
1 -> Builder
"I"
        Int
2 -> Builder
"II"
        Int
3 -> Builder
"III"
        Int
4 -> Builder
"IV"
        Int
5 -> Builder
"V"
        Int
6 -> Builder
"VI"
        Int
n -> Text -> Builder
forall a. HasCallStack => Text -> a
error Text
"Bad header level: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall b a. (Show a, IsString b) => a -> b
show Int
n

instance Given ColorMode => Buildable Anchor where
  build :: Anchor -> Builder
build Anchor{Text
Position
AnchorType
aType :: Anchor -> AnchorType
aName :: Anchor -> Text
aPos :: Anchor -> Position
aType :: AnchorType
aName :: Text
aPos :: Position
..} =
    [int||
    #{aName} (#{aType}) at #{aPos}
    |]

instance Given ColorMode => Buildable FileInfo where
  build :: FileInfo -> Builder
build FileInfo{[Reference]
[Anchor]
_fiReferences :: FileInfo -> [Reference]
_fiAnchors :: FileInfo -> [Anchor]
_fiReferences :: [Reference]
_fiAnchors :: [Anchor]
..} =
    [int||
    - references:
    #{ interpolateIndentF 4 $ maybe "none" interpolateBlockListF (nonEmpty _fiReferences) }
    - anchors:
    #{ interpolateIndentF 4 $ maybe "none" interpolateBlockListF (nonEmpty _fiAnchors) }
    |]

instance Given ColorMode => Buildable RepoInfo where
  build :: RepoInfo -> Builder
build RepoInfo{Map CanonicalRelPosixLink (RelPosixLink, DirectoryStatus)
Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
riFiles :: RepoInfo -> Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
riDirectories :: RepoInfo
-> Map CanonicalRelPosixLink (RelPosixLink, DirectoryStatus)
riFiles :: Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
riDirectories :: Map CanonicalRelPosixLink (RelPosixLink, DirectoryStatus)
..}
    | Just NonEmpty (RelPosixLink, FileInfo)
scanned <- [(RelPosixLink, FileInfo)]
-> Maybe (NonEmpty (RelPosixLink, FileInfo))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [(RelPosixLink
name, FileInfo
info) | (CanonicalRelPosixLink
_, (RelPosixLink
name, Scanned FileInfo
info)) <- Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
-> [(Key (Map CanonicalRelPosixLink (RelPosixLink, FileStatus)),
     Val (Map CanonicalRelPosixLink (RelPosixLink, FileStatus)))]
forall t. ToPairs t => t -> [(Key t, Val t)]
toPairs Map CanonicalRelPosixLink (RelPosixLink, FileStatus)
riFiles]
    = NonEmpty Builder -> Builder
forall a. (HasCallStack, Buildable a) => NonEmpty a -> Builder
interpolateUnlinesF (NonEmpty Builder -> Builder) -> NonEmpty Builder -> Builder
forall a b. (a -> b) -> a -> b
$ (RelPosixLink, FileInfo) -> Builder
buildFileReport ((RelPosixLink, FileInfo) -> Builder)
-> NonEmpty (RelPosixLink, FileInfo) -> NonEmpty Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (RelPosixLink, FileInfo)
scanned
    where
      buildFileReport :: (RelPosixLink, FileInfo) -> Builder
      buildFileReport :: (RelPosixLink, FileInfo) -> Builder
buildFileReport (RelPosixLink
name, FileInfo
info) =
        [int||
        #{ colorIfNeeded Cyan name }:
        #{ interpolateIndentF 2 $ build info }
        |]
  build RepoInfo
_ = Builder
"No scannable files found."

-----------------------------------------------------------
-- Analysing
-----------------------------------------------------------

-- | Which parts of verification do we perform.
data VerifyMode
  = LocalOnlyMode
  | ExternalOnlyMode
  | FullMode

shouldCheckLocal :: VerifyMode -> Bool
shouldCheckLocal :: VerifyMode -> Bool
shouldCheckLocal = \case
  VerifyMode
LocalOnlyMode -> Bool
True
  VerifyMode
ExternalOnlyMode -> Bool
False
  VerifyMode
FullMode -> Bool
True

shouldCheckExternal :: VerifyMode -> Bool
shouldCheckExternal :: VerifyMode -> Bool
shouldCheckExternal = \case
  VerifyMode
LocalOnlyMode -> Bool
False
  VerifyMode
ExternalOnlyMode -> Bool
True
  VerifyMode
FullMode -> Bool
True

-- | Convert section header name to an anchor refering it.
-- Conversion rules: https://docs.gitlab.com/ee/user/markdown.html#header-ids-and-links
headerToAnchor :: Flavor -> Text -> Text
headerToAnchor :: Flavor -> Text -> Text
headerToAnchor Flavor
flavor = \Text
t -> Text
t
  Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text
T.toLower
  Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text
mergeSpecialSymbols
  where
    joinSubsequentChars :: Char -> a -> Text
joinSubsequentChars Char
sym = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
go ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. ToString a => a -> String
toString
      where
        go :: ShowS
go = \case
          (Char
c1 : Char
c2 : String
s)
            | Char
c1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c2 Bool -> Bool -> Bool
&& Char
c1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
sym -> ShowS
go (Char
c1 Char -> ShowS
forall a. a -> [a] -> [a]
: String
s)
          (Char
c : String
s) -> Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
s
          [] -> []

    mergeSpecialSymbols :: Text -> Text
mergeSpecialSymbols = case Flavor
flavor of
      Flavor
GitLab -> \Text
t -> Text
t
        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
" " Text
"-"
        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Char -> Bool) -> Text -> Text
T.filter (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Char -> Text -> Text
forall {a}. ToString a => Char -> a -> Text
joinSubsequentChars Char
'-'
      Flavor
GitHub ->
        -- GitHub case is tricky, it can produce many hythens in a row, e.g.
        -- "A - B" -> "a---b"
        let tmp :: Char
tmp = Char
'\0'; tmpT :: Text
tmpT = Char -> Text
T.singleton Char
tmp
        in \Text
t -> Text
t
        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
" " Text
tmpT
        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Char -> Text -> Text
forall {a}. ToString a => Char -> a -> Text
joinSubsequentChars Char
tmp
        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
tmpT Text
"-"
        Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& (Char -> Bool) -> Text -> Text
T.filter (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')

-- | When there are several anchors with the same name, github automatically attaches
-- "-<number>" suffixes to duplications to make them referable unambiguously.
-- For instance, if there are two headers called "description", they would gain
-- "description" and "description-1" anchors correspondingly.
--
-- This function strips this suffix and returns the original anchor in case when
-- suffix is present.
stripAnchorDupNo :: Text -> Maybe Text
stripAnchorDupNo :: Text -> Maybe Text
stripAnchorDupNo Text
t = do
  let strippedNo :: Text
strippedNo = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
C.isNumber Text
t
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Int
forall t. Container t => t -> Int
length Text
strippedNo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int
forall t. Container t => t -> Int
length Text
t)
  Text -> Text -> Maybe Text
T.stripSuffix Text
"-" Text
strippedNo

-----------------------------------------------------------
-- Visualisation
-----------------------------------------------------------

data VerifyProgress = VerifyProgress
  { VerifyProgress -> Progress Int ()
vrLocal    :: !(Progress Int ())
  , VerifyProgress -> Progress Int Text
vrExternal :: !(Progress Int Text)
  } deriving stock (Int -> VerifyProgress -> ShowS
[VerifyProgress] -> ShowS
VerifyProgress -> String
(Int -> VerifyProgress -> ShowS)
-> (VerifyProgress -> String)
-> ([VerifyProgress] -> ShowS)
-> Show VerifyProgress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerifyProgress -> ShowS
showsPrec :: Int -> VerifyProgress -> ShowS
$cshow :: VerifyProgress -> String
show :: VerifyProgress -> String
$cshowList :: [VerifyProgress] -> ShowS
showList :: [VerifyProgress] -> ShowS
Show)

initVerifyProgress :: [Reference] -> VerifyProgress
initVerifyProgress :: [Reference] -> VerifyProgress
initVerifyProgress [Reference]
references = VerifyProgress
  { vrLocal :: Progress Int ()
vrLocal = [()] -> Progress Int ()
forall w. [w] -> Progress Int w
initProgressWitnessed ([()] -> Progress Int ()) -> [()] -> Progress Int ()
forall a b. (a -> b) -> a -> b
$
      [Reference]
references [Reference] -> Getting (Endo [()]) [Reference] () -> [()]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Reference -> Const (Endo [()]) Reference)
-> [Reference] -> Const (Endo [()]) [Reference]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int [Reference] Reference
folded ((Reference -> Const (Endo [()]) Reference)
 -> [Reference] -> Const (Endo [()]) [Reference])
-> ((() -> Const (Endo [()]) ())
    -> Reference -> Const (Endo [()]) Reference)
-> Getting (Endo [()]) [Reference] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> ReferenceInfo)
-> Optic' (->) (Const (Endo [()])) Reference ReferenceInfo
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Reference -> ReferenceInfo
rInfo Optic' (->) (Const (Endo [()])) Reference ReferenceInfo
-> ((() -> Const (Endo [()]) ())
    -> ReferenceInfo -> Const (Endo [()]) ReferenceInfo)
-> (() -> Const (Endo [()]) ())
-> Reference
-> Const (Endo [()]) Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ReferenceInfoFile -> Const (Endo [()]) ReferenceInfoFile)
-> ReferenceInfo -> Const (Endo [()]) ReferenceInfo
Prism' ReferenceInfo ReferenceInfoFile
_RIFile ((ReferenceInfoFile -> Const (Endo [()]) ReferenceInfoFile)
 -> ReferenceInfo -> Const (Endo [()]) ReferenceInfo)
-> ((() -> Const (Endo [()]) ())
    -> ReferenceInfoFile -> Const (Endo [()]) ReferenceInfoFile)
-> (() -> Const (Endo [()]) ())
-> ReferenceInfo
-> Const (Endo [()]) ReferenceInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> Const (Endo [()]) ())
-> ReferenceInfoFile -> Const (Endo [()]) ReferenceInfoFile
forall a (f :: * -> *). Functor f => (() -> f ()) -> a -> f a
united ((() -> Const (Endo [()]) ())
 -> ReferenceInfo -> Const (Endo [()]) ReferenceInfo)
-> ((() -> Const (Endo [()]) ())
    -> ReferenceInfo -> Const (Endo [()]) ReferenceInfo)
-> (() -> Const (Endo [()]) ())
-> ReferenceInfo
-> Const (Endo [()]) ReferenceInfo
forall a. Semigroup a => a -> a -> a
<> (ExternalLink -> Const (Endo [()]) ExternalLink)
-> ReferenceInfo -> Const (Endo [()]) ReferenceInfo
Prism' ReferenceInfo ExternalLink
_RIExternal ((ExternalLink -> Const (Endo [()]) ExternalLink)
 -> ReferenceInfo -> Const (Endo [()]) ReferenceInfo)
-> ((() -> Const (Endo [()]) ())
    -> ExternalLink -> Const (Endo [()]) ExternalLink)
-> (() -> Const (Endo [()]) ())
-> ReferenceInfo
-> Const (Endo [()]) ReferenceInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [()]) Text)
-> ExternalLink -> Const (Endo [()]) ExternalLink
Prism' ExternalLink Text
_ELOther ((Text -> Const (Endo [()]) Text)
 -> ExternalLink -> Const (Endo [()]) ExternalLink)
-> ((() -> Const (Endo [()]) ()) -> Text -> Const (Endo [()]) Text)
-> (() -> Const (Endo [()]) ())
-> ExternalLink
-> Const (Endo [()]) ExternalLink
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> Const (Endo [()]) ()) -> Text -> Const (Endo [()]) Text
forall a (f :: * -> *). Functor f => (() -> f ()) -> a -> f a
united)
  , vrExternal :: Progress Int Text
vrExternal = [Text] -> Progress Int Text
forall w. [w] -> Progress Int w
initProgressWitnessed ([Text] -> Progress Int Text)
-> ([Text] -> [Text]) -> [Text] -> Progress Int Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Ord a => [a] -> [a]
ordNub ([Text] -> Progress Int Text) -> [Text] -> Progress Int Text
forall a b. (a -> b) -> a -> b
$
      [Reference]
references [Reference] -> Getting (Endo [Text]) [Reference] Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Reference -> Const (Endo [Text]) Reference)
-> [Reference] -> Const (Endo [Text]) [Reference]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int [Reference] Reference
folded ((Reference -> Const (Endo [Text]) Reference)
 -> [Reference] -> Const (Endo [Text]) [Reference])
-> ((Text -> Const (Endo [Text]) Text)
    -> Reference -> Const (Endo [Text]) Reference)
-> Getting (Endo [Text]) [Reference] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> ReferenceInfo)
-> Optic' (->) (Const (Endo [Text])) Reference ReferenceInfo
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Reference -> ReferenceInfo
rInfo Optic' (->) (Const (Endo [Text])) Reference ReferenceInfo
-> ((Text -> Const (Endo [Text]) Text)
    -> ReferenceInfo -> Const (Endo [Text]) ReferenceInfo)
-> (Text -> Const (Endo [Text]) Text)
-> Reference
-> Const (Endo [Text]) Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExternalLink -> Const (Endo [Text]) ExternalLink)
-> ReferenceInfo -> Const (Endo [Text]) ReferenceInfo
Prism' ReferenceInfo ExternalLink
_RIExternal ((ExternalLink -> Const (Endo [Text]) ExternalLink)
 -> ReferenceInfo -> Const (Endo [Text]) ReferenceInfo)
-> ((Text -> Const (Endo [Text]) Text)
    -> ExternalLink -> Const (Endo [Text]) ExternalLink)
-> (Text -> Const (Endo [Text]) Text)
-> ReferenceInfo
-> Const (Endo [Text]) ReferenceInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> ExternalLink -> Const (Endo [Text]) ExternalLink
Prism' ExternalLink Text
_ELUrl
  }

showAnalyseProgress :: Given ColorMode => VerifyMode -> Time Second -> VerifyProgress -> Text
showAnalyseProgress :: Given ColorMode =>
VerifyMode -> Time Second -> VerifyProgress -> Text
showAnalyseProgress VerifyMode
mode Time Second
posixTime VerifyProgress{Progress Int ()
Progress Int Text
vrLocal :: VerifyProgress -> Progress Int ()
vrExternal :: VerifyProgress -> Progress Int Text
vrLocal :: Progress Int ()
vrExternal :: Progress Int Text
..} =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> ([[Text]] -> [Text]) -> [[Text]] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat ([[Text]] -> Text) -> [[Text]] -> Text
forall a b. (a -> b) -> a -> b
$
    [ [ Text
"Verifying " ]
    , [ Text -> Int -> Color -> Time Second -> Progress Int () -> Text
forall w.
Given ColorMode =>
Text -> Int -> Color -> Time Second -> Progress Int w -> Text
showProgress Text
"local" Int
10 Color
White Time Second
posixTime Progress Int ()
vrLocal Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
      | VerifyMode -> Bool
shouldCheckLocal VerifyMode
mode ]
    , [ Text -> Int -> Color -> Time Second -> Progress Int Text -> Text
forall w.
Given ColorMode =>
Text -> Int -> Color -> Time Second -> Progress Int w -> Text
showProgress Text
"external" Int
15 Color
Yellow Time Second
posixTime Progress Int Text
vrExternal
      | VerifyMode -> Bool
shouldCheckExternal VerifyMode
mode ]
    ]

reprintAnalyseProgress :: Given ColorMode =>
  Rewrite -> VerifyMode -> Time Second -> VerifyProgress -> IO ()
reprintAnalyseProgress :: Given ColorMode =>
Rewrite -> VerifyMode -> Time Second -> VerifyProgress -> IO ()
reprintAnalyseProgress Rewrite
rw VerifyMode
mode Time Second
posixTime VerifyProgress
p = Rewrite -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Rewrite -> Text -> m ()
putTextRewrite Rewrite
rw (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
  Given ColorMode =>
VerifyMode -> Time Second -> VerifyProgress -> Text
VerifyMode -> Time Second -> VerifyProgress -> Text
showAnalyseProgress VerifyMode
mode Time Second
posixTime VerifyProgress
p