Switch to attoparsec for gentoo scan

Signed-off-by: hololeap <hololeap@users.noreply.github.com>
This commit is contained in:
hololeap 2023-08-05 17:38:01 -06:00
parent fc9b63fb5e
commit dfa920c5d2
No known key found for this signature in database
GPG Key ID: 06B97EDD7A3D1E83
3 changed files with 74 additions and 35 deletions

View File

@ -66,7 +66,11 @@ library
directory >= 1.2.3 && < 1.4, directory >= 1.2.3 && < 1.4,
-- When cabal supports it, move this to setup-depends: -- When cabal supports it, move this to setup-depends:
process process,
-- support for scanning Gentoo eclasses
attoparsec,
text
exposed-modules: exposed-modules:
ShellCheck.AST ShellCheck.AST
ShellCheck.ASTLib ShellCheck.ASTLib

View File

@ -25,7 +25,7 @@ Use:
import Paths_ShellCheck (version) import Paths_ShellCheck (version)
shellcheckVersion = showVersion version -- VERSIONSTRING shellcheckVersion = showVersion version -- VERSIONSTRING
genericInternalVariables :: [String]
genericInternalVariables = [ genericInternalVariables = [
-- Generic -- Generic
"", "_", "rest", "REST", "", "_", "rest", "REST",
@ -153,7 +153,7 @@ eclassVarsFromMap :: EclassMap -> String -> [String]
eclassVarsFromMap gMap eclass = eclassVarsFromMap gMap eclass =
Data.Map.findWithDefault [] Data.Map.findWithDefault []
eclass eclass
gMap (Data.Map.map (map decodeLenient) gMap)
portageInternalVariables :: [String] -> EclassMap -> [String] portageInternalVariables :: [String] -> EclassMap -> [String]
portageInternalVariables inheritedEclasses gMap = portageInternalVariables inheritedEclasses gMap =

View File

@ -1,3 +1,7 @@
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module ShellCheck.PortageVariables module ShellCheck.PortageVariables
( RepoName ( RepoName
@ -9,25 +13,37 @@ module ShellCheck.PortageVariables
, Eclass(..) , Eclass(..)
, portageVariables , portageVariables
, scanRepos , scanRepos
, decodeLenient
) where ) where
import Control.Applicative import Control.Applicative
import Control.Exception (bracket)
import Control.Monad import Control.Monad
import Control.Monad.Trans.Class import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Data.Map (Map) import Data.Attoparsec.ByteString
import qualified Data.Attoparsec.ByteString as A
import Data.Attoparsec.ByteString.Char8 hiding (takeWhile)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Char (ord)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromJust)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
import System.Directory (listDirectory) import System.Directory (listDirectory)
import System.Exit (ExitCode(..)) import System.Exit (ExitCode(..))
import System.FilePath import System.FilePath
import System.IO (hClose)
import System.Process import System.Process
import Text.Parsec hiding ((<|>))
import Text.Parsec.String
type RepoName = String import Prelude hiding (takeWhile)
type RepoPath = FilePath
type RepoName = ByteString
type RepoPath = ByteString
type EclassName = String type EclassName = String
type EclassVar = String type EclassVar = ByteString
-- | This is used for looking up what eclass variables are inherited, -- | This is used for looking up what eclass variables are inherited,
-- keyed by the name of the eclass. -- keyed by the name of the eclass.
@ -57,7 +73,7 @@ scanRepos = do
let cmd = "/usr/bin/portageq" let cmd = "/usr/bin/portageq"
let args = ["repos_config", "/"] let args = ["repos_config", "/"]
out <- runOrDie cmd args out <- runOrDie cmd args
case parse reposParser "scanRepos" out of case parseOnly reposParser out of
Left pe -> fail $ show pe Left pe -> fail $ show pe
Right nps -> do Right nps -> do
forM nps $ \(n,p) -> Repository n p <$> getEclasses p forM nps $ \(n,p) -> Repository n p <$> getEclasses p
@ -67,27 +83,29 @@ scanRepos = do
reposParser :: Parser [(RepoName, RepoPath)] reposParser :: Parser [(RepoName, RepoPath)]
reposParser = reposParser =
choice choice
[ [] <$ eof [ [] <$ endOfInput
, repoName >>= repoBlock , repoName >>= repoBlock
] ]
where where
-- Get the name of the repo at the top of the block -- Get the name of the repo at the top of the block
repoName :: Parser RepoName repoName :: Parser RepoName
repoName repoName = do
= char '[' _ <- char '['
*> manyTill anyChar (try (char ']')) n <- takeWhile (/= fromIntegral (ord ']'))
<* endOfLine _ <- char ']'
_ <- endOfLine
pure n
-- Parse the block for location field -- Parse the block for location field
repoBlock :: RepoName -> Parser [(RepoName, RepoPath)] repoBlock :: RepoName -> Parser [(RepoName, RepoPath)]
repoBlock n = choice repoBlock n = choice
[ try $ do [ do
l <- string "location = " *> takeLine l <- "location = " *> takeLine
-- Found the location, skip the rest of the block -- Found the location, skip the rest of the block
skipMany miscLine *> endOfBlock skipMany miscLine *> endOfBlock
insert (n,l) insert (n,l)
-- Did not find the location, keep trying -- Did not find the location, keep trying
, try $ miscLine *> repoBlock n , miscLine *> repoBlock n
-- Reached the end of the block, no location field -- Reached the end of the block, no location field
, endOfBlock *> ignore , endOfBlock *> ignore
] ]
@ -95,9 +113,9 @@ reposParser =
miscLine :: Parser () miscLine :: Parser ()
miscLine = skipNonEmptyLine miscLine = skipNonEmptyLine
-- A block ends with an eol or eof -- A block either ends with an empty line or eof
endOfBlock :: Parser () endOfBlock :: Parser ()
endOfBlock = void endOfLine <|> eof endOfBlock = endOfLine <|> endOfInput
-- cons the repo and continue parsing -- cons the repo and continue parsing
insert :: (RepoName, RepoPath) -> Parser [(RepoName, RepoPath)] insert :: (RepoName, RepoPath) -> Parser [(RepoName, RepoPath)]
@ -114,7 +132,7 @@ reposParser =
-- repo. -- repo.
getEclasses :: RepoPath -> IO [Eclass] getEclasses :: RepoPath -> IO [Eclass]
getEclasses repoLoc = fmap (maybe [] id) $ runMaybeT $ do getEclasses repoLoc = fmap (maybe [] id) $ runMaybeT $ do
let eclassDir = repoLoc </> "eclass" let eclassDir = (decodeLenient repoLoc) </> "eclass"
-- Silently fail if the repo doesn't have an eclass dir -- Silently fail if the repo doesn't have an eclass dir
fs <- MaybeT $ Just <$> listDirectory eclassDir <|> pure Nothing fs <- MaybeT $ Just <$> listDirectory eclassDir <|> pure Nothing
@ -131,40 +149,57 @@ getEclasses repoLoc = fmap (maybe [] id) $ runMaybeT $ do
eclassParser :: Parser [EclassVar] eclassParser :: Parser [EclassVar]
eclassParser = choice eclassParser = choice
[ -- cons the EclassVar to the list and continue [ -- cons the EclassVar to the list and continue
try $ liftA2 (:) eclassVar eclassParser liftA2 (:) eclassVar eclassParser
-- or skip the line and continue -- or skip the line and continue
, skipLine *> eclassParser , skipLine *> eclassParser
-- or end the list on eof -- or end the list on eof
, [] <$ eof , [] <$ endOfInput
] ]
where where
-- Scans for @ECLASS_VARIABLE comments rather than parsing the raw bash -- Scans for @ECLASS_VARIABLE comments rather than parsing the raw bash
eclassVar :: Parser EclassVar eclassVar :: Parser EclassVar
eclassVar = string "# @ECLASS_VARIABLE: " *> takeLine eclassVar = "# @ECLASS_VARIABLE: " *> takeLine
takeLine :: Parser String takeLine :: Parser ByteString
takeLine = manyTill anyChar (try endOfLine) takeLine = A.takeWhile (not . isEndOfLine) <* endOfLine
-- | Fails if next char is 'endOfLine' -- | Fails if next char is 'endOfLine'
skipNonEmptyLine :: Parser () skipNonEmptyLine :: Parser ()
skipNonEmptyLine = notFollowedBy endOfLine *> skipLine skipNonEmptyLine = A.satisfy (not . isEndOfLine) *> skipLine
skipLine :: Parser () skipLine :: Parser ()
skipLine = void takeLine skipLine = A.skipWhile (not . isEndOfLine) <* endOfLine
parseFromFile :: Parser a -> FilePath -> IO (Either String a)
parseFromFile p = fmap (parseOnly p) . B.readFile
-- | Run the command and return the full stdout string (stdin is ignored). -- | Run the command and return the full stdout string (stdin is ignored).
-- --
-- If the command exits with a non-zero exit code, this will throw an -- If the command exits with a non-zero exit code, this will throw an
-- error including the captured contents of stdout and stderr. -- error including the captured contents of stdout and stderr.
runOrDie :: FilePath -> [String] -> IO String runOrDie :: FilePath -> [String] -> IO ByteString
runOrDie cmd args = do runOrDie cmd args = bracket acquire release $ \(_,o,e,p) -> do
(ec, o, e) <- readProcessWithExitCode cmd args "" ot <- B.hGetContents (fromJust o)
et <- B.hGetContents (fromJust e)
ec <- waitForProcess p
case ec of case ec of
ExitSuccess -> pure o ExitSuccess -> pure ot
ExitFailure i -> fail $ unlines $ map unwords ExitFailure i -> fail $ unlines $ map unwords
$ [ [ show cmd ] $ [ [ show cmd ]
++ map show args ++ map show args
++ [ "failed with exit code", show i] ++ [ "failed with exit code", show i]
, [ "stdout:" ], [ o ] , [ "stdout:" ], [ decodeLenient ot ]
, [ "stderr:" ], [ e ] , [ "stderr:" ], [ decodeLenient et ]
] ]
where
acquire = createProcess (proc cmd args)
{ std_in = NoStream
, std_out = CreatePipe
, std_err = CreatePipe
}
release (i,o,e,p) = do
_ <- waitForProcess p
forM_ [i,o,e] $ mapM_ hClose
decodeLenient :: ByteString -> String
decodeLenient = T.unpack . T.decodeUtf8With T.lenientDecode