From 38ed3f1be8ea0e607337677d479343998e2bce28 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Fri, 4 Jul 2025 10:06:45 +0200 Subject: [PATCH] Ran a Language server on my old code --- app/Main.hs | 1 + src/Lib.hs | 64 +++++++++++++++++++++++++++++++++---------------- stack.yaml | 3 +-- stack.yaml.lock | 11 ++++----- 4 files changed, 51 insertions(+), 28 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index b2288e2..679b41b 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -34,6 +34,7 @@ main = ioLoop initVars precision = 5 :: Int showRatio :: Int -> Rational -> String +showRatio _ 0 = "0" showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ (if (length postpoint_digits > 0) then ("." ++ postpoint_digits) else "") where prepoint_digits = init . show . round . abs $ (r * 10) diff --git a/src/Lib.hs b/src/Lib.hs index 5c8e2e7..2fbca20 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -18,26 +18,46 @@ module Lib ( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions, updateVariables, parseFullString ) where -import Control.Applicative((<*)) -import Data.Ratio +import Data.Functor.Identity + +import Data.Ratio ( (%), denominator, numerator ) import Data.Map (Map) import qualified Data.Map as Map import Text.Parsec -import Text.Parsec.Char -import Text.Parsec.String + ( alphaNum, + char, + digit, + letter, + oneOf, + eof, + notFollowedBy, + (), + (<|>), + many1, + parse, + try, + ParseError, + ParsecT ) +import Text.Parsec.Char () +import Text.Parsec.String ( Parser ) import Text.Parsec.Expr + ( buildExpressionParser, Assoc(AssocLeft), Operator(Infix) ) import Text.Parsec.Token -import Text.Parsec.Language + ( makeTokenParser, + GenLanguageDef(reservedNames, commentStart, commentEnd, identStart, + identLetter, opStart, opLetter, reservedOpNames), + GenTokenParser(whiteSpace, TokenParser, parens, identifier, + reservedOp, natural, integer) ) +import Text.Parsec.Language ( emptyDef ) data Expr = Variable String | Constant Rational | Binary BinaryOperator Expr Expr | VariableDefinition String Expr deriving Show data BinaryOperator = Plus | Minus | Multiply | Divide | Power deriving Show -naturalRatio a = a % 1 - +def :: Monad m => GenLanguageDef String u m def = emptyDef{ commentStart = "" , commentEnd = "" , identStart = letter <|> char '_' @@ -48,20 +68,26 @@ def = emptyDef{ commentStart = "" , reservedNames = [] } +m_parens :: ParsecT String u Identity a -> ParsecT String u Identity a +m_identifier :: ParsecT String u Identity String +m_whiteSpace :: ParsecT String u Identity () +m_reservedOp :: String -> ParsecT String u Identity () +m_natural :: ParsecT String u Identity Integer +m_integer :: ParsecT String u Identity Integer TokenParser{ parens = m_parens , identifier = m_identifier , reservedOp = m_reservedOp - , reserved = m_reserved - , semiSep1 = m_semiSep1 , natural = m_natural , integer = m_integer , whiteSpace = m_whiteSpace } = makeTokenParser def +parseFullString :: String -> Either ParseError Expr parseFullString s = parse (m_whiteSpace *> exprparser <* eof) "" s exprparser :: Parser Expr exprparser = buildExpressionParser table term "expression" +table :: [[Operator String u Identity Expr]] table = [ [ Infix (m_reservedOp "^" >> return (Binary Power)) AssocLeft, @@ -94,7 +120,6 @@ constantRational = do decimal_digits <- many1 digit _ <- m_whiteSpace let decimal = read decimal_digits :: Integer - let natural_length = length . show $ natural let decimal_length = length decimal_digits let numerator = natural * (10 ^ decimal_length) + decimal let denominator = 10 ^ decimal_length @@ -108,6 +133,7 @@ variableDefinition = try (do return (VariableDefinition name value) ) +term :: ParsecT String () Identity Expr term = m_parens exprparser <|> variableDefinition <|> fmap Variable m_identifier @@ -121,7 +147,7 @@ extractVariableDefinitions (Constant _) = [] extractVariableDefinitions (Variable _) = [] updateVariables :: [(String, Expr)] -> Map String Rational -> Either String (Map String Rational) -updateVariables ds vs = foldl updateVariable (Right vs) ds +updateVariables ds vs = foldl' updateVariable (Right vs) ds updateVariable :: Either String (Map String Rational) -> (String, Expr) -> Either String (Map String Rational) updateVariable (Left e) _ = Left e @@ -135,16 +161,14 @@ updateVariable (Right vs) (name, e) = case updateVariables nvs vs of replaceVars :: Expr -> Map.Map String Rational -> Either String Expr replaceVars (Constant c) vs = Right $ Constant c -replaceVars (Variable name) vs = maybe (Left ("Usage of unknown variable: '" ++ name ++ "'\nSuggestion: define the variable\n++ " ++ name ++ "=42")) (Right . Constant . id) $ Map.lookup name vs +replaceVars (Variable name) vs = case Map.lookup name vs of + Just value -> Right $ Constant value + Nothing -> Left ("Usage of unknown variable: '" ++ name ++ "'\nSuggestion: define the variable\n++ " ++ name ++ "=42") replaceVars (VariableDefinition name _) vs = replaceVars (Variable name) vs -replaceVars (Binary op l r) vs = case leftBranch of - Left s -> Left s - Right a -> case rightBranch of - Left s -> Left s - Right b -> Right $ Binary op a b - where - leftBranch = replaceVars l vs - rightBranch = replaceVars r vs +replaceVars (Binary op l r) vs = do + leftBranch <- replaceVars l vs + rightBranch <- replaceVars r vs + pure $ Binary op leftBranch rightBranch {- - a/b ^ c/d diff --git a/stack.yaml b/stack.yaml index 5f5e6a9..601020f 100644 --- a/stack.yaml +++ b/stack.yaml @@ -17,8 +17,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/34.yaml +resolver: nightly-2025-07-04 # User packages to be built. # Various formats can be used as shown in the example below. diff --git a/stack.yaml.lock b/stack.yaml.lock index e60110a..42ad879 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -1,13 +1,12 @@ # This file was autogenerated by Stack. # You should not edit this file by hand. # For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files +# https://docs.haskellstack.org/en/stable/topics/lock_files packages: [] snapshots: - completed: - sha256: edbd50d7e7c85c13ad5f5835ae2db92fab1e9cf05ecf85340e2622ec0a303df1 - size: 720020 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/34.yaml - original: - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/34.yaml + sha256: f519f0130813ac275982b1a378f4ffd38680394a98ce27c76341e7f7e94ee0a8 + size: 722616 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2025/7/4.yaml + original: nightly-2025-07-04