{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK prune #-}
module Data.SigFig.Parse
( parse,
parse',
)
where
import Control.Monad (when)
import Data.Bifunctor (first)
import Data.BigDecimal (BigDecimal (BigDecimal))
import Data.BigDecimal qualified as BD
import Data.Foldable (foldr')
import Data.Ratio (denominator, numerator)
import Data.SigFig.Types
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Real (Ratio ((:%)), (%))
import Text.Parsec hiding (parse)
import Text.Parsec qualified as P
import Prelude hiding (exponent)
type Parses = Parsec Text ()
data Sign = Positive | Negative
deriving (Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
(Int -> Sign -> ShowS)
-> (Sign -> String) -> ([Sign] -> ShowS) -> Show Sign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sign] -> ShowS
$cshowList :: [Sign] -> ShowS
show :: Sign -> String
$cshow :: Sign -> String
showsPrec :: Int -> Sign -> ShowS
$cshowsPrec :: Int -> Sign -> ShowS
Show, Sign -> Sign -> Bool
(Sign -> Sign -> Bool) -> (Sign -> Sign -> Bool) -> Eq Sign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sign -> Sign -> Bool
$c/= :: Sign -> Sign -> Bool
== :: Sign -> Sign -> Bool
$c== :: Sign -> Sign -> Bool
Eq)
parse :: Text -> Either Text Expr
parse :: Text -> Either Text Expr
parse = Either ParseError Expr -> Either Text Expr
forall c. Either ParseError c -> Either Text c
textify (Either ParseError Expr -> Either Text Expr)
-> (Text -> Either ParseError Expr) -> Text -> Either Text Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Text () Expr -> String -> Text -> Either ParseError Expr
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse Parsec Text () Expr
fullExpr String
""
where
textify :: Either ParseError c -> Either Text c
textify = (ParseError -> Text) -> Either ParseError c -> Either Text c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
T.pack (String -> Text) -> (ParseError -> String) -> ParseError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show)
parse' :: Text -> Expr
parse' :: Text -> Expr
parse' Text
s = case Text -> Either Text Expr
parse Text
s of
Left Text
e -> String -> Expr
forall a. HasCallStack => String -> a
error (String -> Expr) -> (Text -> String) -> Text -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ Text
"parse' crashed because: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
Right Expr
e -> Expr
e
toOp :: Char -> Op
toOp :: Char -> Op
toOp Char
'+' = Op
Add
toOp Char
'-' = Op
Sub
toOp Char
'*' = Op
Mul
toOp Char
'/' = Op
Div
toOp Char
_ = String -> Op
forall a. HasCallStack => String -> a
error String
"should be guarded by parser"
sign :: Parses Sign
sign :: Parses Sign
sign =
do Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'; Sign -> Parses Sign
forall (m :: * -> *) a. Monad m => a -> m a
return Sign
Negative
Parses Sign -> Parses Sign -> Parses Sign
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'; Sign -> Parses Sign
forall (m :: * -> *) a. Monad m => a -> m a
return Sign
Positive
Parses Sign -> Parses Sign -> Parses Sign
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Sign -> Parses Sign
forall (m :: * -> *) a. Monad m => a -> m a
return Sign
Positive
signToFunc :: Num a => Sign -> (a -> a)
signToFunc :: Sign -> a -> a
signToFunc Sign
Positive = a -> a
forall a. a -> a
id
signToFunc Sign
Negative = a -> a
forall a. Num a => a -> a
negate
digits :: Parses Text
digits :: Parses Text
digits = String -> Text
T.pack (String -> Text) -> ParsecT Text () Identity String -> Parses Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
numSigFigsNNIntTextual :: Text -> Integer
numSigFigsNNIntTextual :: Text -> Integer
numSigFigsNNIntTextual Text
t =
let residue :: Text
residue = (Char -> Bool) -> Text -> Text
T.dropAround (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0') Text
t
in Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
residue then Int
1 else Text -> Int
T.length Text
residue
numSigFigsNNFltTextual :: Text -> Integer
numSigFigsNNFltTextual :: Text -> Integer
numSigFigsNNFltTextual Text
t =
let residue :: Text
residue = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
t
in Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
residue then Text -> Text -> Int
T.count Text
"0" Text
t else Text -> Int
T.length Text
residue
integer :: Parses Term
integer :: Parses Term
integer = do
Sign
s <- Parses Sign
sign
Text
digs <- Parses Text
digits
Term -> Parses Term
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> Parses Term) -> (Text -> Term) -> Text -> Parses Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> BigDecimal -> Term
Measured (Text -> Integer
numSigFigsNNIntTextual Text
digs) (BigDecimal -> Term) -> (Text -> BigDecimal) -> Text -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sign -> BigDecimal -> BigDecimal
forall a. Num a => Sign -> a -> a
signToFunc Sign
s (BigDecimal -> BigDecimal)
-> (Text -> BigDecimal) -> Text -> BigDecimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BigDecimal
BD.fromString (String -> BigDecimal) -> (Text -> String) -> Text -> BigDecimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Parses Term) -> Text -> Parses Term
forall a b. (a -> b) -> a -> b
$ Text
digs
float :: Parses Term
float :: Parses Term
float = do
Sign
s <- Parses Sign
sign
Text
ldigs <- Text -> Parses Text -> Parses Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" Parses Text
digits
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
Text
rdigs <- Text -> Parses Text -> Parses Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" Parses Text
digits
Bool -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
ldigs Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
rdigs) (String -> ParsecT Text () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected String
"dot without other digits")
let flt :: Text
flt = Text
ldigs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rdigs
Term -> Parses Term
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> Parses Term) -> (Text -> Term) -> Text -> Parses Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> BigDecimal -> Term
Measured (Text -> Integer
numSigFigsNNFltTextual Text
flt) (BigDecimal -> Term) -> (Text -> BigDecimal) -> Text -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sign -> BigDecimal -> BigDecimal
forall a. Num a => Sign -> a -> a
signToFunc Sign
s (BigDecimal -> BigDecimal)
-> (Text -> BigDecimal) -> Text -> BigDecimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BigDecimal
BD.fromString (String -> BigDecimal) -> (Text -> String) -> Text -> BigDecimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Parses Term) -> Text -> Parses Term
forall a b. (a -> b) -> a -> b
$ Text
flt
sciNotation :: Parses Term
sciNotation :: Parses Term
sciNotation = do
Measured Integer
sf coef :: BigDecimal
coef@(BigDecimal Integer
coefValue Natural
coefScale) <- Parses Term -> Parses Term
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parses Term
float Parses Term -> Parses Term -> Parses Term
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parses Term -> Parses Term
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parses Term
integer
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e'
Measured Integer
_ (BigDecimal Integer
exp Natural
_) <- Parses Term
integer
Term -> Parses Term
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> Parses Term) -> Term -> Parses Term
forall a b. (a -> b) -> a -> b
$ Integer -> BigDecimal -> Term
Measured Integer
sf (BigDecimal -> Term) -> BigDecimal -> Term
forall a b. (a -> b) -> a -> b
$ BigDecimal -> BigDecimal
BD.nf (BigDecimal -> BigDecimal) -> BigDecimal -> BigDecimal
forall a b. (a -> b) -> a -> b
$ BigDecimal
coef BigDecimal -> BigDecimal -> BigDecimal
forall a. Num a => a -> a -> a
* BigDecimal
10 BigDecimal -> Integer -> BigDecimal
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ Integer
exp
integerConstant :: Parses Term
integerConstant :: Parses Term
integerConstant = do
Measured Integer
_ (BigDecimal Integer
v Natural
_) <- Parses Term
integer
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'c'
Term -> Parses Term
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> Parses Term)
-> (Rational -> Term) -> Rational -> Parses Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Term
Constant (Rational -> Parses Term) -> Rational -> Parses Term
forall a b. (a -> b) -> a -> b
$ Integer
v Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1
floatConstant :: Parses Term
floatConstant :: Parses Term
floatConstant = do
Measured Integer
_ (BigDecimal Integer
v Natural
s) <- Parses Term
float
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'c'
Term -> Parses Term
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> Parses Term)
-> (Rational -> Term) -> Rational -> Parses Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Term
Constant (Rational -> Parses Term) -> Rational -> Parses Term
forall a b. (a -> b) -> a -> b
$ Integer
v Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10 Integer -> Natural -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Natural
s)
sciNotationConstant :: Parses Term
sciNotationConstant :: Parses Term
sciNotationConstant = do
Measured Integer
_ (BigDecimal Integer
v Natural
s) <- Parses Term
sciNotation
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'c'
Term -> Parses Term
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> Parses Term)
-> (Rational -> Term) -> Rational -> Parses Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Term
Constant (Rational -> Parses Term) -> Rational -> Parses Term
forall a b. (a -> b) -> a -> b
$ Integer
v Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10 Integer -> Natural -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Natural
s)
leaf :: Parses Expr
leaf :: Parsec Text () Expr
leaf = do
Term
l <- [Parses Term] -> Parses Term
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([Parses Term] -> Parses Term) -> [Parses Term] -> Parses Term
forall a b. (a -> b) -> a -> b
$ Parses Term -> Parses Term
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parses Term -> Parses Term) -> [Parses Term] -> [Parses Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parses Term
sciNotationConstant, Parses Term
floatConstant, Parses Term
integerConstant, Parses Term
sciNotation, Parses Term
float, Parses Term
integer]
Expr -> Parsec Text () Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Parsec Text () Expr) -> Expr -> Parsec Text () Expr
forall a b. (a -> b) -> a -> b
$ Term -> Expr
Leaf Term
l
exponent :: Parses Expr
exponent :: Parsec Text () Expr
exponent = do
(Expr
base, Expr
e) <- ParsecT Text () Identity (Expr, Expr)
-> ParsecT Text () Identity (Expr, Expr)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try do
Expr
base <- Parsec Text () Expr
operand
String
op <- ParsecT Text () Identity String
forall u. ParsecT Text u Identity String
operator
Expr
e <- Parsec Text () Expr
operand
(Expr, Expr) -> ParsecT Text () Identity (Expr, Expr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
base, Expr
e)
Integer
e' <- Expr -> ParsecT Text () Identity Integer
forall s (m :: * -> *) t u.
Stream s m t =>
Expr -> ParsecT s u m Integer
exprNNInt Expr
e
[Integer]
exps <- ParsecT Text () Identity Integer
-> ParsecT Text () Identity [Integer]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many do
String
op <- ParsecT Text () Identity String
forall u. ParsecT Text u Identity String
operator
Expr
term' <- Parsec Text () Expr
operand
Expr -> ParsecT Text () Identity Integer
forall s (m :: * -> *) t u.
Stream s m t =>
Expr -> ParsecT s u m Integer
exprNNInt Expr
term'
Expr -> Parsec Text () Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> Parsec Text () Expr) -> Expr -> Parsec Text () Expr
forall a b. (a -> b) -> a -> b
$ (Integer -> Expr -> Expr) -> Expr -> [Integer] -> Expr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' ((Expr -> Integer -> Expr) -> Integer -> Expr -> Expr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Expr -> Integer -> Expr
Exp) Expr
base (Integer
e' Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
exps)
where
operand :: Parsec Text () Expr
operand = [Parsec Text () Expr] -> Parsec Text () Expr
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec Text () Expr -> Parsec Text () Expr)
-> Parsec Text () Expr -> Parsec Text () Expr
forall a b. (a -> b) -> a -> b
$ Parsec Text () Expr -> Parsec Text () Expr
forall a. Parses a -> Parses a
betweenParens Parsec Text () Expr
expr Parsec Text () Expr -> Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () Expr
leaf] Parsec Text () Expr
-> ParsecT Text () Identity () -> Parsec Text () Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
operator :: ParsecT Text u Identity String
operator = String -> ParsecT Text u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"**" ParsecT Text u Identity String
-> ParsecT Text u Identity () -> ParsecT Text u Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text u Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
toNNInt :: Term -> Maybe Integer
toNNInt (Measured Integer
sf (BigDecimal Integer
v Natural
s)) =
if Natural
s Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0 Bool -> Bool -> Bool
&& Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 then Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
v else Maybe Integer
forall a. Maybe a
Nothing
toNNInt (Constant Rational
a) =
if Rational -> Integer
forall a. Ratio a -> a
denominator Rational
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Bool -> Bool -> Bool
&& Rational
a Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
0 then Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
a) else Maybe Integer
forall a. Maybe a
Nothing
exprNNInt :: Expr -> ParsecT s u m Integer
exprNNInt Expr
e = case Expr
e of
Leaf Term
k | Just Integer
n <- Term -> Maybe Integer
toNNInt Term
k -> Integer -> ParsecT s u m Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
n
Expr
_ -> String -> ParsecT s u m Integer
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected String
"non-integer exponent"
funcMap :: [(Function, Text)]
funcMap :: [(Function, Text)]
funcMap =
[ (Function
Log10, Text
"log"),
(Function
Antilog10, Text
"exp")
]
genFuncParsers :: [Parses Expr]
genFuncParsers :: [Parsec Text () Expr]
genFuncParsers = do
(Function
f, Text
t) <- [(Function, Text)]
funcMap
Parsec Text () Expr -> [Parsec Text () Expr]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parsec Text () Expr -> [Parsec Text () Expr])
-> Parsec Text () Expr -> [Parsec Text () Expr]
forall a b. (a -> b) -> a -> b
$ do
String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (String -> ParsecT Text () Identity String)
-> String -> ParsecT Text () Identity String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
Expr
e <- Parsec Text () Expr
expr
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
Expr -> Parsec Text () Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> Parsec Text () Expr) -> Expr -> Parsec Text () Expr
forall a b. (a -> b) -> a -> b
$ Function -> Expr -> Expr
Apply Function
f Expr
e
function :: Parses Expr
function :: Parsec Text () Expr
function = [Parsec Text () Expr] -> Parsec Text () Expr
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Parsec Text () Expr]
genFuncParsers
expr :: Parses Expr
expr :: Parsec Text () Expr
expr =
Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () Expr
prec1Chain
Parsec Text () Expr -> Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () Expr
prec2Chain
Parsec Text () Expr -> Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () Expr
exponent
Parsec Text () Expr -> Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec Text () Expr -> Parsec Text () Expr
forall a. Parses a -> Parses a
betweenParens Parsec Text () Expr
expr)
Parsec Text () Expr -> Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () Expr
function
Parsec Text () Expr -> Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () Expr
leaf
fullExpr :: Parses Expr
fullExpr :: Parsec Text () Expr
fullExpr =
[Parsec Text () Expr] -> Parsec Text () Expr
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
[ Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () Expr
prec1Chain Parsec Text () Expr
-> ParsecT Text () Identity () -> Parsec Text () Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof,
Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () Expr
prec2Chain Parsec Text () Expr
-> ParsecT Text () Identity () -> Parsec Text () Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof,
Parsec Text () Expr
exponent Parsec Text () Expr
-> ParsecT Text () Identity () -> Parsec Text () Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof,
Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec Text () Expr -> Parsec Text () Expr
forall a. Parses a -> Parses a
betweenParens Parsec Text () Expr
expr) Parsec Text () Expr
-> ParsecT Text () Identity () -> Parsec Text () Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof,
Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () Expr
function Parsec Text () Expr
-> ParsecT Text () Identity () -> Parsec Text () Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof,
Parsec Text () Expr
leaf Parsec Text () Expr
-> ParsecT Text () Identity () -> Parsec Text () Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
]
precChain :: [Parses Expr] -> Parses Char -> ([(Op, Expr)] -> Expr) -> Op -> Parses Expr
precChain :: [Parsec Text () Expr]
-> ParsecT Text () Identity Char
-> ([(Op, Expr)] -> Expr)
-> Op
-> Parsec Text () Expr
precChain [Parsec Text () Expr]
validOperands ParsecT Text () Identity Char
validOperator [(Op, Expr)] -> Expr
constructor Op
idOp =
do
Expr
term <- Parsec Text () Expr
operand
Char
op <- ParsecT Text () Identity Char
operator
Expr
term' <- Parsec Text () Expr
operand
[(Op, Expr)] -> Parsec Text () Expr
rest [(Char -> Op
toOp Char
op, Expr
term'), (Op
idOp, Expr
term)]
where
operand :: Parsec Text () Expr
operand = [Parsec Text () Expr] -> Parsec Text () Expr
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Parsec Text () Expr]
validOperands Parsec Text () Expr
-> ParsecT Text () Identity () -> Parsec Text () Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
operator :: ParsecT Text () Identity Char
operator = ParsecT Text () Identity Char
validOperator ParsecT Text () Identity Char
-> ParsecT Text () Identity () -> ParsecT Text () Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
rest :: [(Op, Expr)] -> Parsec Text () Expr
rest [(Op, Expr)]
terms =
do
Char
op <- ParsecT Text () Identity Char
operator
Expr
term' <- Parsec Text () Expr
operand
[(Op, Expr)] -> Parsec Text () Expr
rest ((Char -> Op
toOp Char
op, Expr
term') (Op, Expr) -> [(Op, Expr)] -> [(Op, Expr)]
forall a. a -> [a] -> [a]
: [(Op, Expr)]
terms)
Parsec Text () Expr -> Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Expr -> Parsec Text () Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> Parsec Text () Expr)
-> ([(Op, Expr)] -> Expr) -> [(Op, Expr)] -> Parsec Text () Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Op, Expr)] -> Expr
constructor ([(Op, Expr)] -> Parsec Text () Expr)
-> [(Op, Expr)] -> Parsec Text () Expr
forall a b. (a -> b) -> a -> b
$ [(Op, Expr)] -> [(Op, Expr)]
forall a. [a] -> [a]
reverse [(Op, Expr)]
terms)
prec1Chain :: Parses Expr
prec1Chain :: Parsec Text () Expr
prec1Chain =
[Parsec Text () Expr]
-> ParsecT Text () Identity Char
-> ([(Op, Expr)] -> Expr)
-> Op
-> Parsec Text () Expr
precChain
[Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () Expr
prec2Chain, Parsec Text () Expr
exponent, Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec Text () Expr -> Parsec Text () Expr)
-> Parsec Text () Expr -> Parsec Text () Expr
forall a b. (a -> b) -> a -> b
$ Parsec Text () Expr -> Parsec Text () Expr
forall a. Parses a -> Parses a
betweenParens Parsec Text () Expr
expr, Parsec Text () Expr
function, Parsec Text () Expr
leaf]
(String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"+-")
[(Op, Expr)] -> Expr
Prec1
Op
Add
prec2Chain :: Parses Expr
prec2Chain :: Parsec Text () Expr
prec2Chain =
[Parsec Text () Expr]
-> ParsecT Text () Identity Char
-> ([(Op, Expr)] -> Expr)
-> Op
-> Parsec Text () Expr
precChain
[Parsec Text () Expr
exponent, Parsec Text () Expr -> Parsec Text () Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec Text () Expr -> Parsec Text () Expr)
-> Parsec Text () Expr -> Parsec Text () Expr
forall a b. (a -> b) -> a -> b
$ Parsec Text () Expr -> Parsec Text () Expr
forall a. Parses a -> Parses a
betweenParens Parsec Text () Expr
expr, Parsec Text () Expr
function, Parsec Text () Expr
leaf]
(String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"*/")
[(Op, Expr)] -> Expr
Prec2
Op
Mul
betweenParens :: Parses a -> Parses a
betweenParens :: Parses a -> Parses a
betweenParens Parses a
p = Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT Text () Identity Char
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text () Identity () -> Parses a -> Parses a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parses a
p Parses a -> ParsecT Text () Identity () -> Parses a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces Parses a -> ParsecT Text () Identity Char -> Parses a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'