module Hadolint.Pragma
  ( ignored,
    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 {$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]
parseIgnorePragma 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

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]
commentParser

commentParser :: Megaparsec.Parsec Void Text [Text]
commentParser :: Parsec Void Text [Text]
commentParser =
  do
    ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
spaces
    ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity 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 Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
spaces1
    ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity 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 Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
spaces
    ParsecT Void Text Identity 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 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 Text
ParsecT Void Text Identity (Tokens Text)
spaces ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity 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 Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity 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 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")


parseShell :: Text -> Maybe Text
parseShell :: Text -> Maybe Text
parseShell = ParsecT Void Text Identity Text -> Text -> Maybe Text
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe ParsecT Void Text Identity Text
shellParser

shellParser :: Megaparsec.Parsec Void Text Text
shellParser :: ParsecT Void Text Identity Text
shellParser =
  do
    ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
spaces
    ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity 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 Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
spaces1
    ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
string Tokens Text
"shell"
    ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
spaces
    ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity 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 Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
spaces
    ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity 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 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 -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\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 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 :: Megaparsec.ParsecT Void Text Identity (Megaparsec.Tokens Text)
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 -> 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'