From a8afb9046c0a235ad9130c7ecb0497d07d133267 Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Sat, 8 Nov 2025 16:05:42 +0100 Subject: [PATCH 1/2] Replace liftM and liftM2 with fmap and liftA2 respectivally. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit it's to solve build errors like these on ghc 9.8.4: ``` language-ecmascript> src/Language/ECMAScript3/Syntax.hs:327:21: error: [GHC-88464] language-ecmascript> Variable not in scope: language-ecmascript> liftM2 language-ecmascript> :: (Bool -> Bool -> Bool) language-ecmascript> -> State ([Label], [EnclosingStatement]) Bool language-ecmascript> -> State ([Label], [EnclosingStatement]) Bool language-ecmascript> -> State ([Label], [EnclosingStatement]) Bool language-ecmascript> Suggested fix: language-ecmascript> Perhaps use one of these: language-ecmascript> ‘liftA2’ (imported from Prelude), language-ecmascript> ‘lift’ (imported from Control.Monad.State), language-ecmascript> ‘liftIO’ (imported from Control.Monad.State) language-ecmascript> | language-ecmascript> 327 | IfStmt _ _ t e -> liftM2 (&&) (checkStmtM t) (checkStmtM e) language-ecmascript> | ^^^^^^ language-ecmascript> language-ecmascript> src/Language/ECMAScript3/Syntax.hs:329:37: error: [GHC-88464] language-ecmascript> Variable not in scope: language-ecmascript> liftM2 language-ecmascript> :: (Bool -> Bool -> Bool) language-ecmascript> -> State ([Label], [EnclosingStatement]) Bool language-ecmascript> -> a0 language-ecmascript> -> State ([Label], [EnclosingStatement]) Bool language-ecmascript> Suggested fix: language-ecmascript> Perhaps use one of these: language-ecmascript> ‘liftA2’ (imported from Prelude), language-ecmascript> ‘lift’ (imported from Control.Monad.State), language-ecmascript> ‘liftIO’ (imported from Control.Monad.State) language-ecmascript> | language-ecmascript> 329 | TryStmt _ body mcatch mfinally -> liftM2 (&&) (checkStmtM body) $ ``` --- src/Language/ECMAScript3/Parser.hs | 45 ++++++++++---------- src/Language/ECMAScript3/Syntax.hs | 12 +++--- src/Language/ECMAScript3/Syntax/Arbitrary.hs | 6 +-- 3 files changed, 31 insertions(+), 32 deletions(-) diff --git a/src/Language/ECMAScript3/Parser.hs b/src/Language/ECMAScript3/Parser.hs index 78100d84..8867906c 100644 --- a/src/Language/ECMAScript3/Parser.hs +++ b/src/Language/ECMAScript3/Parser.hs @@ -34,7 +34,6 @@ import Language.ECMAScript3.Syntax.Annotations import Data.Default.Class import Text.Parsec hiding (parse) import Text.Parsec.Expr -import Control.Monad(liftM,liftM2) import Control.Monad.Trans (MonadIO,liftIO) import Numeric(readDec,readOct,readHex, readFloat) import Data.Char @@ -98,7 +97,7 @@ withFreshLabelStack p = do oldState <- getState identifier :: Stream s Identity Char => Parser s (Id SourcePos) identifier = - liftM2 Id getPosition Lexer.identifier + liftA2 Id getPosition Lexer.identifier --{{{ Statements @@ -176,7 +175,7 @@ parseContinueStmt = do pos' <- getPosition -- Ensure that the identifier is on the same line as 'continue.' id <- if sourceLine pos == sourceLine pos' - then liftM Just identifier <|> return Nothing + then fmap Just identifier <|> return Nothing else return Nothing optional semi return $ ContinueStmt pos id @@ -188,7 +187,7 @@ parseBreakStmt = do pos' <- getPosition -- Ensure that the identifier is on the same line as 'break.' id <- if sourceLine pos == sourceLine pos' - then liftM Just identifier <|> return Nothing + then fmap Just identifier <|> return Nothing else return Nothing optional semi return $ BreakStmt pos id @@ -228,8 +227,8 @@ parseExpressionStmt = do parseForInStmt:: Stream s Identity Char => StatementParser s parseForInStmt = - let parseInit = (reserved "var" >> liftM ForInVar identifier) - <|> liftM ForInLVal lvalue + let parseInit = (reserved "var" >> fmap ForInVar identifier) + <|> fmap ForInLVal lvalue in do pos <- getPosition -- Lookahead, so that we don't clash with parseForStmt (init,expr) <- try $ do reserved "for" @@ -242,8 +241,8 @@ parseForInStmt = parseForStmt:: Stream s Identity Char => StatementParser s parseForStmt = - let parseInit = (reserved "var" >> liftM VarInit (parseVarDecl `sepBy` comma)) - <|> liftM ExprInit parseListExpr + let parseInit = (reserved "var" >> fmap VarInit (parseVarDecl `sepBy` comma)) + <|> fmap ExprInit parseListExpr <|> return NoInit in do pos <- getPosition reserved "for" @@ -304,7 +303,7 @@ parseVarDecl :: Stream s Identity Char => Parser s (VarDecl SourcePos) parseVarDecl = do pos <- getPosition id <- identifier - init <- (reservedOp "=" >> liftM Just assignExpr) <|> return Nothing + init <- (reservedOp "=" >> fmap Just assignExpr) <|> return Nothing return (VarDecl pos id init) parseVarDeclStmt:: Stream s Identity Char => StatementParser s @@ -380,10 +379,10 @@ parseBoolLit = do parseTrueLit <|> parseFalseLit parseVarRef:: Stream s Identity Char => ExpressionParser s -parseVarRef = liftM2 VarRef getPosition identifier +parseVarRef = liftA2 VarRef getPosition identifier parseArrayLit:: Stream s Identity Char => ExpressionParser s -parseArrayLit = liftM2 ArrayLit getPosition (squares (assignExpr `sepEndBy` comma)) +parseArrayLit = liftA2 ArrayLit getPosition (squares (assignExpr `sepEndBy` comma)) parseFuncExpr :: Stream s Identity Char => ExpressionParser s parseFuncExpr = do @@ -420,7 +419,7 @@ parseAsciiHexChar = do parseUnicodeHexChar :: Stream s Identity Char => Parser s Char parseUnicodeHexChar = do char 'u' - liftM (chr.fst.head.readHex) + fmap (chr.fst.head.readHex) (sequence [hexDigit,hexDigit,hexDigit,hexDigit]) isWhitespace ch = ch `elem` " \t" @@ -440,7 +439,7 @@ parseStringLit' endWith = if c == '\r' || c == '\n' then return (c:dropWhile isWhitespace cs) else return (c:cs)) <|> - liftM2 (:) anyChar (parseStringLit' endWith) + liftA2 (:) anyChar (parseStringLit' endWith) parseStringLit:: Stream s Identity Char => ExpressionParser s parseStringLit = do @@ -471,7 +470,7 @@ parseRegexpLit = do ch <- anyChar -- TODO: too lenient rest <- parseRe return ('\\':ch:rest)) <|> - liftM2 (:) anyChar parseRe + liftA2 (:) anyChar parseRe pos <- getPosition char '/' notFollowedBy $ char '/' @@ -486,9 +485,9 @@ parseObjectLit = -- Parses a string, identifier or integer as the property name. I -- apologize for the abstruse style, but it really does make the code -- much shorter. - name <- liftM (\(StringLit p s) -> PropString p s) parseStringLit - <|> liftM2 PropId getPosition identifier - <|> liftM2 PropNum getPosition (parseNumber >>= toInt) + name <- fmap (\(StringLit p s) -> PropString p s) parseStringLit + <|> liftA2 PropId getPosition identifier + <|> liftA2 PropNum getPosition (parseNumber >>= toInt) colon val <- assignExpr return (name,val) @@ -679,16 +678,16 @@ unaryAssignExpr = do p <- getPosition let prefixInc = do reservedOp "++" - liftM (UnaryAssignExpr p PrefixInc) lvalue + fmap (UnaryAssignExpr p PrefixInc) lvalue let prefixDec = do reservedOp "--" - liftM (UnaryAssignExpr p PrefixDec) lvalue + fmap (UnaryAssignExpr p PrefixDec) lvalue let postfixInc e = do reservedOp "++" - liftM (UnaryAssignExpr p PostfixInc) (asLValue p e) + fmap (UnaryAssignExpr p PostfixInc) (asLValue p e) let postfixDec e = do reservedOp "--" - liftM (UnaryAssignExpr p PostfixDec) (asLValue p e) + fmap (UnaryAssignExpr p PostfixDec) (asLValue p e) let other = do e <- parseSimpleExpr Nothing postfixInc e <|> postfixDec e <|> return e @@ -748,12 +747,12 @@ parseListExpr :: Stream s Identity Char => ExpressionParser s parseListExpr = assignExpr `sepBy1` comma >>= \exprs -> case exprs of [expr] -> return expr - es -> liftM2 ListExpr getPosition (return es) + es -> liftA2 ListExpr getPosition (return es) parseScript:: Stream s Identity Char => Parser s (JavaScript SourcePos) parseScript = do whiteSpace - liftM2 Script getPosition (parseStatement `sepBy` whiteSpace) + liftA2 Script getPosition (parseStatement `sepBy` whiteSpace) -- | A parser that parses an ECMAScript program. program :: Stream s Identity Char => Parser s (JavaScript SourcePos) diff --git a/src/Language/ECMAScript3/Syntax.hs b/src/Language/ECMAScript3/Syntax.hs index 680c9433..69c4e4e7 100644 --- a/src/Language/ECMAScript3/Syntax.hs +++ b/src/Language/ECMAScript3/Syntax.hs @@ -323,12 +323,12 @@ checkStmtM stmt = case stmt of DoWhileStmt _ s _ -> iterCommon s ForStmt _ _ _ _ s -> iterCommon s ForInStmt _ _ _ s -> iterCommon s - SwitchStmt _ _ cs -> pushEnclosing EnclosingSwitch $ liftM and $ mapM checkCaseM cs - BlockStmt _ ss -> pushEnclosing EnclosingOther $ liftM and $ mapM checkStmtM ss - IfStmt _ _ t e -> liftM2 (&&) (checkStmtM t) (checkStmtM e) + SwitchStmt _ _ cs -> pushEnclosing EnclosingSwitch $ fmap and $ mapM checkCaseM cs + BlockStmt _ ss -> pushEnclosing EnclosingOther $ fmap and $ mapM checkStmtM ss + IfStmt _ _ t e -> liftA2 (&&) (checkStmtM t) (checkStmtM e) IfSingleStmt _ _ t -> checkStmtM t - TryStmt _ body mcatch mfinally -> liftM2 (&&) (checkStmtM body) $ - liftM2 (&&) (maybe (return True) checkCatchM mcatch) + TryStmt _ body mcatch mfinally -> liftA2 (&&) (checkStmtM body) $ + liftA2 (&&) (maybe (return True) checkCatchM mcatch) (maybe (return True) checkStmtM mfinally) WithStmt _ _ body -> checkStmtM body _ -> return True @@ -347,7 +347,7 @@ pushLabel l = bracketState (first (unId l:)) checkCaseM c = let ss = case c of CaseClause _ _ body -> body CaseDefault _ body -> body - in liftM and $ mapM checkStmtM ss + in fmap and $ mapM checkStmtM ss checkCatchM (CatchClause _ _ body) = checkStmtM body diff --git a/src/Language/ECMAScript3/Syntax/Arbitrary.hs b/src/Language/ECMAScript3/Syntax/Arbitrary.hs index 09f686cd..50b236e4 100644 --- a/src/Language/ECMAScript3/Syntax/Arbitrary.hs +++ b/src/Language/ECMAScript3/Syntax/Arbitrary.hs @@ -192,7 +192,7 @@ instance (Data a) => Fixable (JavaScript a) where :: Statement a -> Gen (Statement a)) >=>transformBiM (return . fixLValue :: LValue a -> Gen (LValue a)) - >=>(\(Script a ss)-> liftM (Script a) $ fixBreakContinue ss) + >=>(\(Script a ss)-> fmap (Script a) $ fixBreakContinue ss) instance (Data a) => Fixable (Expression a) where fixUp = (fixUpFunExpr . transformBi (identifierFixup :: Id a -> Id a)) @@ -269,7 +269,7 @@ fixLValue lv = case lv of fixUpFunExpr :: (Data a) => Expression a -> Gen (Expression a) fixUpFunExpr e = case e of - FuncExpr a mid params body -> liftM (FuncExpr a mid params) $ fixBreakContinue body + FuncExpr a mid params body -> fmap (FuncExpr a mid params) $ fixBreakContinue body _ -> return e fixUpListExpr :: (Data a) => Expression a -> Gen (Expression a) @@ -279,7 +279,7 @@ fixUpListExpr e = case e of fixUpFunStmt :: (Data a) => Statement a -> Gen (Statement a) fixUpFunStmt s = case s of - FunctionStmt a id params body -> liftM (FunctionStmt a id params) $ fixBreakContinue body + FunctionStmt a id params body -> fmap (FunctionStmt a id params) $ fixBreakContinue body _ -> return s identifierFixup :: Id a -> Id a From 13094125fe9029cf235edfe28078ab78c3fcb134 Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Sat, 8 Nov 2025 16:11:01 +0100 Subject: [PATCH 2/2] bump bounds --- language-ecmascript.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/language-ecmascript.cabal b/language-ecmascript.cabal index 0119be2f..d07021ac 100644 --- a/language-ecmascript.cabal +++ b/language-ecmascript.cabal @@ -35,16 +35,16 @@ Library Hs-Source-Dirs: src Build-Depends: - base >= 4 && < 4.19, + base >= 4 && < 4.23, mtl >= 1 && < 3, parsec > 3 && < 3.2.0, - ansi-wl-pprint >= 0.6 && < 1, + ansi-wl-pprint >= 0.6 && < 2, containers == 0.*, uniplate >= 1.6 && <1.7, data-default-class >= 0.0.1 && < 0.2, QuickCheck >= 2.5 && < 3, template-haskell >= 2.7 && < 3, - Diff == 0.4.*, + Diff < 1.1.0, charset >= 0.3 ghc-options: -fwarn-incomplete-patterns