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