{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

module Krank.Checkers.Ignore
  ( IgnoreCommand (..),
    filterViolations,
  )
where

import qualified Data.ByteString.Char8 as ByteString
import Data.ByteString.Char8 (ByteString)
import qualified Data.HashMap.Strict as HashM
import qualified Data.List as DataL
import Krank.Types
import PyF (fmt)
import qualified Text.Regex.PCRE.Heavy as RE

data IgnoreCommand = IgnoreLine deriving (Int -> IgnoreCommand -> ShowS
[IgnoreCommand] -> ShowS
IgnoreCommand -> String
(Int -> IgnoreCommand -> ShowS)
-> (IgnoreCommand -> String)
-> ([IgnoreCommand] -> ShowS)
-> Show IgnoreCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IgnoreCommand] -> ShowS
$cshowList :: [IgnoreCommand] -> ShowS
show :: IgnoreCommand -> String
$cshow :: IgnoreCommand -> String
showsPrec :: Int -> IgnoreCommand -> ShowS
$cshowsPrec :: Int -> IgnoreCommand -> ShowS
Show, IgnoreCommand -> IgnoreCommand -> Bool
(IgnoreCommand -> IgnoreCommand -> Bool)
-> (IgnoreCommand -> IgnoreCommand -> Bool) -> Eq IgnoreCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IgnoreCommand -> IgnoreCommand -> Bool
$c/= :: IgnoreCommand -> IgnoreCommand -> Bool
== :: IgnoreCommand -> IgnoreCommand -> Bool
$c== :: IgnoreCommand -> IgnoreCommand -> Bool
Eq)

-- | This regex represents a krank ignore marker
ignoreRe :: RE.Regex
ignoreRe :: Regex
ignoreRe = [RE.re|krank:ignore-(line)|]

-- TODO: support more "ignore" (checker specific, all file, next line)

-- | Extract all issues on one line and returns a list of ignore keyword
extractIssuesOnALine :: ByteString -> [(Int, IgnoreCommand)]
extractIssuesOnALine :: ByteString -> [(Int, IgnoreCommand)]
extractIssuesOnALine ByteString
lineContent = ((ByteString, [ByteString]) -> (Int, IgnoreCommand))
-> [(ByteString, [ByteString])] -> [(Int, IgnoreCommand)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (ByteString, [ByteString]) -> (Int, IgnoreCommand)
f (Regex -> ByteString -> [(ByteString, [ByteString])]
forall a.
(ConvertibleStrings ByteString a,
 ConvertibleStrings a ByteString) =>
Regex -> a -> [(a, [a])]
RE.scan Regex
ignoreRe ByteString
lineContent)
  where
    f :: (ByteString, [ByteString]) -> (Int, IgnoreCommand)
f (ByteString
match, [ByteString
command]) = (Int
colNo, IgnoreCommand
ignoreCommand)
      where
        colNo :: Int
colNo = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
ByteString.length ((ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> (ByteString, ByteString)
ByteString.breakSubstring ByteString
match ByteString
lineContent)
        ignoreCommand :: IgnoreCommand
ignoreCommand
          | ByteString
command ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"line" = IgnoreCommand
IgnoreLine
          | Bool
otherwise = String -> IgnoreCommand
forall a. HasCallStack => String -> a
error [fmt|Impossible case, update the guard with: {ByteString.unpack command}|]
    -- This case seems impossible, the reasons for pattern match issues are:
    --  A number of items different than 1 in the list: there is only 1 matching groups in the regex
    f (ByteString, [ByteString])
res = String -> (Int, IgnoreCommand)
forall a. HasCallStack => String -> a
error (String
"Error: impossible match" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (ByteString, [ByteString]) -> String
forall a. Show a => a -> String
show (ByteString, [ByteString])
res)

-- | Extract all ignore markers correctly localized
-- Note: we use 'ByteString' internally. This way we do not have to
-- care about the possible encoding of the input files.
-- In programming world, we mostly use ascii variants. This gives a
-- few performance improvement compared to initially converting
-- everything to 'Text' and search on it.
extractIgnores ::
  -- | Path of the file
  FilePath ->
  -- | Content of the file
  ByteString ->
  [Localized IgnoreCommand]
extractIgnores :: String -> ByteString -> [Localized IgnoreCommand]
extractIgnores String
filePath ByteString
toCheck = [[Localized IgnoreCommand]] -> [Localized IgnoreCommand]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Int -> ByteString -> [Localized IgnoreCommand])
-> [Int] -> [ByteString] -> [[Localized IgnoreCommand]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ByteString -> [Localized IgnoreCommand]
extract [Int
1 ..] (ByteString -> [ByteString]
ByteString.lines ByteString
toCheck))
  where
    extract :: Int -> ByteString -> [Localized IgnoreCommand]
extract Int
lineNo ByteString
lineContent = ((Int, IgnoreCommand) -> Localized IgnoreCommand)
-> [(Int, IgnoreCommand)] -> [Localized IgnoreCommand]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (Int, IgnoreCommand) -> Localized IgnoreCommand
forall t. (Int, t) -> Localized t
f (ByteString -> [(Int, IgnoreCommand)]
extractIssuesOnALine ByteString
lineContent)
      where
        f :: (Int, t) -> Localized t
f (Int
colNo, t
gitIssue) = SourcePos -> t -> Localized t
forall t. SourcePos -> t -> Localized t
Localized (String -> Int -> Int -> SourcePos
SourcePos String
filePath Int
lineNo Int
colNo) t
gitIssue

-- | Takes a list of Violation, some ignore commands and remove all those that are ignored due to an
-- ignore marker
filterViolations ::
  -- | List of Violation to filter
  [Violation] ->
  -- | Path of the file
  FilePath ->
  -- | Content of the file
  ByteString ->
  [Violation]
filterViolations :: [Violation] -> String -> ByteString -> [Violation]
filterViolations [Violation]
violations String
filePath ByteString
content =
  (Violation -> Bool) -> [Violation] -> [Violation]
forall a. (a -> Bool) -> [a] -> [a]
DataL.filter Violation -> Bool
isNotIgnored [Violation]
violations
  where
    ignoreCommands :: [Localized IgnoreCommand]
ignoreCommands = String -> ByteString -> [Localized IgnoreCommand]
extractIgnores String
filePath ByteString
content
    f :: HashMap Int v -> Localized v -> HashMap Int v
f HashMap Int v
hashMap Localized v
ignoreCommand = Int -> v -> HashMap Int v -> HashMap Int v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashM.insert (SourcePos -> Int
lineNumber (SourcePos -> Int)
-> (Localized v -> SourcePos) -> Localized v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Localized v -> SourcePos
forall t. Localized t -> SourcePos
getLocation (Localized v -> Int) -> Localized v -> Int
forall a b. (a -> b) -> a -> b
$ Localized v
ignoreCommand) (Localized v -> v
forall t. Localized t -> t
unLocalized Localized v
ignoreCommand) HashMap Int v
hashMap
    ignoreIndex :: HashMap Int IgnoreCommand
ignoreIndex = (HashMap Int IgnoreCommand
 -> Localized IgnoreCommand -> HashMap Int IgnoreCommand)
-> HashMap Int IgnoreCommand
-> [Localized IgnoreCommand]
-> HashMap Int IgnoreCommand
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl HashMap Int IgnoreCommand
-> Localized IgnoreCommand -> HashMap Int IgnoreCommand
forall v. HashMap Int v -> Localized v -> HashMap Int v
f HashMap Int IgnoreCommand
forall k v. HashMap k v
HashM.empty [Localized IgnoreCommand]
ignoreCommands
    isIgnored :: Violation -> Bool
isIgnored Violation
violation = Int -> HashMap Int IgnoreCommand -> Maybe IgnoreCommand
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashM.lookup (SourcePos -> Int
lineNumber (SourcePos -> Int) -> (Violation -> SourcePos) -> Violation -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Violation -> SourcePos
location (Violation -> Int) -> Violation -> Int
forall a b. (a -> b) -> a -> b
$ Violation
violation) HashMap Int IgnoreCommand
ignoreIndex Maybe IgnoreCommand -> Maybe IgnoreCommand -> Bool
forall a. Eq a => a -> a -> Bool
== IgnoreCommand -> Maybe IgnoreCommand
forall a. a -> Maybe a
Just IgnoreCommand
IgnoreLine
    isNotIgnored :: Violation -> Bool
isNotIgnored = Bool -> Bool
not (Bool -> Bool) -> (Violation -> Bool) -> Violation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Violation -> Bool
isIgnored