Ran a Language server on my old code
This commit is contained in:
parent
64967afb9b
commit
38ed3f1be8
4 changed files with 51 additions and 28 deletions
|
@ -34,6 +34,7 @@ main = ioLoop initVars
|
||||||
precision = 5 :: Int
|
precision = 5 :: Int
|
||||||
|
|
||||||
showRatio :: Int -> Rational -> String
|
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 "")
|
showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ (if (length postpoint_digits > 0) then ("." ++ postpoint_digits) else "")
|
||||||
where
|
where
|
||||||
prepoint_digits = init . show . round . abs $ (r * 10)
|
prepoint_digits = init . show . round . abs $ (r * 10)
|
||||||
|
|
64
src/Lib.hs
64
src/Lib.hs
|
@ -18,26 +18,46 @@
|
||||||
module Lib
|
module Lib
|
||||||
( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions, updateVariables, parseFullString
|
( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions, updateVariables, parseFullString
|
||||||
) where
|
) where
|
||||||
import Control.Applicative((<*))
|
|
||||||
|
|
||||||
import Data.Ratio
|
import Data.Functor.Identity
|
||||||
|
|
||||||
|
import Data.Ratio ( (%), denominator, numerator )
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
import Text.Parsec
|
import Text.Parsec
|
||||||
import Text.Parsec.Char
|
( alphaNum,
|
||||||
import Text.Parsec.String
|
char,
|
||||||
|
digit,
|
||||||
|
letter,
|
||||||
|
oneOf,
|
||||||
|
eof,
|
||||||
|
notFollowedBy,
|
||||||
|
(<?>),
|
||||||
|
(<|>),
|
||||||
|
many1,
|
||||||
|
parse,
|
||||||
|
try,
|
||||||
|
ParseError,
|
||||||
|
ParsecT )
|
||||||
|
import Text.Parsec.Char ()
|
||||||
|
import Text.Parsec.String ( Parser )
|
||||||
import Text.Parsec.Expr
|
import Text.Parsec.Expr
|
||||||
|
( buildExpressionParser, Assoc(AssocLeft), Operator(Infix) )
|
||||||
import Text.Parsec.Token
|
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
|
data Expr = Variable String | Constant Rational | Binary BinaryOperator Expr Expr | VariableDefinition String Expr
|
||||||
deriving Show
|
deriving Show
|
||||||
data BinaryOperator = Plus | Minus | Multiply | Divide | Power
|
data BinaryOperator = Plus | Minus | Multiply | Divide | Power
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
naturalRatio a = a % 1
|
def :: Monad m => GenLanguageDef String u m
|
||||||
|
|
||||||
def = emptyDef{ commentStart = ""
|
def = emptyDef{ commentStart = ""
|
||||||
, commentEnd = ""
|
, commentEnd = ""
|
||||||
, identStart = letter <|> char '_'
|
, identStart = letter <|> char '_'
|
||||||
|
@ -48,20 +68,26 @@ def = emptyDef{ commentStart = ""
|
||||||
, reservedNames = []
|
, 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
|
TokenParser{ parens = m_parens
|
||||||
, identifier = m_identifier
|
, identifier = m_identifier
|
||||||
, reservedOp = m_reservedOp
|
, reservedOp = m_reservedOp
|
||||||
, reserved = m_reserved
|
|
||||||
, semiSep1 = m_semiSep1
|
|
||||||
, natural = m_natural
|
, natural = m_natural
|
||||||
, integer = m_integer
|
, integer = m_integer
|
||||||
, whiteSpace = m_whiteSpace } = makeTokenParser def
|
, whiteSpace = m_whiteSpace } = makeTokenParser def
|
||||||
|
|
||||||
|
parseFullString :: String -> Either ParseError Expr
|
||||||
parseFullString s = parse (m_whiteSpace *> exprparser <* eof) "<stdin>" s
|
parseFullString s = parse (m_whiteSpace *> exprparser <* eof) "<stdin>" s
|
||||||
|
|
||||||
exprparser :: Parser Expr
|
exprparser :: Parser Expr
|
||||||
exprparser = buildExpressionParser table term <?> "expression"
|
exprparser = buildExpressionParser table term <?> "expression"
|
||||||
|
|
||||||
|
table :: [[Operator String u Identity Expr]]
|
||||||
table = [
|
table = [
|
||||||
[
|
[
|
||||||
Infix (m_reservedOp "^" >> return (Binary Power)) AssocLeft,
|
Infix (m_reservedOp "^" >> return (Binary Power)) AssocLeft,
|
||||||
|
@ -94,7 +120,6 @@ constantRational = do
|
||||||
decimal_digits <- many1 digit
|
decimal_digits <- many1 digit
|
||||||
_ <- m_whiteSpace
|
_ <- m_whiteSpace
|
||||||
let decimal = read decimal_digits :: Integer
|
let decimal = read decimal_digits :: Integer
|
||||||
let natural_length = length . show $ natural
|
|
||||||
let decimal_length = length decimal_digits
|
let decimal_length = length decimal_digits
|
||||||
let numerator = natural * (10 ^ decimal_length) + decimal
|
let numerator = natural * (10 ^ decimal_length) + decimal
|
||||||
let denominator = 10 ^ decimal_length
|
let denominator = 10 ^ decimal_length
|
||||||
|
@ -108,6 +133,7 @@ variableDefinition = try (do
|
||||||
return (VariableDefinition name value)
|
return (VariableDefinition name value)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
term :: ParsecT String () Identity Expr
|
||||||
term = m_parens exprparser
|
term = m_parens exprparser
|
||||||
<|> variableDefinition
|
<|> variableDefinition
|
||||||
<|> fmap Variable m_identifier
|
<|> fmap Variable m_identifier
|
||||||
|
@ -121,7 +147,7 @@ extractVariableDefinitions (Constant _) = []
|
||||||
extractVariableDefinitions (Variable _) = []
|
extractVariableDefinitions (Variable _) = []
|
||||||
|
|
||||||
updateVariables :: [(String, Expr)] -> Map String Rational -> Either String (Map String Rational)
|
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 :: Either String (Map String Rational) -> (String, Expr) -> Either String (Map String Rational)
|
||||||
updateVariable (Left e) _ = Left e
|
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 :: Expr -> Map.Map String Rational -> Either String Expr
|
||||||
replaceVars (Constant c) vs = Right $ Constant c
|
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 (VariableDefinition name _) vs = replaceVars (Variable name) vs
|
||||||
replaceVars (Binary op l r) vs = case leftBranch of
|
replaceVars (Binary op l r) vs = do
|
||||||
Left s -> Left s
|
leftBranch <- replaceVars l vs
|
||||||
Right a -> case rightBranch of
|
rightBranch <- replaceVars r vs
|
||||||
Left s -> Left s
|
pure $ Binary op leftBranch rightBranch
|
||||||
Right b -> Right $ Binary op a b
|
|
||||||
where
|
|
||||||
leftBranch = replaceVars l vs
|
|
||||||
rightBranch = replaceVars r vs
|
|
||||||
|
|
||||||
{-
|
{-
|
||||||
- a/b ^ c/d
|
- a/b ^ c/d
|
||||||
|
|
|
@ -17,8 +17,7 @@
|
||||||
#
|
#
|
||||||
# resolver: ./custom-snapshot.yaml
|
# resolver: ./custom-snapshot.yaml
|
||||||
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
||||||
resolver:
|
resolver: nightly-2025-07-04
|
||||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/34.yaml
|
|
||||||
|
|
||||||
# User packages to be built.
|
# User packages to be built.
|
||||||
# Various formats can be used as shown in the example below.
|
# Various formats can be used as shown in the example below.
|
||||||
|
|
|
@ -1,13 +1,12 @@
|
||||||
# This file was autogenerated by Stack.
|
# This file was autogenerated by Stack.
|
||||||
# You should not edit this file by hand.
|
# You should not edit this file by hand.
|
||||||
# For more information, please see the documentation at:
|
# 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: []
|
packages: []
|
||||||
snapshots:
|
snapshots:
|
||||||
- completed:
|
- completed:
|
||||||
sha256: edbd50d7e7c85c13ad5f5835ae2db92fab1e9cf05ecf85340e2622ec0a303df1
|
sha256: f519f0130813ac275982b1a378f4ffd38680394a98ce27c76341e7f7e94ee0a8
|
||||||
size: 720020
|
size: 722616
|
||||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/34.yaml
|
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2025/7/4.yaml
|
||||||
original:
|
original: nightly-2025-07-04
|
||||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/34.yaml
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue