@@ -25,29 +25,24 @@ where
25
25
import CLC.Stackage.Utils.Paths qualified as Paths
26
26
import Control.Applicative (Alternative ((<|>) ))
27
27
import Control.DeepSeq (NFData )
28
- import Control.Monad (void )
29
28
import Data.Aeson (FromJSON (parseJSON ), ToJSON (toJSON ))
30
29
import Data.Aeson qualified as Asn
31
30
import Data.Char qualified as Ch
32
31
import Data.String (IsString (fromString ))
33
32
import Data.Text (Text )
34
33
import Data.Text qualified as T
35
- import Data.Void (Void )
36
34
import GHC.Generics (Generic )
37
35
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
41
36
42
37
-- | Wrapper for package version.
43
38
data PackageVersion
44
39
= -- | Basic version text e.g. "2.3".
45
40
PackageVersionText Text
46
41
| -- | 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
48
43
-- writing/reading the report.
49
44
--
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
51
46
-- to the cabal.config endpoint, or is used with an explicit
52
47
-- --snapshot-path argument.
53
48
PackageVersionInstalled
@@ -120,49 +115,50 @@ toTextNoInstalled p = p.name <> versToTextNoInstalled p.version
120
115
-- - "aeson ==2.0.0,"
121
116
-- - "mtl installed"
122
117
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
127
119
128
- type Parser = MP. Parsec Void Text
129
-
130
- -- | Parses packages e.g.
120
+ -- NOTE: [*Parsers]
131
121
--
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
138
134
pure $ MkPackage name vers
139
135
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)
142
141
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
157
159
where
158
160
isVersChar c = Ch. isDigit c || c == ' .'
159
161
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
-
166
162
versToTextInstalled :: PackageVersion -> Text
167
163
versToTextInstalled (PackageVersionText t) = " " <> delim <> t
168
164
versToTextInstalled PackageVersionInstalled = " installed"
0 commit comments