1
+ {-# LANGUAGE ApplicativeDo #-}
2
+ {-# LANGUAGE LambdaCase #-}
3
+ {-# LANGUAGE OverloadedStrings #-}
4
+ {-# LANGUAGE TupleSections #-}
1
5
2
6
module ShellCheck.PortageVariables
3
7
( RepoName
@@ -9,25 +13,37 @@ module ShellCheck.PortageVariables
9
13
, Eclass (.. )
10
14
, portageVariables
11
15
, scanRepos
16
+ , decodeLenient
12
17
) where
13
18
14
19
import Control.Applicative
20
+ import Control.Exception (bracket )
15
21
import Control.Monad
16
- import Control.Monad.Trans.Class
22
+ import Control.Monad.Trans.Class ( lift )
17
23
import Control.Monad.Trans.Maybe
18
- import Data.Map (Map )
24
+ import Data.Attoparsec.ByteString
25
+ import qualified Data.Attoparsec.ByteString as A
26
+ import Data.Attoparsec.ByteString.Char8 hiding (takeWhile )
27
+ import Data.ByteString (ByteString )
28
+ import qualified Data.ByteString as B
29
+ import Data.Char (ord )
19
30
import qualified Data.Map as M
31
+ import Data.Maybe (fromJust )
32
+ import qualified Data.Text as T
33
+ import qualified Data.Text.Encoding as T
34
+ import qualified Data.Text.Encoding.Error as T
20
35
import System.Directory (listDirectory )
21
36
import System.Exit (ExitCode (.. ))
22
37
import System.FilePath
38
+ import System.IO (hClose )
23
39
import System.Process
24
- import Text.Parsec hiding ((<|>) )
25
- import Text.Parsec.String
26
40
27
- type RepoName = String
28
- type RepoPath = FilePath
41
+ import Prelude hiding (takeWhile )
42
+
43
+ type RepoName = ByteString
44
+ type RepoPath = ByteString
29
45
type EclassName = String
30
- type EclassVar = String
46
+ type EclassVar = ByteString
31
47
32
48
-- | This is used for looking up what eclass variables are inherited,
33
49
-- keyed by the name of the eclass.
@@ -57,7 +73,7 @@ scanRepos = do
57
73
let cmd = " /usr/bin/portageq"
58
74
let args = [" repos_config" , " /" ]
59
75
out <- runOrDie cmd args
60
- case parse reposParser " scanRepos " out of
76
+ case parseOnly reposParser out of
61
77
Left pe -> fail $ show pe
62
78
Right nps -> do
63
79
forM nps $ \ (n,p) -> Repository n p <$> getEclasses p
@@ -67,37 +83,39 @@ scanRepos = do
67
83
reposParser :: Parser [(RepoName , RepoPath )]
68
84
reposParser =
69
85
choice
70
- [ [] <$ eof
86
+ [ [] <$ endOfInput
71
87
, repoName >>= repoBlock
72
88
]
73
89
where
74
90
-- Get the name of the repo at the top of the block
75
91
repoName :: Parser RepoName
76
- repoName
77
- = char ' ['
78
- *> manyTill anyChar (try (char ' ]' ))
79
- <* endOfLine
92
+ repoName = do
93
+ _ <- char ' ['
94
+ n <- takeWhile (/= fromIntegral (ord ' ]' ))
95
+ _ <- char ' ]'
96
+ _ <- endOfLine
97
+ pure n
80
98
81
99
-- Parse the block for location field
82
100
repoBlock :: RepoName -> Parser [(RepoName , RepoPath )]
83
101
repoBlock n = choice
84
- [ try $ do
85
- l <- string " location = " *> takeLine
102
+ [ do
103
+ l <- " location = " *> takeLine
86
104
-- Found the location, skip the rest of the block
87
105
skipMany miscLine *> endOfBlock
88
106
insert (n,l)
89
107
-- Did not find the location, keep trying
90
- , try $ miscLine *> repoBlock n
108
+ , miscLine *> repoBlock n
91
109
-- Reached the end of the block, no location field
92
110
, endOfBlock *> ignore
93
111
]
94
112
95
113
miscLine :: Parser ()
96
114
miscLine = skipNonEmptyLine
97
115
98
- -- A block ends with an eol or eof
116
+ -- A block either ends with an empty line or eof
99
117
endOfBlock :: Parser ()
100
- endOfBlock = void endOfLine <|> eof
118
+ endOfBlock = endOfLine <|> endOfInput
101
119
102
120
-- cons the repo and continue parsing
103
121
insert :: (RepoName , RepoPath ) -> Parser [(RepoName , RepoPath )]
@@ -114,7 +132,7 @@ reposParser =
114
132
-- repo.
115
133
getEclasses :: RepoPath -> IO [Eclass ]
116
134
getEclasses repoLoc = fmap (maybe [] id ) $ runMaybeT $ do
117
- let eclassDir = repoLoc </> " eclass"
135
+ let eclassDir = (decodeLenient repoLoc) </> " eclass"
118
136
119
137
-- Silently fail if the repo doesn't have an eclass dir
120
138
fs <- MaybeT $ Just <$> listDirectory eclassDir <|> pure Nothing
@@ -131,40 +149,57 @@ getEclasses repoLoc = fmap (maybe [] id) $ runMaybeT $ do
131
149
eclassParser :: Parser [EclassVar ]
132
150
eclassParser = choice
133
151
[ -- cons the EclassVar to the list and continue
134
- try $ liftA2 (:) eclassVar eclassParser
152
+ liftA2 (:) eclassVar eclassParser
135
153
-- or skip the line and continue
136
154
, skipLine *> eclassParser
137
155
-- or end the list on eof
138
- , [] <$ eof
156
+ , [] <$ endOfInput
139
157
]
140
158
where
141
159
-- Scans for @ECLASS_VARIABLE comments rather than parsing the raw bash
142
160
eclassVar :: Parser EclassVar
143
- eclassVar = string " # @ECLASS_VARIABLE: " *> takeLine
161
+ eclassVar = " # @ECLASS_VARIABLE: " *> takeLine
144
162
145
- takeLine :: Parser String
146
- takeLine = manyTill anyChar (try endOfLine)
163
+ takeLine :: Parser ByteString
164
+ takeLine = A. takeWhile ( not . isEndOfLine) <* endOfLine
147
165
148
166
-- | Fails if next char is 'endOfLine'
149
167
skipNonEmptyLine :: Parser ()
150
- skipNonEmptyLine = notFollowedBy endOfLine *> skipLine
168
+ skipNonEmptyLine = A. satisfy ( not . isEndOfLine) *> skipLine
151
169
152
170
skipLine :: Parser ()
153
- skipLine = void takeLine
171
+ skipLine = A. skipWhile (not . isEndOfLine) <* endOfLine
172
+
173
+ parseFromFile :: Parser a -> FilePath -> IO (Either String a )
174
+ parseFromFile p = fmap (parseOnly p) . B. readFile
154
175
155
176
-- | Run the command and return the full stdout string (stdin is ignored).
156
177
--
157
178
-- If the command exits with a non-zero exit code, this will throw an
158
179
-- error including the captured contents of stdout and stderr.
159
- runOrDie :: FilePath -> [String ] -> IO String
160
- runOrDie cmd args = do
161
- (ec, o, e) <- readProcessWithExitCode cmd args " "
180
+ runOrDie :: FilePath -> [String ] -> IO ByteString
181
+ runOrDie cmd args = bracket acquire release $ \ (_,o,e,p) -> do
182
+ ot <- B. hGetContents (fromJust o)
183
+ et <- B. hGetContents (fromJust e)
184
+ ec <- waitForProcess p
162
185
case ec of
163
- ExitSuccess -> pure o
186
+ ExitSuccess -> pure ot
164
187
ExitFailure i -> fail $ unlines $ map unwords
165
188
$ [ [ show cmd ]
166
189
++ map show args
167
190
++ [ " failed with exit code" , show i]
168
- , [ " stdout:" ], [ o ]
169
- , [ " stderr:" ], [ e ]
191
+ , [ " stdout:" ], [ decodeLenient ot ]
192
+ , [ " stderr:" ], [ decodeLenient et ]
170
193
]
194
+ where
195
+ acquire = createProcess (proc cmd args)
196
+ { std_in = NoStream
197
+ , std_out = CreatePipe
198
+ , std_err = CreatePipe
199
+ }
200
+ release (i,o,e,p) = do
201
+ _ <- waitForProcess p
202
+ forM_ [i,o,e] $ mapM_ hClose
203
+
204
+ decodeLenient :: ByteString -> String
205
+ decodeLenient = T. unpack . T. decodeUtf8With T. lenientDecode
0 commit comments