Partially fix whitespace parsing performance regression (#1512)

* Partially fix whitespace parsing performance regression

This undoes some of the performance regression introduced
in https://github.com/dhall-lang/dhall-haskell/pull/1483

Before #1483:

```
benchmarked Line comment
time                 11.86 ms   (11.69 ms .. 11.98 ms)
                     0.999 R²   (0.999 R² .. 1.000 R²)
mean                 11.84 ms   (11.79 ms .. 11.89 ms)
std dev              129.4 μs   (107.2 μs .. 164.1 μs)

benchmarked Block comment
time                 13.20 ms   (13.00 ms .. 13.41 ms)
                     0.999 R²   (0.998 R² .. 1.000 R²)
mean                 13.59 ms   (13.41 ms .. 13.94 ms)
std dev              600.0 μs   (142.2 μs .. 953.7 μs)
```

After #1483:

```
benchmarked Line comment
time                 288.7 ms   (282.8 ms .. 294.7 ms)
                     1.000 R²   (0.999 R² .. 1.000 R²)
mean                 292.3 ms   (290.8 ms .. 294.6 ms)
std dev              3.156 ms   (2.216 ms .. 4.546 ms)

benchmarked Block comment
time                 286.2 ms   (280.9 ms .. 292.6 ms)
                     0.999 R²   (0.998 R² .. 1.000 R²)
mean                 290.6 ms   (288.3 ms .. 292.9 ms)
std dev              3.875 ms   (2.866 ms .. 5.500 ms)
```

After this change:

```
benchmarked Line comment
time                 61.44 ms   (60.37 ms .. 63.03 ms)
                     0.999 R²   (0.997 R² .. 1.000 R²)
mean                 61.41 ms   (60.74 ms .. 62.25 ms)
std dev              1.341 ms   (945.0 μs .. 1.901 ms)

benchmarked Block comment
time                 61.83 ms   (60.97 ms .. 63.14 ms)
                     0.999 R²   (0.998 R² .. 1.000 R²)
mean                 61.16 ms   (60.33 ms .. 61.85 ms)
std dev              1.396 ms   (1.011 ms .. 1.907 ms)
```

* Correctly parse `https://example.com usingBla`

... as caught by @sjakobi

dhall/src/Dhall/Parser/Expression.hs

@@ -262,14 +262,14 @@ parsers embedded = Parsers {..}
             a <- operatorExpression
 
             let alternative4A = do
-                    try (whitespace *> _arrow)
+                    _arrow
                     whitespace
                     b <- expression
                     whitespace
                     return (Pi "_" a b)
 
             let alternative4B = do
-                    try (whitespace *> _colon)
+                    _colon
                     nonemptyWhitespace
                     b <- expression
                     case shallowDenote a of
@@ -289,9 +289,16 @@ parsers embedded = Parsers {..}
     makeOperatorExpression operatorParser subExpression =
             noted (do
                 a <- subExpression
+
+                whitespace
+
                 b <- Text.Megaparsec.many $ do
-                    op <- try (whitespace *> operatorParser)
+                    op <- operatorParser
+
                     r  <- subExpression
+
+                    whitespace
+
                     return (\l -> l `op` r)
                 return (foldl (\x f -> f x) a b) )
 
@@ -705,36 +712,70 @@ parsers embedded = Parsers {..}
     nonEmptyRecordTypeOrLiteral = do
             a <- anyLabel
 
+            whitespace
+
             let nonEmptyRecordType = do
-                    try (whitespace *> _colon)
+                    _colon
+
                     nonemptyWhitespace
+
                     b <- expression
+
+                    whitespace
+
                     e <- Text.Megaparsec.many (do
-                        try (whitespace *> _comma)
+                        _comma
+
                         whitespace
+
                         c <- anyLabel
+
                         whitespace
+
                         _colon
+
                         nonemptyWhitespace
+
                         d <- expression
+
+                        whitespace
+
                         return (c, d) )
+
                     m <- toMap ((a, b) : e)
+
                     return (Record m)
 
             let nonEmptyRecordLiteral = do
-                    try (whitespace *> _equal)
+                    _equal
+
                     whitespace
+
                     b <- expression
+
+                    whitespace
+
                     e <- Text.Megaparsec.many (do
-                        try (whitespace *> _comma)
+                        _comma
+
                         whitespace
+
                         c <- anyLabel
+
                         whitespace
+
                         _equal
+
                         whitespace
+
                         d <- expression
+
+                        whitespace
+
                         return (c, d) )
+
                     m <- toMap ((a, b) : e)
+
                     return (RecordLit m)
 
             nonEmptyRecordType <|> nonEmptyRecordLiteral
@@ -840,10 +881,8 @@ local = do
 http :: Parser ImportType
 http = do
     url <- httpRaw
-    headers <- optional (try $ do
+    headers <- optional (do
-        whitespace
+        try (whitespace *> _using *> nonemptyWhitespace)
-        _using
-        nonemptyWhitespace
         importExpression import_ )
     return (Remote (url { headers }))
 
@@ -905,10 +944,9 @@ import_ = (do
     importMode   <- alternative <|> pure Code
     return (Import {..}) ) <?> "import"
   where
-    alternative = try $ do
+    alternative = do
-      whitespace
+      try (whitespace *> _as *> nonemptyWhitespace)
-      _as
+
-      nonemptyWhitespace
       (_Text >> pure RawText) <|> (_Location >> pure Location)
 
 -- | Same as @Data.Text.splitOn@, except always returning a `NonEmpty` result

dhall/tests/Dhall/Test/Parser.hs

@@ -89,7 +89,8 @@ notesInLetInLet = do
                       (Just " ")
                       Nothing
                       (Just " ")
-                      (Note "0" (NaturalLit 0)))
+                      (Note "0 " (Note "0" (NaturalLit 0)))
+                    )
                     -- This 'Let' isn't wrapped in a 'Note'!
                     (Let
                       (Binding
@@ -98,7 +99,7 @@ notesInLetInLet = do
                         (Just " ")
                         Nothing
                         (Just " ")
-                        (Note "1" (NaturalLit 1))
+                        (Note "1 " (Note "1" (NaturalLit 1)))
                       )
                       (Note "let z = 2 in x"
                         (Let
@@ -108,10 +109,14 @@ notesInLetInLet = do
                             (Just " ")
                             Nothing
                             (Just " ")
-                            (Note "2" (NaturalLit 2))
+                            (Note "2 " (Note "2" (NaturalLit 2)))
                           )
-                          (Note "x"
+                          (Note "x" (Var (V "x" 0)))
-                            (Var (V "x" 0))))))))
+                        )
+                      )
+                    )
+                  )
+                )
 
         let msg = "Unexpected parse result"