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
>> Parsec Void Text 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]
ignore

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

global :: Megaparsec.Parsec Void Text Text
global :: Parsec Void Text Text
global = 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

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")
  Parsec Void Text Text
-> ParsecT Void Text Identity (Maybe Text) -> Parsec Void Text Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity (Maybe Text)
inlineComment

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
c -> Token Text
c Token Text -> Set (Token Text) -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Token Text] -> Set (Token Text)
forall a. Ord a => [a] -> Set a
Set.fromList [Token Text]
"\n\t ")
  Parsec Void Text Text
-> ParsecT Void Text Identity (Maybe Text) -> Parsec Void Text Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity (Maybe Text)
inlineComment

inlineComment :: Megaparsec.Parsec Void Text (Maybe Text)
inlineComment :: ParsecT Void Text Identity (Maybe Text)
inlineComment =
  Parsec Void Text Text
ParsecT Void Text Identity (Tokens Text)
spaces Parsec Void Text Text
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity (Maybe 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 (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Megaparsec.optional ( 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
>> 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 (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token Text
'\n') )

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'