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'