Skip to content

Commit ff436aa

Browse files
committed
Swap megaparsec for text parsing
Using megaparsec was probably overkill, as the constraint parsing is simple enough that we can do it with text without too much trouble.
1 parent 1be6d71 commit ff436aa

File tree

3 files changed

+45
-53
lines changed

3 files changed

+45
-53
lines changed

clc-stackage.cabal

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,6 @@ library utils
4646
, directory ^>=1.3.5.0
4747
, file-io ^>=0.1.0.0
4848
, filepath >=1.4.100.0 && <1.6
49-
, megaparsec >=9.5.0 && <9.8
5049
, pretty-terminal ^>=0.1.0.0
5150
, text >=1.2.3.2 && <2.2
5251
, time >=1.9.3 && <1.15
@@ -72,7 +71,6 @@ library parser
7271
, http-client >=0.5.9 && <0.8
7372
, http-client-tls ^>=0.3
7473
, http-types ^>=0.12.3
75-
, megaparsec
7674
, text
7775
, utils
7876

src/parser/CLC/Stackage/Parser/API/CabalConfig.hs

Lines changed: 7 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -27,8 +27,6 @@ import Data.Text qualified as T
2727
import Data.Text.Encoding qualified as TEnc
2828
import Network.HTTP.Client (BodyReader, Manager, Request, Response)
2929
import Network.HTTP.Client qualified as HttpClient
30-
import Text.Megaparsec qualified as MP
31-
import Text.Megaparsec.Char qualified as MPC
3230

3331
-- | Given http manager and snapshot string, queries the cabal config
3432
-- endpoint. This is intended as a backup, for when the primary endpoint fails.
@@ -79,11 +77,11 @@ parseCabalConfig =
7977

8078
-- | Parses a line like '<pkg> ==<vers>'.
8179
parseCabalConfigLine :: Text -> Maybe Package.Package
82-
parseCabalConfigLine txt = case MP.parse (MPC.space *> p) "package" txt of
83-
Right x -> Just x
84-
Left _ -> Nothing
80+
parseCabalConfigLine txt = do
81+
-- Strip leading 'constraints:' keyword, if it exists.
82+
let s = case T.stripPrefix "constraints:" txt' of
83+
Nothing -> txt'
84+
Just rest -> T.stripStart rest
85+
Package.packageParser s
8586
where
86-
-- Optional case for leading constraints section.
87-
p = do
88-
_ <- MP.optional (MPC.string "constraints:" *> MPC.space)
89-
Package.packageParser
87+
txt' = T.stripStart txt

src/utils/CLC/Stackage/Utils/Package.hs

Lines changed: 38 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -25,29 +25,24 @@ where
2525
import CLC.Stackage.Utils.Paths qualified as Paths
2626
import Control.Applicative (Alternative ((<|>)))
2727
import Control.DeepSeq (NFData)
28-
import Control.Monad (void)
2928
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON))
3029
import Data.Aeson qualified as Asn
3130
import Data.Char qualified as Ch
3231
import Data.String (IsString (fromString))
3332
import Data.Text (Text)
3433
import Data.Text qualified as T
35-
import Data.Void (Void)
3634
import GHC.Generics (Generic)
3735
import System.OsPath (OsPath)
38-
import Text.Megaparsec qualified as MP
39-
import Text.Megaparsec.Char qualified as MPC
40-
import Text.Megaparsec.Char.Lexer qualified as MPCL
4136

4237
-- | Wrapper for package version.
4338
data PackageVersion
4439
= -- | Basic version text e.g. "2.3".
4540
PackageVersionText Text
4641
| -- | Represents an installed lib e.g. "foo installed" from cabal
47-
-- constraints. This is included in the from/toJSON instances, for the
42+
-- constraints. This is included in the from/toJSON instances, for
4843
-- writing/reading the report.
4944
--
50-
-- Generally speaking, this is only used when clc-stackage is falls back
45+
-- Generally speaking, this is only used when clc-stackage falls back
5146
-- to the cabal.config endpoint, or is used with an explicit
5247
-- --snapshot-path argument.
5348
PackageVersionInstalled
@@ -120,49 +115,50 @@ toTextNoInstalled p = p.name <> versToTextNoInstalled p.version
120115
-- - "aeson ==2.0.0,"
121116
-- - "mtl installed"
122117
fromCabalConstraintsText :: Text -> Maybe Package
123-
fromCabalConstraintsText txt =
124-
case MP.parse (MPC.space *> packageParser) "package" txt of
125-
Right x -> Just x
126-
Left _ -> Nothing
118+
fromCabalConstraintsText = packageParser . T.stripStart
127119

128-
type Parser = MP.Parsec Void Text
129-
130-
-- | Parses packages e.g.
120+
-- NOTE: [*Parsers]
131121
--
132-
-- - "aeson ==2.0.0,"
133-
-- - "mtl installed"
134-
packageParser :: Parser Package
135-
packageParser = do
136-
name <- nameParser
137-
vers <- versionTextParser <|> versionInstalledParser
122+
-- DIY parser, where each function parses only as much as it needs, then
123+
-- returns the rest to be fed into the next parser. Following megaparsec's
124+
-- lead, each parser assumes that it is at the start of relevant text
125+
-- (i.e. no leading whitespace), and consumes trailing whitespace.
126+
--
127+
-- Hence the "rest" that is returned must have its leading whitespace stripped,
128+
-- so that the next parser can make the same assumption.
129+
130+
packageParser :: Text -> Maybe Package
131+
packageParser txt = do
132+
(name, r1) <- nameParser txt
133+
(vers, _) <- versionTextParser r1 <|> versionInstalledParser r1
138134
pure $ MkPackage name vers
139135

140-
nameParser :: Parser Text
141-
nameParser = lexeme $ MP.takeWhile1P (Just "name") isNameChar
136+
-- Split on whitepspace or equals e.g. "mtl installed", "aeson ==1.2.3".
137+
nameParser :: Text -> Maybe (Text, Text)
138+
nameParser txt
139+
| T.null name = Nothing
140+
| otherwise = Just (name, T.stripStart rest)
142141
where
143-
isNameChar c = c /= ' ' && c /= '='
144-
145-
versionInstalledParser :: Parser PackageVersion
146-
versionInstalledParser = do
147-
MPC.string "installed"
148-
mcommaParser
149-
pure PackageVersionInstalled
150-
151-
versionTextParser :: Parser PackageVersion
152-
versionTextParser = do
153-
lexeme $ MPC.string delim
154-
vers <- lexeme $ MP.takeWhile1P (Just "version") isVersChar
155-
mcommaParser
156-
pure $ PackageVersionText vers
142+
(name, rest) = T.break isNameChar txt
143+
isNameChar c = c == ' ' || c == '='
144+
145+
-- Parse "installed".
146+
versionInstalledParser :: Text -> Maybe (PackageVersion, Text)
147+
versionInstalledParser txt = do
148+
rest <- T.stripPrefix "installed" txt
149+
pure (PackageVersionInstalled, T.stripStart rest)
150+
151+
-- Parse e.g. "==1.2.3".
152+
versionTextParser :: Text -> Maybe (PackageVersion, Text)
153+
versionTextParser txt = do
154+
r1 <- T.stripPrefix delim txt
155+
let (vers, r2) = T.span isVersChar (T.stripStart r1)
156+
if not (T.null vers)
157+
then Just (PackageVersionText vers, T.stripStart r2)
158+
else Nothing
157159
where
158160
isVersChar c = Ch.isDigit c || c == '.'
159161

160-
mcommaParser :: Parser ()
161-
mcommaParser = lexeme $ void $ MP.optional $ MPC.char ','
162-
163-
lexeme :: Parser a -> Parser a
164-
lexeme = MPCL.lexeme MPC.space
165-
166162
versToTextInstalled :: PackageVersion -> Text
167163
versToTextInstalled (PackageVersionText t) = " " <> delim <> t
168164
versToTextInstalled PackageVersionInstalled = " installed"

0 commit comments

Comments
 (0)