Drop attoparsec/text dependencies

This commit is contained in:
Vidar Holen 2023-10-08 18:16:09 -07:00
parent e59fbfebda
commit c9b8ad3439
2 changed files with 50 additions and 115 deletions

View file

@ -66,11 +66,7 @@ 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

@ -7,34 +7,24 @@ module ShellCheck.PortageVariables (
readPortageVariables readPortageVariables
) where ) where
import Control.Applicative import ShellCheck.Regex
import Control.Exception (bracket)
import Control.Exception
import Control.Monad import Control.Monad
import Control.Monad.Trans.Class (lift) import Data.Maybe
import Control.Monad.Trans.Maybe
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 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.IO
import System.Process import System.Process
import Prelude hiding (takeWhile) import qualified Data.ByteString as B
import qualified Data.Map as M
type RepoName = ByteString type RepoName = String
type RepoPath = ByteString type RepoPath = String
type EclassName = String type EclassName = String
type EclassVar = ByteString type EclassVar = String
-- | 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.
@ -52,7 +42,7 @@ data Eclass = Eclass
} deriving (Show, Eq, Ord) } deriving (Show, Eq, Ord)
readPortageVariables :: IO (M.Map String [String]) readPortageVariables :: IO (M.Map String [String])
readPortageVariables = M.map (map decodeLenient) <$> portageVariables <$> scanRepos readPortageVariables = portageVariables <$> scanRepos
-- | Map from eclass names to a list of eclass variables -- | Map from eclass names to a list of eclass variables
portageVariables :: [Repository] -> EclassMap portageVariables :: [Repository] -> EclassMap
@ -67,57 +57,21 @@ scanRepos = do
let cmd = "portageq" let cmd = "portageq"
let args = ["repos_config", "/"] let args = ["repos_config", "/"]
out <- runOrDie cmd args out <- runOrDie cmd args
case parseOnly reposParser out of forM (reposParser $ lines out) $ \(n,p) -> Repository n p <$> getEclasses p
Left pe -> fail $ show pe
Right nps -> do
forM nps $ \(n,p) -> Repository n p <$> getEclasses p
-- | Get the name of the repo and its path from blocks outputted by -- | Get the name of the repo and its path from blocks outputted by
-- @portageq@. If the path doesn't exist, this will return @Nothing@. -- @portageq@. If the path doesn't exist, this will return @Nothing@.
reposParser :: Parser [(RepoName, RepoPath)] reposParser :: [String] -> [(RepoName, RepoPath)]
reposParser = reposParser = f ""
choice
[ [] <$ endOfInput
, repoName >>= repoBlock
]
where where
-- Get the name of the repo at the top of the block segmentRegex = mkRegex "^\\[(.*)\\].*"
repoName :: Parser RepoName locationRegex = mkRegex "^[[:space:]]*location[[:space:]]*=[[:space:]]*(.*)[[:space:]]*$"
repoName = do f name [] = []
_ <- char '[' f name (line:rest) =
n <- takeWhile (/= fromIntegral (ord ']')) case (matchRegex segmentRegex line, matchRegex locationRegex line) of
_ <- char ']' (Just [next], _) -> f next rest
_ <- endOfLine (_, Just [location]) -> (name, location) : f name rest
pure n _ -> f name rest
-- Parse the block for location field
repoBlock :: RepoName -> Parser [(RepoName, RepoPath)]
repoBlock n = choice
[ do
l <- "location = " *> takeLine
-- Found the location, skip the rest of the block
skipMany miscLine *> endOfBlock
insert (n,l)
-- Did not find the location, keep trying
, miscLine *> repoBlock n
-- Reached the end of the block, no location field
, endOfBlock *> ignore
]
miscLine :: Parser ()
miscLine = skipNonEmptyLine
-- A block either ends with an empty line or eof
endOfBlock :: Parser ()
endOfBlock = endOfLine <|> endOfInput
-- cons the repo and continue parsing
insert :: (RepoName, RepoPath) -> Parser [(RepoName, RepoPath)]
insert r = (r:) <$> reposParser
-- skip the repo and continue parsing
ignore :: Parser [(RepoName, RepoPath)]
ignore = reposParser
-- | Scan the repo path for @*.eclass@ files in @eclass/@, then run -- | Scan the repo path for @*.eclass@ files in @eclass/@, then run
-- 'eclassParser' on each of them to produce @[Eclass]@. -- 'eclassParser' on each of them to produce @[Eclass]@.
@ -125,56 +79,38 @@ reposParser =
-- If the @eclass/@ directory doesn't exist, the scan is skipped for that -- If the @eclass/@ directory doesn't exist, the scan is skipped for that
-- repo. -- repo.
getEclasses :: RepoPath -> IO [Eclass] getEclasses :: RepoPath -> IO [Eclass]
getEclasses repoLoc = fmap (maybe [] id) $ runMaybeT $ do getEclasses repoLoc = do
let eclassDir = (decodeLenient repoLoc) </> "eclass" let eclassDir = repoLoc </> "eclass"
-- Silently fail if the repo doesn't have an eclass dir files <- handle catcher $ listDirectory eclassDir
fs <- MaybeT $ Just <$> listDirectory eclassDir <|> pure Nothing let names = filter (\(_, e) -> e == ".eclass") $ map splitExtension files
let fs' = filter (\(_,e) -> e == ".eclass") $ map splitExtensions fs
forM fs' $ \(n,e) -> do forM (names :: [(String, String)]) $ \(name, ext) -> do
evs <- lift $ parseFromFile eclassParser (eclassDir </> n <.> e) contents <- withFile (eclassDir </> name <.> ext) ReadMode readFully
case evs of return $ Eclass name $ eclassParser (lines contents)
Left pe -> lift $ fail $ show pe
Right vs -> pure $ Eclass n vs where
catcher :: IOException -> IO [String]
catcher e = do
hPutStrLn stderr $ "Unable to find .eclass files: " ++ show e
return []
-- | Scan a @.eclass@ file for any @@@ECLASS_VARIABLE:@ comments, generating -- | Scan a @.eclass@ file for any @@@ECLASS_VARIABLE:@ comments, generating
-- a list of eclass variables. -- a list of eclass variables.
eclassParser :: Parser [EclassVar] eclassParser :: [String] -> [String]
eclassParser = choice eclassParser lines = mapMaybe match lines
[ -- cons the EclassVar to the list and continue
liftA2 (:) eclassVar eclassParser
-- or skip the line and continue
, skipLine *> eclassParser
-- or end the list on eof
, [] <$ endOfInput
]
where where
-- Scans for @ECLASS_VARIABLE comments rather than parsing the raw bash varRegex = mkRegex "^[[:space:]]*#[[:space:]]*@ECLASS_VARIABLE:[[:space:]]*([^[:space:]]*)[[:space:]]*$"
eclassVar :: Parser EclassVar match str = head <$> matchRegex varRegex str
eclassVar = "# @ECLASS_VARIABLE: " *> takeLine
takeLine :: Parser ByteString
takeLine = A.takeWhile (not . isEndOfLine) <* endOfLine
-- | Fails if next char is 'endOfLine'
skipNonEmptyLine :: Parser ()
skipNonEmptyLine = A.satisfy (not . isEndOfLine) *> skipLine
skipLine :: Parser ()
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 ByteString runOrDie :: FilePath -> [String] -> IO String
runOrDie cmd args = bracket acquire release $ \(_,o,e,p) -> do runOrDie cmd args = bracket acquire release $ \(_,o,e,p) -> do
ot <- B.hGetContents (fromJust o) ot <- readFully (fromJust o)
et <- B.hGetContents (fromJust e) et <- readFully (fromJust e)
ec <- waitForProcess p ec <- waitForProcess p
case ec of case ec of
ExitSuccess -> pure ot ExitSuccess -> pure ot
@ -182,8 +118,8 @@ runOrDie cmd args = bracket acquire release $ \(_,o,e,p) -> do
$ [ [ show cmd ] $ [ [ show cmd ]
++ map show args ++ map show args
++ [ "failed with exit code", show i] ++ [ "failed with exit code", show i]
, [ "stdout:" ], [ decodeLenient ot ] , [ "stdout:" ], [ ot ]
, [ "stderr:" ], [ decodeLenient et ] , [ "stderr:" ], [ et ]
] ]
where where
acquire = createProcess (proc cmd args) acquire = createProcess (proc cmd args)
@ -195,5 +131,8 @@ runOrDie cmd args = bracket acquire release $ \(_,o,e,p) -> do
_ <- waitForProcess p _ <- waitForProcess p
forM_ [i,o,e] $ mapM_ hClose forM_ [i,o,e] $ mapM_ hClose
decodeLenient :: ByteString -> String readFully :: Handle -> IO String
decodeLenient = T.unpack . T.decodeUtf8With T.lenientDecode readFully handle = do
hSetBinaryMode handle True
str <- hGetContents handle
length str `seq` return str