Merge pull request #12193 from cabalism/refactor/applicative-parsing

Use applicative parsing

Author: mergify[bot]

Cabal-syntax/src/Distribution/Backpack.hs

@@ -180,17 +180,8 @@ instance Pretty OpenModule where
 instance Parsec OpenModule where
   parsec = parsecModuleVar <|> parsecOpenModule
     where
-      parsecOpenModule = do
-        uid <- parsec
-        _ <- P.char ':'
-        mod_name <- parsec
-        return (OpenModule uid mod_name)
-
-      parsecModuleVar = do
-        _ <- P.char '<'
-        mod_name <- parsec
-        _ <- P.char '>'
-        return (OpenModuleVar mod_name)
+      parsecOpenModule = OpenModule <$> parsec <* P.char ':' <*> parsec
+      parsecModuleVar = OpenModuleVar <$ P.char '<' <*> parsec <* P.char '>'
 
 -- | Get the set of holes ('ModuleVar') embedded in a 'Module'.
 openModuleFreeHoles :: OpenModule -> Set ModuleName

Cabal-syntax/src/Distribution/SPDX/LicenseExpression.hs

@@ -112,10 +112,7 @@ instance Parsec LicenseExpression where
     where
       expr = compoundOr
 
-      simple = do
-        s <- parsec
-        exc <- exception
-        return $ ELicense s exc
+      simple = ELicense <$> parsec <*> exception
 
       exception = P.optional $ P.try (spaces1 *> P.string "WITH" *> spaces1) *> parsec
 

Cabal-syntax/src/Distribution/System.hs

@@ -294,11 +294,7 @@ instance Parsec Platform where
   -- We could support that preferring variants 'OtherOS' or 'OtherArch'
   --
   -- For now we split into arch and os parts on the first dash.
-  parsec = do
-    arch <- parsecDashlessArch
-    _ <- P.char '-'
-    os <- parsec
-    return (Platform arch os)
+  parsec = Platform <$> parsecDashlessArch <* P.char '-' <*> parsec
     where
       parsecDashlessArch = classifyArch Strict <$> dashlessIdent
 

Cabal-syntax/src/Distribution/Types/AbiDependency.hs

@@ -31,11 +31,7 @@ instance Pretty AbiDependency where
     pretty uid <<>> Disp.char '=' <<>> pretty abi
 
 instance Parsec AbiDependency where
-  parsec = do
-    uid <- parsec
-    _ <- P.char '='
-    abi <- parsec
-    return (AbiDependency uid abi)
+  parsec = AbiDependency <$> parsec <* P.char '=' <*> parsec
 
 instance Binary AbiDependency
 instance Structured AbiDependency

Cabal-syntax/src/Distribution/Types/Module.hs

@@ -32,11 +32,7 @@ instance Pretty Module where
     pretty uid <<>> Disp.text ":" <<>> pretty mod_name
 
 instance Parsec Module where
-  parsec = do
-    uid <- parsec
-    _ <- P.char ':'
-    mod_name <- parsec
-    return (Module uid mod_name)
+  parsec = Module <$> parsec <* P.char ':' <*> parsec
 
 instance NFData Module where
   rnf (Module uid mod_name) = rnf uid `seq` rnf mod_name

Cabal-syntax/src/Distribution/Types/VersionRange/Internal.hs

@@ -356,27 +356,14 @@ instance Parsec VersionRange where
 versionRangeParser :: forall m. CabalParsing m => m Int -> CabalSpecVersion -> m VersionRange
 versionRangeParser digitParser csv = expr
   where
-    expr = do
-      P.spaces
-      t <- term
-      P.spaces
-      do
-        _ <- P.string "||"
-        checkOp
-        P.spaces
-        e <- expr
-        return (unionVersionRanges t e)
-        <|> return t
-    term = do
-      f <- factor
-      P.spaces
-      do
-        _ <- P.string "&&"
-        checkOp
-        P.spaces
-        t <- term
-        return (intersectVersionRanges f t)
-        <|> return f
+    expr =
+      (maybe <*> unionVersionRanges)
+        <$> (P.spaces *> term <* P.spaces)
+        <*> P.optional (P.string "||" *> checkOp *> P.spaces *> expr)
+    term =
+      (maybe <*> intersectVersionRanges)
+        <$> (factor <* P.spaces)
+        <*> P.optional (P.string "&&" *> checkOp *> P.spaces *> term)
     factor = parens expr <|> prim
 
     prim = do

Cabal-syntax/src/Distribution/Utils/MD5.hs

@@ -54,10 +54,7 @@ binaryPutMD5 (Fingerprint a b) = do
 
 -- | @since 3.2.0.0
 binaryGetMD5 :: Get MD5
-binaryGetMD5 = do
-  a <- getWord64le
-  b <- getWord64le
-  return (Fingerprint a b)
+binaryGetMD5 = Fingerprint <$> getWord64le <*> getWord64le
 
 -- |
 --

cabal-install/src/Distribution/Client/IndexUtils/ActiveRepos.hs

@@ -105,10 +105,7 @@ instance Parsec ActiveRepoEntry where
           "repo" -> P.char ':' *> leadRepo
           _ -> P.unexpected $ "Unknown active repository entry type: " ++ token
 
-      leadRepo = do
-        r <- parsec
-        s <- strategyP
-        return (ActiveRepo r s)
+      leadRepo = ActiveRepo <$> parsec <*> strategyP
 
       strategyP = P.option CombineStrategyMerge (P.char ':' *> parsec)
 

cabal-install/src/Distribution/Client/TargetSelector.hs

@@ -319,64 +319,15 @@ parseTargetString :: String -> Maybe TargetString
 parseTargetString =
   readPToMaybe parseTargetApprox
   where
+    colon = Parse.char ':'
     parseTargetApprox :: Parse.ReadP TargetString
     parseTargetApprox =
-      ( do
-          a <- tokenQEnd
-          return (TargetString1 a)
-      )
-        +++ ( do
-                a <- tokenQ0
-                _ <- Parse.char ':'
-                b <- tokenQEnd
-                return (TargetString2 a b)
-            )
-        +++ ( do
-                a <- tokenQ0
-                _ <- Parse.char ':'
-                b <- tokenQ
-                _ <- Parse.char ':'
-                c <- tokenQEnd
-                return (TargetString3 a b c)
-            )
-        +++ ( do
-                a <- tokenQ0
-                _ <- Parse.char ':'
-                b <- token
-                _ <- Parse.char ':'
-                c <- tokenQ
-                _ <- Parse.char ':'
-                d <- tokenQEnd
-                return (TargetString4 a b c d)
-            )
-        +++ ( do
-                a <- tokenQ0
-                _ <- Parse.char ':'
-                b <- token
-                _ <- Parse.char ':'
-                c <- tokenQ
-                _ <- Parse.char ':'
-                d <- tokenQ
-                _ <- Parse.char ':'
-                e <- tokenQEnd
-                return (TargetString5 a b c d e)
-            )
-        +++ ( do
-                a <- tokenQ0
-                _ <- Parse.char ':'
-                b <- token
-                _ <- Parse.char ':'
-                c <- tokenQ
-                _ <- Parse.char ':'
-                d <- tokenQ
-                _ <- Parse.char ':'
-                e <- tokenQ
-                _ <- Parse.char ':'
-                f <- tokenQ
-                _ <- Parse.char ':'
-                g <- tokenQEnd
-                return (TargetString7 a b c d e f g)
-            )
+      (TargetString1 <$> tokenQEnd)
+        +++ (TargetString2 <$> tokenQ0 <* colon <*> tokenQEnd)
+        +++ (TargetString3 <$> tokenQ0 <* colon <*> tokenQ <* colon <*> tokenQEnd)
+        +++ (TargetString4 <$> tokenQ0 <* colon <*> token <* colon <*> tokenQ <* colon <*> tokenQEnd)
+        +++ (TargetString5 <$> tokenQ0 <* colon <*> token <* colon <*> tokenQ <* colon <*> tokenQ <* colon <*> tokenQEnd)
+        +++ (TargetString7 <$> tokenQ0 <* colon <*> token <* colon <*> tokenQ <* colon <*> tokenQ <* colon <*> tokenQ <* colon <*> tokenQ <* colon <*> tokenQEnd)
 
     token = Parse.munch1 (\x -> not (isSpace x) && x /= ':')
     tokenQ = parseHaskellString <++ token