module Hadolint.Pragma ( ignored, globalIgnored, parseIgnorePragma, parseShell ) where import Data.Functor.Identity (Identity) import Data.Text (Text) import Data.Void (Void) import Hadolint.Rule (RuleCode (RuleCode)) import Language.Docker.Syntax import qualified Control.Foldl as Foldl import qualified Data.IntMap.Strict as Map import qualified Data.Set as Set import qualified Text.Megaparsec as Megaparsec import qualified Text.Megaparsec.Char as Megaparsec ignored :: Foldl.Fold (InstructionPos 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 {instruction :: forall args. InstructionPos args -> Instruction args instruction = Comment Text comment, lineNumber :: forall args. InstructionPos args -> Key lineNumber = Key line} = case Text -> Maybe [Text] parseIgnorePragma Text comment of Just ignores :: [Text] ignores@(Text _ : [Text] _) -> Key -> Set RuleCode -> IntMap (Set RuleCode) -> IntMap (Set RuleCode) forall a. Key -> a -> IntMap a -> IntMap a Map.insert (Key line Key -> Key -> Key forall a. Num a => a -> a -> a + Key 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 a b. (a -> b) -> [a] -> [b] 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 globalIgnored :: Foldl.Fold (InstructionPos Text) (Set.Set RuleCode) globalIgnored :: Fold (InstructionPos Text) (Set RuleCode) globalIgnored = (Set RuleCode -> InstructionPos Text -> Set RuleCode) -> Set RuleCode -> (Set RuleCode -> Set RuleCode) -> Fold (InstructionPos Text) (Set RuleCode) forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b Foldl.Fold Set RuleCode -> InstructionPos Text -> Set RuleCode forall {args}. Set RuleCode -> InstructionPos args -> Set RuleCode parse Set RuleCode forall a. Monoid a => a mempty Set RuleCode -> Set RuleCode forall a. a -> a id where parse :: Set RuleCode -> InstructionPos args -> Set RuleCode parse Set RuleCode acc InstructionPos { instruction :: forall args. InstructionPos args -> Instruction args instruction = Comment Text comment } = case Text -> Maybe [Text] parseGlobalIgnorePragma Text comment of Just ignores :: [Text] ignores@(Text _ : [Text] _) -> Set RuleCode -> Set RuleCode -> Set RuleCode forall a. Ord a => Set a -> Set a -> Set a Set.union ( [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 a b. (a -> b) -> [a] -> [b] 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 ) Set RuleCode acc Maybe [Text] _ -> Set RuleCode acc parse Set RuleCode acc InstructionPos args _ = Set RuleCode acc parseIgnorePragma :: Text -> Maybe [Text] parseIgnorePragma :: Text -> Maybe [Text] parseIgnorePragma = 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] ignoreParser parseGlobalIgnorePragma :: Text -> Maybe [Text] parseGlobalIgnorePragma :: Text -> Maybe [Text] parseGlobalIgnorePragma = 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] globalIgnoreParser ignoreParser :: Megaparsec.Parsec Void Text [Text] ignoreParser :: Parsec Void Text [Text] ignoreParser = Parsec Void Text Text hadolintPragma Parsec Void Text Text -> Parsec Void Text [Text] -> Parsec Void Text [Text] forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Parsec Void Text [Text] ignore globalIgnoreParser :: Megaparsec.Parsec Void Text [Text] globalIgnoreParser :: Parsec Void Text [Text] globalIgnoreParser = Parsec Void Text Text hadolintPragma Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text Text forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Tokens Text -> ParsecT Void Text Identity (Tokens Text) string Text Tokens Text "global" Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text Text forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Parsec Void Text Text ParsecT Void Text Identity (Tokens Text) spaces1 Parsec Void Text Text -> Parsec Void Text [Text] -> Parsec Void Text [Text] forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Parsec Void Text [Text] ignore ignore :: Megaparsec.Parsec Void Text [Text] ignore :: Parsec Void Text [Text] ignore = Tokens Text -> ParsecT Void Text Identity (Tokens Text) string Text Tokens Text "ignore" Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text Text forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Parsec Void Text Text ParsecT Void Text Identity (Tokens Text) spaces Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text Text forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Tokens Text -> ParsecT Void Text Identity (Tokens Text) string Text Tokens Text "=" Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text Text forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Parsec Void Text Text ParsecT Void Text Identity (Tokens Text) spaces Parsec Void Text Text -> Parsec Void Text [Text] -> Parsec Void Text [Text] forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Parsec Void Text [Text] ruleList ruleList :: Megaparsec.Parsec Void Text [Text] ruleList :: Parsec Void Text [Text] ruleList = Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text [Text] forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a] Megaparsec.sepBy1 Parsec Void Text Text ParsecT Void Text Identity (Tokens Text) ruleName ( Parsec Void Text Text ParsecT Void Text Identity (Tokens Text) spaces Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text Text forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Tokens Text -> ParsecT Void Text Identity (Tokens Text) string Text Tokens Text "," Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text Text forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Parsec Void Text Text ParsecT Void Text Identity (Tokens Text) spaces ) ruleName :: Megaparsec.ParsecT Void Text Identity (Megaparsec.Tokens Text) ruleName :: ParsecT Void Text Identity (Tokens Text) ruleName = Maybe [Char] -> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Maybe [Char] -> (Token s -> Bool) -> m (Tokens s) Megaparsec.takeWhile1P Maybe [Char] forall a. Maybe a Nothing (\Token Text c -> Token Text c Token Text -> Set (Token Text) -> Bool forall a. Eq a => a -> Set a -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` [Token Text] -> Set (Token Text) forall a. Ord a => [a] -> Set a Set.fromList [Token Text] "DLSC0123456789") parseShell :: Text -> Maybe Text parseShell :: Text -> Maybe Text parseShell = 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 shellParser shellParser :: Megaparsec.Parsec Void Text Text shellParser :: Parsec Void Text Text shellParser = Parsec Void Text Text hadolintPragma Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text Text forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Tokens Text -> ParsecT Void Text Identity (Tokens Text) string Text Tokens Text "shell" Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text Text forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Parsec Void Text Text ParsecT Void Text Identity (Tokens Text) spaces Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text Text forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Tokens Text -> ParsecT Void Text Identity (Tokens Text) string Text Tokens Text "=" Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text Text forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Parsec Void Text Text ParsecT Void Text Identity (Tokens Text) spaces Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text Text forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Parsec Void Text Text ParsecT Void Text Identity (Tokens Text) shellName shellName :: Megaparsec.ParsecT Void Text Identity (Megaparsec.Tokens Text) shellName :: ParsecT Void Text Identity (Tokens Text) shellName = Maybe [Char] -> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Maybe [Char] -> (Token s -> Bool) -> m (Tokens s) Megaparsec.takeWhile1P Maybe [Char] forall a. Maybe a Nothing (Token Text -> Token Text -> Bool forall a. Eq a => a -> a -> Bool /= Char Token Text '\n') hadolintPragma :: Megaparsec.Parsec Void Text Text hadolintPragma :: Parsec Void Text Text hadolintPragma = Parsec Void Text Text ParsecT Void Text Identity (Tokens Text) spaces Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text Text forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Tokens Text -> ParsecT Void Text Identity (Tokens Text) string Text Tokens Text "hadolint" Parsec Void Text Text -> Parsec Void Text Text -> Parsec Void Text Text forall a b. ParsecT Void Text Identity a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Parsec Void Text Text ParsecT Void Text Identity (Tokens Text) spaces1 string :: Megaparsec.Tokens Text -> Megaparsec.ParsecT Void Text Identity (Megaparsec.Tokens Text) 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 :: Megaparsec.ParsecT Void Text Identity (Megaparsec.Tokens Text) spaces :: ParsecT Void Text Identity (Tokens Text) spaces = Maybe [Char] -> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Maybe [Char] -> (Token s -> Bool) -> m (Tokens s) Megaparsec.takeWhileP Maybe [Char] forall a. Maybe a Nothing Char -> Bool Token Text -> Bool space spaces1 :: Megaparsec.ParsecT Void Text Identity (Megaparsec.Tokens Text) spaces1 :: ParsecT Void Text Identity (Tokens Text) spaces1 = Maybe [Char] -> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Maybe [Char] -> (Token s -> Bool) -> m (Tokens s) Megaparsec.takeWhile1P Maybe [Char] forall a. Maybe a Nothing Char -> Bool Token Text -> Bool space space :: Char -> Bool 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'