module Hadolint.Ignore (ignored) where

import qualified Control.Foldl as Foldl
import qualified Data.IntMap.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import Data.Void (Void)
import Hadolint.Rule (RuleCode (RuleCode))
import Language.Docker.Syntax
import qualified Text.Megaparsec as Megaparsec
import qualified Text.Megaparsec.Char as Megaparsec

ignored :: Foldl.Fold (InstructionPos Text.Text) (Map.IntMap (Set.Set RuleCode))
ignored :: Fold (InstructionPos Text) (IntMap (Set RuleCode))
ignored = (IntMap (Set RuleCode)
 -> InstructionPos Text -> IntMap (Set RuleCode))
-> IntMap (Set RuleCode)
-> (IntMap (Set RuleCode) -> IntMap (Set RuleCode))
-> Fold (InstructionPos Text) (IntMap (Set RuleCode))
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Foldl.Fold IntMap (Set RuleCode)
-> InstructionPos Text -> IntMap (Set RuleCode)
forall args.
IntMap (Set RuleCode)
-> InstructionPos args -> IntMap (Set RuleCode)
parse IntMap (Set RuleCode)
forall a. Monoid a => a
mempty IntMap (Set RuleCode) -> IntMap (Set RuleCode)
forall a. a -> a
id
  where
    parse :: IntMap (Set RuleCode)
-> InstructionPos args -> IntMap (Set RuleCode)
parse IntMap (Set RuleCode)
acc InstructionPos {$sel:instruction:InstructionPos :: forall args. InstructionPos args -> Instruction args
instruction = Comment Text
comment, $sel:lineNumber:InstructionPos :: forall args. InstructionPos args -> Linenumber
lineNumber = Linenumber
line} =
      case Text -> Maybe [Text]
parseComment Text
comment of
        Just ignores :: [Text]
ignores@(Text
_ : [Text]
_) -> Linenumber
-> Set RuleCode -> IntMap (Set RuleCode) -> IntMap (Set RuleCode)
forall a. Linenumber -> a -> IntMap a -> IntMap a
Map.insert (Linenumber
line Linenumber -> Linenumber -> Linenumber
forall a. Num a => a -> a -> a
+ Linenumber
1) ([RuleCode] -> Set RuleCode
forall a. Ord a => [a] -> Set a
Set.fromList ([RuleCode] -> Set RuleCode)
-> ([Text] -> [RuleCode]) -> [Text] -> Set RuleCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> RuleCode) -> [Text] -> [RuleCode]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> RuleCode
RuleCode ([Text] -> Set RuleCode) -> [Text] -> Set RuleCode
forall a b. (a -> b) -> a -> b
$ [Text]
ignores) IntMap (Set RuleCode)
acc
        Maybe [Text]
_ -> IntMap (Set RuleCode)
acc
    parse IntMap (Set RuleCode)
acc InstructionPos args
_ = IntMap (Set RuleCode)
acc

    parseComment :: Text.Text -> Maybe [Text.Text]
    parseComment :: Text -> Maybe [Text]
parseComment =
      Parsec Void Text [Text] -> Text -> Maybe [Text]
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe Parsec Void Text [Text]
commentParser

    commentParser :: Megaparsec.Parsec Void Text.Text [Text.Text]
    commentParser :: Parsec Void Text [Text]
commentParser =
      do
        ParsecT Void Text Identity (Tokens Text)
spaces
        ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
string Tokens Text
"hadolint"
        ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
spaces1
        ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
string Tokens Text
"ignore="
        ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
spaces
        ParsecT Void Text Identity (Tokens Text)
-> Parsec Void Text [Text] -> Parsec Void Text [Text]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Tokens Text)
-> Parsec Void Text [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
Megaparsec.sepBy1 ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
ruleName (ParsecT Void Text Identity (Tokens Text)
spaces ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
string Tokens Text
"," ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity (Tokens Text)
spaces)

    ruleName :: ParsecT Void Text Identity (Tokens Text)
ruleName = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Megaparsec.takeWhile1P Maybe String
forall a. Maybe a
Nothing (\Token Text
c -> Char
Token Text
c Char -> Set Char -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList String
"DLSC0123456789")
    string :: Tokens Text -> ParsecT Void Text Identity (Tokens Text)
string = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Megaparsec.string
    spaces :: ParsecT Void Text Identity (Tokens Text)
spaces = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Megaparsec.takeWhileP Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
space
    spaces1 :: ParsecT Void Text Identity (Tokens Text)
spaces1 = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Megaparsec.takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
space
    space :: Char -> Bool
space Char
c = 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
'\t'