Skip to content

Commit 761e854

Browse files
Anton-LatukhaAnton-Latukha
committed
Nix.Parser: org, TOC, use of liftA*, clean-up
1 parent 787156e commit 761e854

File tree

1 file changed

+85
-69
lines changed

1 file changed

+85
-69
lines changed

‎src/Nix/Parser.hs‎

Lines changed: 85 additions & 69 deletions
Original file line numberDiff line numberDiff line change
@@ -49,9 +49,7 @@ import Prelude hiding ( some
4949
)
5050
import Data.Foldable ( foldr1 )
5151

52-
import Control.Monad ( liftM2
53-
, msum
54-
)
52+
import Control.Monad ( msum )
5553
import Control.Monad.Combinators.Expr ( makeExprParser
5654
, Operator( Postfix
5755
, InfixN
@@ -91,6 +89,11 @@ import Text.Megaparsec.Char ( space1
9189
)
9290
import qualified Text.Megaparsec.Char.Lexer as Lexer
9391

92+
-- | Different to @isAlphaNum@
93+
isAlphanumeric :: Char -> Bool
94+
isAlphanumeric x = isAlpha x || isDigit x
95+
{-# inline isAlphanumeric #-}
96+
9497
infixl 3 <+>
9598
(<+>) :: MonadPlus m => m a -> m a -> m a
9699
(<+>) = mplus
@@ -100,11 +103,12 @@ infixl 3 <+>
100103
nixExpr :: Parser NExprLoc
101104
nixExpr =
102105
makeExprParser
103-
nixTerm $ snd <<$>>
106+
nixTerm $
107+
snd <<$>>
104108
nixOperators nixSelector
105109

106110
antiStart :: Parser Text
107-
antiStart = symbol "${" <?> show ("${" :: String)
111+
antiStart = symbol "${" <?> "${"
108112

109113
nixAntiquoted :: Parser a -> Parser (Antiquoted a NExprLoc)
110114
nixAntiquoted p =
@@ -121,19 +125,20 @@ nixSelect :: Parser NExprLoc -> Parser NExprLoc
121125
nixSelect term =
122126
do
123127
res <-
124-
build
125-
<$> term
126-
<*> optional
127-
( (,)
128-
<$> (selDot *> nixSelector)
129-
<*> optional (reserved "or" *> nixTerm)
128+
liftA2 build
129+
term
130+
(optional $
131+
liftA2 (,)
132+
(selDot *> nixSelector)
133+
(optional $ reserved "or" *> nixTerm)
130134
)
131135
continues <- optional $ lookAhead selDot
132136

133137
maybe
134-
(pure res)
135-
(const $ nixSelect (pure res))
138+
id
139+
(const nixSelect)
136140
continues
141+
(pure res)
137142
where
138143
build
139144
:: NExprLoc
@@ -143,9 +148,10 @@ nixSelect term =
143148
-> NExprLoc
144149
build t mexpr =
145150
maybe
146-
t
147-
(uncurry (nSelectLoc t))
151+
id
152+
(\ expr t -> (uncurry $ nSelectLoc t) expr)
148153
mexpr
154+
t
149155

150156
nixSelector :: Parser (Ann SrcSpan (NAttrPath NExprLoc))
151157
nixSelector =
@@ -217,7 +223,7 @@ nixList = annotateLocation1 (brackets (NList <$> many nixTerm) <?> "list")
217223

218224
pathChar :: Char -> Bool
219225
pathChar x =
220-
isAlpha x || isDigit x || (`elem` ("._-+~" :: String)) x
226+
isAlphanumeric x || (`elem` ("._-+~" :: String)) x
221227

222228
slash :: Parser Char
223229
slash =
@@ -238,10 +244,17 @@ nixSearchPath =
238244
)
239245

240246
pathStr :: Parser FilePath
241-
pathStr = lexeme $ liftM2
242-
(<>)
243-
(many (satisfy pathChar))
244-
(Prelude.concat <$> some (liftM2 (:) slash (some (satisfy pathChar))))
247+
pathStr =
248+
lexeme $
249+
liftA2 (<>)
250+
(many $ satisfy pathChar)
251+
(concat <$>
252+
some
253+
(liftA2 (:)
254+
slash
255+
(some $ satisfy pathChar)
256+
)
257+
)
245258

246259
nixPath :: Parser NExprLoc
247260
nixPath = annotateLocation1 (try (mkPathF False <$> pathStr) <?> "path")
@@ -251,41 +264,44 @@ nixLet = annotateLocation1
251264
(reserved "let" *> (letBody <+> letBinders) <?> "let block")
252265
where
253266
letBinders =
254-
NLet
255-
<$> nixBinders
256-
<*> (reserved "in" *> nixToplevelForm)
267+
liftA2 NLet
268+
nixBinders
269+
(reserved "in" *> nixToplevelForm)
257270
-- Let expressions `let {..., body = ...}' are just desugared
258271
-- into `(rec {..., body = ...}).body'.
259272
letBody = (\x -> NSelect x (StaticKey "body" :| mempty) Nothing) <$> aset
260273
aset = annotateLocation1 $ NSet NRecursive <$> braces nixBinders
261274

262275
nixIf :: Parser NExprLoc
263276
nixIf = annotateLocation1
264-
(NIf
265-
<$> (reserved "if" *> nixExpr)
266-
<*> (reserved "then" *> nixToplevelForm)
267-
<*> (reserved "else" *> nixToplevelForm)
277+
(liftA3 NIf
278+
(reserved "if" *> nixExpr )
279+
(reserved "then" *> nixToplevelForm)
280+
(reserved "else" *> nixToplevelForm)
268281
<?> "if"
269282
)
270283

271284
nixAssert :: Parser NExprLoc
272285
nixAssert = annotateLocation1
273-
(NAssert
274-
<$> (reserved "assert" *> nixToplevelForm)
275-
<*> (semi *> nixToplevelForm)
286+
(liftA2 NAssert
287+
(reserved "assert" *> nixToplevelForm)
288+
(semi *> nixToplevelForm)
276289
<?> "assert"
277290
)
278291

279292
nixWith :: Parser NExprLoc
280293
nixWith = annotateLocation1
281-
(NWith
282-
<$> (reserved "with" *> nixToplevelForm)
283-
<*> (semi *> nixToplevelForm)
294+
(liftA2 NWith
295+
(reserved "with" *> nixToplevelForm)
296+
(semi *> nixToplevelForm)
284297
<?> "with"
285298
)
286299

287300
nixLambda :: Parser NExprLoc
288-
nixLambda = nAbs <$> annotateLocation (try argExpr) <*> nixToplevelForm
301+
nixLambda =
302+
liftA2 nAbs
303+
(annotateLocation $ try argExpr)
304+
nixToplevelForm
289305

290306
nixString :: Parser NExprLoc
291307
nixString = nStr <$> annotateLocation nixString'
@@ -296,16 +312,14 @@ nixUri = lexeme $ annotateLocation1 $ try $ do
296312
protocol <- many $
297313
satisfy $
298314
\ x ->
299-
isAlpha x
300-
|| isDigit x
315+
isAlphanumeric x
301316
|| (`elem` ("+-." :: String)) x
302317
_ <- string ":"
303318
address <-
304319
some $
305320
satisfy $
306321
\ x ->
307-
isAlpha x
308-
|| isDigit x
322+
isAlphanumeric x
309323
|| (`elem` ("%/?:@&=+$,-_.!~*'" :: String)) x
310324
pure $ NStr $ DoubleQuoted
311325
[Plain $ toText $ start : protocol ++ ':' : address]
@@ -324,7 +338,7 @@ nixString' = lexeme (doubleQuoted <+> indented <?> "string")
324338
)
325339
<?> "double quoted string"
326340

327-
doubleQ = void (char '"')
341+
doubleQ = void $ char '"'
328342
doubleEscape = Plain . singleton <$> (char '\\' *> escapeCode)
329343

330344
indented :: Parser (NString NExprLoc)
@@ -392,21 +406,18 @@ argExpr =
392406
try $
393407
do
394408
name <- identifier <* symbol "@"
395-
(variadic, params) <- params
396-
pure $ ParamSet params variadic (pure name)
409+
(params, variadic) <- params
410+
pure $ ParamSet params variadic $ pure name
397411

398412
-- Parameters named by an identifier on the right, or none (`{x, y} @ args`)
399413
atRight =
400414
do
401-
(variadic, params) <- params
415+
(params, variadic) <- params
402416
name <- optional $ symbol "@" *> identifier
403417
pure $ ParamSet params variadic name
404418

405419
-- Return the parameters set.
406-
params =
407-
do
408-
(args, dotdots) <- braces getParams
409-
pure (dotdots, args)
420+
params = braces getParams
410421

411422
-- Collects the parameters within curly braces. Returns the parameters and
412423
-- a boolean indicating if the parameters are variadic.
@@ -417,17 +428,22 @@ argExpr =
417428
-- Otherwise, attempt to parse an argument, optionally with a
418429
-- default. If this fails, then return what has been accumulated
419430
-- so far.
420-
go acc = ((acc, True) <$ symbol "...") <+> getMore acc
431+
go acc = ((acc, True) <$ symbol "...") <+> getMore
432+
where
433+
getMore =
434+
-- Could be nothing, in which just return what we have so far.
435+
option (acc, False) $
436+
do
437+
-- Get an argument name and an optional default.
438+
pair <-
439+
liftA2 (,)
440+
identifier
441+
(optional $ question *> nixToplevelForm)
421442

422-
getMore acc =
423-
-- Could be nothing, in which just return what we have so far.
424-
option (acc, False) $
425-
do
426-
-- Get an argument name and an optional default.
427-
pair <- liftM2 (,) identifier (optional $ question *> nixToplevelForm)
443+
let args = acc <> [pair]
428444

429-
-- Either return this, or attempt to get a comma and restart.
430-
option (acc <> [pair], False) $ comma *> go (acc <> [pair])
445+
-- Either return this, or attempt to get a comma and restart.
446+
option (args, False) $ comma *> go args
431447

432448
nixBinders :: Parser [Binding NExprLoc]
433449
nixBinders = (inherit <+> namedVar) `endBy` semi where
@@ -438,17 +454,17 @@ nixBinders = (inherit <+> namedVar) `endBy` semi where
438454
try $ string "inherit" *> lookAhead (void (satisfy reservedEnd))
439455
p <- getSourcePos
440456
x <- whiteSpace *> optional scope
441-
Inherit x
442-
<$> many keyName
443-
<*> pure p
457+
liftA2 (Inherit x)
458+
(many keyName)
459+
(pure p)
444460
<?> "inherited binding"
445461
namedVar =
446462
do
447463
p <- getSourcePos
448-
NamedVar
449-
<$> (annotated <$> nixSelector)
450-
<*> (equals *> nixToplevelForm)
451-
<*> pure p
464+
liftA3 NamedVar
465+
(annotated <$> nixSelector)
466+
(equals *> nixToplevelForm)
467+
(pure p)
452468
<?> "variable binding"
453469
scope = nixParens <?> "inherit scope"
454470

@@ -509,13 +525,13 @@ reserved n =
509525
identifier :: Parser Text
510526
identifier = lexeme $ try $ do
511527
ident <-
512-
cons
513-
<$> satisfy (\x -> isAlpha x || x == '_')
514-
<*> takeWhileP mempty identLetter
515-
guard (not (ident `HashSet.member` reservedNames))
528+
liftA2 cons
529+
(satisfy (\x -> isAlpha x || x == '_'))
530+
(takeWhileP mempty identLetter)
531+
guard $ not $ ident `HashSet.member` reservedNames
516532
pure ident
517533
where
518-
identLetter x = isAlpha x || isDigit x || x == '_' || x == '\'' || x == '-'
534+
identLetter x = isAlphanumeric x || x == '_' || x == '\'' || x == '-'
519535

520536
-- We restrict the type of 'parens' and 'brackets' here because if they were to
521537
-- take a @Parser NExprLoc@ argument they would parse additional text which
@@ -584,8 +600,8 @@ data NAssoc = NAssocNone | NAssocLeft | NAssocRight
584600
deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)
585601

586602
data NOperatorDef
587-
= NUnaryDef Text NUnaryOp
588-
| NBinaryDef Text NBinaryOp NAssoc
603+
= NUnaryDef Text NUnaryOp
604+
| NBinaryDef Text NBinaryOp NAssoc
589605
| NSpecialDef Text NSpecialOp NAssoc
590606
deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)
591607

0 commit comments

Comments
 (0)