{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK prune #-}

-- |
-- A module that exports two functions, 'parse' and 'parse'',
-- to help with turning text into expression trees.
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 ()

-- | Represents signs.
data Sign = Positive | Negative
  deriving (Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
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
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 into either an error message or an expression.
parse :: Text -> Either Text Expr
parse :: Text -> Either Text Expr
parse = forall {c}. Either ParseError c -> Either Text c
textify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse Parses Expr
fullExpr String
""
  where
    textify :: Either ParseError c -> Either Text c
textify = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)

-- | Like 'parse', but assume the result is a valid expression and crash otherwise.
parse' :: Text -> Expr
parse' :: Text -> Expr
parse' Text
s = case Text -> Either Text Expr
parse Text
s of
  Left Text
e -> forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
"parse' crashed because: " 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
_ = forall a. HasCallStack => String -> a
error String
"should be guarded by parser"

-- | Parse an optional sign preceding a value.
sign :: Parses Sign
sign :: Parses Sign
sign =
  do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'; forall (m :: * -> *) a. Monad m => a -> m a
return Sign
Negative
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'; forall (m :: * -> *) a. Monad m => a -> m a
return Sign
Positive
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Sign
Positive

signToFunc :: Num a => Sign -> (a -> a)
signToFunc :: forall a. Num a => Sign -> a -> a
signToFunc Sign
Positive = forall a. a -> a
id
signToFunc Sign
Negative = forall a. Num a => a -> a
negate

-- | Parses at least 1 digit, as Text.
digits :: Parses Text
digits :: Parses Text
digits = String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

-- | Get the number of significant figures for a
-- non-negative integer if it was typed as text.
numSigFigsNNIntTextual :: Text -> Integer
numSigFigsNNIntTextual :: Text -> Integer
numSigFigsNNIntTextual Text
t =
  let residue :: Text
residue = (Char -> Bool) -> Text -> Text
T.dropAround (forall a. Eq a => a -> a -> Bool
== Char
'0') Text
t
   in forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
residue then Int
1 else Text -> Int
T.length Text
residue

-- | Get the number of significant figures for a
-- non-negative float if it was typed as text.
numSigFigsNNFltTextual :: Text -> Integer
numSigFigsNNFltTextual :: Text -> Integer
numSigFigsNNFltTextual Text
t =
  let residue :: Text
residue = (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'0') forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
/= Char
'.') forall a b. (a -> b) -> a -> b
$ Text
t
   in forall a. Integral a => a -> Integer
toInteger 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

-- | Parse an integer which may have a sign.
integer :: Parses Term
integer :: Parses Term
integer = do
  Sign
s <- Parses Sign
sign
  Text
digs <- Parses Text
digits
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> BigDecimal -> Term
Measured (Text -> Integer
numSigFigsNNIntTextual Text
digs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Sign -> a -> a
signToFunc Sign
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BigDecimal
BD.fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
digs

-- | Parse a float which may have a sign.
float :: Parses Term
float :: Parses Term
float = do
  Sign
s <- Parses Sign
sign
  Text
ldigs <- 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
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
  Text
rdigs <- 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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
ldigs Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
rdigs) (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 forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
rdigs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> BigDecimal -> Term
Measured (Text -> Integer
numSigFigsNNFltTextual Text
flt) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Sign -> a -> a
signToFunc Sign
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BigDecimal
BD.fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack 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) <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parses Term
float forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parses Term
integer
  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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> BigDecimal -> Term
Measured Integer
sf forall a b. (a -> b) -> a -> b
$ BigDecimal -> BigDecimal
BD.nf forall a b. (a -> b) -> a -> b
$ BigDecimal
coef forall a. Num a => a -> a -> a
* BigDecimal
10 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
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'c'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Term
Constant forall a b. (a -> b) -> a -> b
$ Integer
v 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
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'c'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Term
Constant forall a b. (a -> b) -> a -> b
$ Integer
v forall a. Integral a => a -> a -> Ratio a
% (Integer
10 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
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'c'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Term
Constant forall a b. (a -> b) -> a -> b
$ Integer
v forall a. Integral a => a -> a -> Ratio a
% (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Natural
s)

leaf :: Parses Expr
leaf :: Parses Expr
leaf = do
  Term
l <- forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try 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]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Expr
Leaf Term
l

exponent :: Parses Expr
exponent :: Parses Expr
exponent = do
  (Expr
base, Expr
e) <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try do
    Expr
base <- Parses Expr
operand
    String
op <- forall {u}. ParsecT Text u Identity String
operator
    Expr
e <- Parses Expr
operand
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
base, Expr
e)
  Integer
e' <- forall {s} {m :: * -> *} {t} {u}.
Stream s m t =>
Expr -> ParsecT s u m Integer
exprNNInt Expr
e
  [Integer]
exps <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many do
    String
op <- forall {u}. ParsecT Text u Identity String
operator
    Expr
term' <- Parses Expr
operand
    forall {s} {m :: * -> *} {t} {u}.
Stream s m t =>
Expr -> ParsecT s u m Integer
exprNNInt Expr
term'
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (forall a b c. (a -> b -> c) -> b -> a -> c
flip Expr -> Integer -> Expr
Exp) Expr
base (Integer
e' forall a. a -> [a] -> [a]
: [Integer]
exps)
  where
    operand :: Parses Expr
operand = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall a. Parses a -> Parses a
betweenParens Parses Expr
expr forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parses Expr
leaf] forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    operator :: ParsecT Text u Identity String
operator = forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"**" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 forall a. Eq a => a -> a -> Bool
== Natural
0 Bool -> Bool -> Bool
&& Integer
v forall a. Ord a => a -> a -> Bool
>= Integer
0 then forall a. a -> Maybe a
Just Integer
v else forall a. Maybe a
Nothing
    toNNInt (Constant Rational
a) =
      if forall a. Ratio a -> a
denominator Rational
a forall a. Eq a => a -> a -> Bool
== Integer
1 Bool -> Bool -> Bool
&& Rational
a forall a. Ord a => a -> a -> Bool
>= Rational
0 then forall a. a -> Maybe a
Just (forall a. Ratio a -> a
numerator Rational
a) else 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
n
      Expr
_ -> forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected String
"non-integer exponent"

-- exponent :: Parses Expr
-- exponent = do
--   e <- try do
--     k <- try (betweenParens expr) <|> try leaf
--     spaces
--     string "**"
--     spaces
--     return k
--   i <- toInteger . BD.value . BD.nf . value <$> try integer
--   when (i < 0) $ unexpected "negative exponent"
--   return $ Exp e i

-- | A list of all the functions available.
funcMap :: [(Function, Text)]
funcMap :: [(Function, Text)]
funcMap =
  [ (Function
Log10, Text
"log"),
    (Function
Antilog10, Text
"exp")
  ]

genFuncParsers :: [Parses Expr]
genFuncParsers :: [Parses Expr]
genFuncParsers = do
  (Function
f, Text
t) <- [(Function, Text)]
funcMap
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ do
    forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
    forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
    Expr
e <- Parses Expr
expr
    forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Function -> Expr -> Expr
Apply Function
f Expr
e

-- | Parses a function application.
function :: Parses Expr
function :: Parses Expr
function = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Parses Expr]
genFuncParsers

-- | Parses any expression.
expr :: Parses Expr
expr :: Parses Expr
expr =
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parses Expr
prec1Chain
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parses Expr
prec2Chain
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parses Expr
exponent
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall a. Parses a -> Parses a
betweenParens Parses Expr
expr)
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parses Expr
function
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parses Expr
leaf

-- | Parses a full expression.
fullExpr :: Parses Expr
fullExpr :: Parses Expr
fullExpr =
  forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
    [ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parses Expr
prec1Chain forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof,
      forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parses Expr
prec2Chain forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof,
      Parses Expr
exponent forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof,
      forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall a. Parses a -> Parses a
betweenParens Parses Expr
expr) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof,
      forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parses Expr
function forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof,
      Parses Expr
leaf forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
    ]

-- Generate a chain parser: necessary because sigfig-simplification
-- only occurs on completion of evaluation of such a chain.
precChain :: [Parses Expr] -> Parses Char -> ([(Op, Expr)] -> Expr) -> Op -> Parses Expr
precChain :: [Parses Expr]
-> Parses Char -> ([(Op, Expr)] -> Expr) -> Op -> Parses Expr
precChain [Parses Expr]
validOperands Parses Char
validOperator [(Op, Expr)] -> Expr
constructor Op
idOp =
  do
    Expr
term <- Parses Expr
operand
    Char
op <- Parses Char
operator
    Expr
term' <- Parses Expr
operand
    [(Op, Expr)] -> Parses Expr
rest [(Char -> Op
toOp Char
op, Expr
term'), (Op
idOp, Expr
term)]
  where
    operand :: Parses Expr
operand = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Parses Expr]
validOperands forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    operator :: Parses Char
operator = Parses Char
validOperator forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
    rest :: [(Op, Expr)] -> Parses Expr
rest [(Op, Expr)]
terms =
      do
        Char
op <- Parses Char
operator
        Expr
term' <- Parses Expr
operand
        [(Op, Expr)] -> Parses Expr
rest ((Char -> Op
toOp Char
op, Expr
term') forall a. a -> [a] -> [a]
: [(Op, Expr)]
terms)
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Op, Expr)] -> Expr
constructor forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [(Op, Expr)]
terms)

-- | Parse a precendence-2 chain (of both addition or subtraction)
prec1Chain :: Parses Expr
prec1Chain :: Parses Expr
prec1Chain =
  [Parses Expr]
-> Parses Char -> ([(Op, Expr)] -> Expr) -> Op -> Parses Expr
precChain
    [forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parses Expr
prec2Chain, Parses Expr
exponent, forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall a. Parses a -> Parses a
betweenParens Parses Expr
expr, Parses Expr
function, Parses Expr
leaf]
    (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"+-")
    [(Op, Expr)] -> Expr
Prec1
    Op
Add

-- | Parse a precendence-2 chain (of both multiplication or division)
prec2Chain :: Parses Expr
prec2Chain :: Parses Expr
prec2Chain =
  [Parses Expr]
-> Parses Char -> ([(Op, Expr)] -> Expr) -> Op -> Parses Expr
precChain
    [Parses Expr
exponent, forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall a. Parses a -> Parses a
betweenParens Parses Expr
expr, Parses Expr
function, Parses Expr
leaf]
    (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 :: forall a. Parses a -> Parses a
betweenParens Parses a
p = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parses a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'