{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Data.Derivation.Parse (
	-- * PARSE CONSTRAINT
	parseConstraint, Var ) where

import Control.Applicative (empty, (<|>), many)
import Control.Arrow (second)
import Data.Function ((&))
import Data.Maybe (listToMaybe)
import Data.List (uncons, unfoldr)
import Data.Char (isDigit, isLower)
import Data.Parse (Parse, parse, unparse, (>>!))
import Data.Derivation.Expression (Exp(..), ExpType(..))

import qualified Data.Bool as B (bool)

---------------------------------------------------------------------------

-- * PARSE CONSTRAINT
-- * MEMO
-- * GRAMMAR
-- * PICK AND CHECK

---------------------------------------------------------------------------
-- PARSE CONSTRAINT
---------------------------------------------------------------------------

parseConstraint :: String -> Maybe (Exp Var 'Boolean)
parseConstraint :: String -> Maybe (Exp String 'Boolean)
parseConstraint = ((Exp String 'Boolean, Memo) -> Exp String 'Boolean
forall a b. (a, b) -> a
fst ((Exp String 'Boolean, Memo) -> Exp String 'Boolean)
-> Maybe (Exp String 'Boolean, Memo) -> Maybe (Exp String 'Boolean)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe (Exp String 'Boolean, Memo) -> Maybe (Exp String 'Boolean))
-> (String -> Maybe (Exp String 'Boolean, Memo))
-> String
-> Maybe (Exp String 'Boolean)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Memo -> Maybe (Exp String 'Boolean, Memo)
constraint (Memo -> Maybe (Exp String 'Boolean, Memo))
-> (String -> Memo) -> String -> Maybe (Exp String 'Boolean, Memo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Memo
memo ([String] -> Memo) -> (String -> [String]) -> String -> Memo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe (String, String)) -> String -> [String]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr ([(String, String)] -> Maybe (String, String)
forall a. [a] -> Maybe a
listToMaybe ([(String, String)] -> Maybe (String, String))
-> (String -> [(String, String)])
-> String
-> Maybe (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(String, String)]
lex)

---------------------------------------------------------------------------
-- MEMO
---------------------------------------------------------------------------

data Memo = Memo {
	Memo -> Maybe (Exp String 'Boolean, Memo)
constraint, Memo -> Maybe (Exp String 'Boolean, Memo)
equal, Memo -> Maybe (Exp String 'Boolean, Memo)
bool, Memo -> Maybe (Exp String 'Boolean, Memo)
lessEqual :: M (Exp Var 'Boolean),
	Memo -> M (Exp String 'Number)
polynomial, Memo -> M (Exp String 'Number)
number :: M (Exp Var 'Number), Memo -> M String
token :: M String }

type M a = Maybe (a, Memo); type Var = String

memo :: [String] -> Memo
memo :: [String] -> Memo
memo [String]
ts = Memo
m where
	m :: Memo
m = Maybe (Exp String 'Boolean, Memo)
-> Maybe (Exp String 'Boolean, Memo)
-> Maybe (Exp String 'Boolean, Memo)
-> Maybe (Exp String 'Boolean, Memo)
-> M (Exp String 'Number)
-> M (Exp String 'Number)
-> M String
-> Memo
Memo Maybe (Exp String 'Boolean, Memo)
ct Maybe (Exp String 'Boolean, Memo)
eq Maybe (Exp String 'Boolean, Memo)
bl Maybe (Exp String 'Boolean, Memo)
le M (Exp String 'Number)
pl M (Exp String 'Number)
nm M String
tk
	ct :: Maybe (Exp String 'Boolean, Memo)
ct = Parse Memo (Exp String 'Boolean)
pConstraint Parse Memo (Exp String 'Boolean)
-> Memo -> Maybe (Exp String 'Boolean, Memo)
forall s a. Parse s a -> s -> Maybe (a, s)
`unparse` Memo
m
	eq :: Maybe (Exp String 'Boolean, Memo)
eq = Parse Memo (Exp String 'Boolean)
pEqual Parse Memo (Exp String 'Boolean)
-> Memo -> Maybe (Exp String 'Boolean, Memo)
forall s a. Parse s a -> s -> Maybe (a, s)
`unparse` Memo
m
	bl :: Maybe (Exp String 'Boolean, Memo)
bl = Parse Memo (Exp String 'Boolean)
pBool Parse Memo (Exp String 'Boolean)
-> Memo -> Maybe (Exp String 'Boolean, Memo)
forall s a. Parse s a -> s -> Maybe (a, s)
`unparse` Memo
m
	le :: Maybe (Exp String 'Boolean, Memo)
le = Parse Memo (Exp String 'Boolean)
pLessEqual Parse Memo (Exp String 'Boolean)
-> Memo -> Maybe (Exp String 'Boolean, Memo)
forall s a. Parse s a -> s -> Maybe (a, s)
`unparse` Memo
m
	pl :: M (Exp String 'Number)
pl = Parse Memo (Exp String 'Number)
pPolynomial Parse Memo (Exp String 'Number) -> Memo -> M (Exp String 'Number)
forall s a. Parse s a -> s -> Maybe (a, s)
`unparse` Memo
m
	nm :: M (Exp String 'Number)
nm = Parse Memo (Exp String 'Number)
pNumber Parse Memo (Exp String 'Number) -> Memo -> M (Exp String 'Number)
forall s a. Parse s a -> s -> Maybe (a, s)
`unparse` Memo
m
	tk :: M String
tk = ([String] -> Memo
memo ([String] -> Memo) -> (String, [String]) -> (String, Memo)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
`second`) ((String, [String]) -> (String, Memo))
-> Maybe (String, [String]) -> M String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Maybe (String, [String])
forall a. [a] -> Maybe (a, [a])
uncons [String]
ts

---------------------------------------------------------------------------
-- GRAMMAR
---------------------------------------------------------------------------

-- Constraint <- Equal / LessEqual
-- Equal <-
--	var "==" var !("+" / "-" / "<=") /
--	var "==" Polynomial !"<=" /
--	var "==" Bool /
--	Polynomial "==" Polynomial /
--	Bool "==" Bool
-- Bool <- LessEqual / "F" / "T" / var
-- LessEqual <- Polynomial "<=" Polynomial
-- Polynomial <- Number ("+" Number / "-" Number)*
-- Number <- <digit string> / var / "(" Polynomial ")"

pConstraint :: Parse Memo (Exp Var 'Boolean)
pConstraint :: Parse Memo (Exp String 'Boolean)
pConstraint = (Memo -> Maybe (Exp String 'Boolean, Memo))
-> Parse Memo (Exp String 'Boolean)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> Maybe (Exp String 'Boolean, Memo)
equal Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Memo -> Maybe (Exp String 'Boolean, Memo))
-> Parse Memo (Exp String 'Boolean)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> Maybe (Exp String 'Boolean, Memo)
lessEqual

pEqual :: Parse Memo (Exp Var 'Boolean)
pEqual :: Parse Memo (Exp String 'Boolean)
pEqual =
	Exp String Any -> Exp String Any -> Exp String 'Boolean
forall v (t :: ExpType). Exp v t -> Exp v t -> Exp v 'Boolean
(:==) (Exp String Any -> Exp String Any -> Exp String 'Boolean)
-> StateT Memo Maybe (Exp String Any)
-> StateT Memo Maybe (Exp String Any -> Exp String 'Boolean)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Memo Maybe (Exp String Any)
forall (t :: ExpType). Parse Memo (Exp String t)
var StateT Memo Maybe (Exp String Any -> Exp String 'Boolean)
-> StateT Memo Maybe String
-> StateT Memo Maybe (Exp String Any -> Exp String 'Boolean)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> StateT Memo Maybe String
pick String
"==" StateT Memo Maybe (Exp String Any -> Exp String 'Boolean)
-> StateT Memo Maybe (Exp String Any)
-> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Memo Maybe (Exp String Any)
forall (t :: ExpType). Parse Memo (Exp String t)
var
		StateT Memo Maybe (Exp String Any)
-> StateT Memo Maybe String -> StateT Memo Maybe (Exp String Any)
forall s a b. Parse s a -> Parse s b -> Parse s a
>>! (String -> StateT Memo Maybe String
pick String
"+" StateT Memo Maybe String
-> StateT Memo Maybe String -> StateT Memo Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> StateT Memo Maybe String
pick String
"-" StateT Memo Maybe String
-> StateT Memo Maybe String -> StateT Memo Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> StateT Memo Maybe String
pick String
"<=") Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
	Exp String 'Number -> Exp String 'Number -> Exp String 'Boolean
forall v (t :: ExpType). Exp v t -> Exp v t -> Exp v 'Boolean
(:==) (Exp String 'Number -> Exp String 'Number -> Exp String 'Boolean)
-> Parse Memo (Exp String 'Number)
-> StateT Memo Maybe (Exp String 'Number -> Exp String 'Boolean)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse Memo (Exp String 'Number)
forall (t :: ExpType). Parse Memo (Exp String t)
var StateT Memo Maybe (Exp String 'Number -> Exp String 'Boolean)
-> StateT Memo Maybe String
-> StateT Memo Maybe (Exp String 'Number -> Exp String 'Boolean)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> StateT Memo Maybe String
pick String
"==" StateT Memo Maybe (Exp String 'Number -> Exp String 'Boolean)
-> Parse Memo (Exp String 'Number)
-> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Memo -> M (Exp String 'Number)) -> Parse Memo (Exp String 'Number)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> M (Exp String 'Number)
polynomial Parse Memo (Exp String 'Number)
-> StateT Memo Maybe String -> Parse Memo (Exp String 'Number)
forall s a b. Parse s a -> Parse s b -> Parse s a
>>! String -> StateT Memo Maybe String
pick String
"<=" Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
	Exp String 'Boolean -> Exp String 'Boolean -> Exp String 'Boolean
forall v (t :: ExpType). Exp v t -> Exp v t -> Exp v 'Boolean
(:==) (Exp String 'Boolean -> Exp String 'Boolean -> Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
-> StateT Memo Maybe (Exp String 'Boolean -> Exp String 'Boolean)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parse Memo (Exp String 'Boolean)
forall (t :: ExpType). Parse Memo (Exp String t)
var StateT Memo Maybe (Exp String 'Boolean -> Exp String 'Boolean)
-> StateT Memo Maybe String
-> StateT Memo Maybe (Exp String 'Boolean -> Exp String 'Boolean)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> StateT Memo Maybe String
pick String
"==" StateT Memo Maybe (Exp String 'Boolean -> Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Memo -> Maybe (Exp String 'Boolean, Memo))
-> Parse Memo (Exp String 'Boolean)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> Maybe (Exp String 'Boolean, Memo)
bool Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
	Exp String 'Number -> Exp String 'Number -> Exp String 'Boolean
forall v (t :: ExpType). Exp v t -> Exp v t -> Exp v 'Boolean
(:==) (Exp String 'Number -> Exp String 'Number -> Exp String 'Boolean)
-> Parse Memo (Exp String 'Number)
-> StateT Memo Maybe (Exp String 'Number -> Exp String 'Boolean)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Memo -> M (Exp String 'Number)) -> Parse Memo (Exp String 'Number)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> M (Exp String 'Number)
polynomial StateT Memo Maybe (Exp String 'Number -> Exp String 'Boolean)
-> StateT Memo Maybe String
-> StateT Memo Maybe (Exp String 'Number -> Exp String 'Boolean)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> StateT Memo Maybe String
pick String
"==" StateT Memo Maybe (Exp String 'Number -> Exp String 'Boolean)
-> Parse Memo (Exp String 'Number)
-> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Memo -> M (Exp String 'Number)) -> Parse Memo (Exp String 'Number)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> M (Exp String 'Number)
polynomial Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
	Exp String 'Boolean -> Exp String 'Boolean -> Exp String 'Boolean
forall v (t :: ExpType). Exp v t -> Exp v t -> Exp v 'Boolean
(:==) (Exp String 'Boolean -> Exp String 'Boolean -> Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
-> StateT Memo Maybe (Exp String 'Boolean -> Exp String 'Boolean)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Memo -> Maybe (Exp String 'Boolean, Memo))
-> Parse Memo (Exp String 'Boolean)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> Maybe (Exp String 'Boolean, Memo)
bool StateT Memo Maybe (Exp String 'Boolean -> Exp String 'Boolean)
-> StateT Memo Maybe String
-> StateT Memo Maybe (Exp String 'Boolean -> Exp String 'Boolean)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> StateT Memo Maybe String
pick String
"==" StateT Memo Maybe (Exp String 'Boolean -> Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Memo -> Maybe (Exp String 'Boolean, Memo))
-> Parse Memo (Exp String 'Boolean)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> Maybe (Exp String 'Boolean, Memo)
bool

pBool :: Parse Memo (Exp Var 'Boolean)
pBool :: Parse Memo (Exp String 'Boolean)
pBool =	(Memo -> Maybe (Exp String 'Boolean, Memo))
-> Parse Memo (Exp String 'Boolean)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> Maybe (Exp String 'Boolean, Memo)
lessEqual Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
	Bool -> Exp String 'Boolean
forall v. Bool -> Exp v 'Boolean
Bool Bool
False Exp String 'Boolean
-> StateT Memo Maybe String -> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> StateT Memo Maybe String
pick String
"F" Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Exp String 'Boolean
forall v. Bool -> Exp v 'Boolean
Bool Bool
True Exp String 'Boolean
-> StateT Memo Maybe String -> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> StateT Memo Maybe String
pick String
"T" Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
-> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse Memo (Exp String 'Boolean)
forall (t :: ExpType). Parse Memo (Exp String t)
var

pLessEqual :: Parse Memo (Exp Var 'Boolean)
pLessEqual :: Parse Memo (Exp String 'Boolean)
pLessEqual = Exp String 'Number -> Exp String 'Number -> Exp String 'Boolean
forall v. Exp v 'Number -> Exp v 'Number -> Exp v 'Boolean
(:<=) (Exp String 'Number -> Exp String 'Number -> Exp String 'Boolean)
-> Parse Memo (Exp String 'Number)
-> StateT Memo Maybe (Exp String 'Number -> Exp String 'Boolean)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Memo -> M (Exp String 'Number)) -> Parse Memo (Exp String 'Number)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> M (Exp String 'Number)
polynomial StateT Memo Maybe (Exp String 'Number -> Exp String 'Boolean)
-> StateT Memo Maybe String
-> StateT Memo Maybe (Exp String 'Number -> Exp String 'Boolean)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> StateT Memo Maybe String
pick String
"<=" StateT Memo Maybe (Exp String 'Number -> Exp String 'Boolean)
-> Parse Memo (Exp String 'Number)
-> Parse Memo (Exp String 'Boolean)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Memo -> M (Exp String 'Number)) -> Parse Memo (Exp String 'Number)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> M (Exp String 'Number)
polynomial

pPolynomial :: Parse Memo (Exp Var 'Number)
pPolynomial :: Parse Memo (Exp String 'Number)
pPolynomial = (Exp String 'Number
 -> (Exp String 'Number -> Exp String 'Number)
 -> Exp String 'Number)
-> Exp String 'Number
-> [Exp String 'Number -> Exp String 'Number]
-> Exp String 'Number
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Exp String 'Number
-> (Exp String 'Number -> Exp String 'Number) -> Exp String 'Number
forall a b. a -> (a -> b) -> b
(&) (Exp String 'Number
 -> [Exp String 'Number -> Exp String 'Number]
 -> Exp String 'Number)
-> Parse Memo (Exp String 'Number)
-> StateT
     Memo
     Maybe
     ([Exp String 'Number -> Exp String 'Number] -> Exp String 'Number)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Memo -> M (Exp String 'Number)) -> Parse Memo (Exp String 'Number)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> M (Exp String 'Number)
number StateT
  Memo
  Maybe
  ([Exp String 'Number -> Exp String 'Number] -> Exp String 'Number)
-> StateT Memo Maybe [Exp String 'Number -> Exp String 'Number]
-> Parse Memo (Exp String 'Number)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT Memo Maybe (Exp String 'Number -> Exp String 'Number)
-> StateT Memo Maybe [Exp String 'Number -> Exp String 'Number]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (
	(Exp String 'Number -> Exp String 'Number -> Exp String 'Number)
-> Exp String 'Number -> Exp String 'Number -> Exp String 'Number
forall a b c. (a -> b -> c) -> b -> a -> c
flip Exp String 'Number -> Exp String 'Number -> Exp String 'Number
forall v. Exp v 'Number -> Exp v 'Number -> Exp v 'Number
(:+) (Exp String 'Number -> Exp String 'Number -> Exp String 'Number)
-> Parse Memo (Exp String 'Number)
-> StateT Memo Maybe (Exp String 'Number -> Exp String 'Number)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> StateT Memo Maybe String
pick String
"+" StateT Memo Maybe String
-> Parse Memo (Exp String 'Number)
-> Parse Memo (Exp String 'Number)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Memo -> M (Exp String 'Number)) -> Parse Memo (Exp String 'Number)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> M (Exp String 'Number)
number) StateT Memo Maybe (Exp String 'Number -> Exp String 'Number)
-> StateT Memo Maybe (Exp String 'Number -> Exp String 'Number)
-> StateT Memo Maybe (Exp String 'Number -> Exp String 'Number)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
	(Exp String 'Number -> Exp String 'Number -> Exp String 'Number)
-> Exp String 'Number -> Exp String 'Number -> Exp String 'Number
forall a b c. (a -> b -> c) -> b -> a -> c
flip Exp String 'Number -> Exp String 'Number -> Exp String 'Number
forall v. Exp v 'Number -> Exp v 'Number -> Exp v 'Number
(:-) (Exp String 'Number -> Exp String 'Number -> Exp String 'Number)
-> Parse Memo (Exp String 'Number)
-> StateT Memo Maybe (Exp String 'Number -> Exp String 'Number)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> StateT Memo Maybe String
pick String
"-" StateT Memo Maybe String
-> Parse Memo (Exp String 'Number)
-> Parse Memo (Exp String 'Number)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Memo -> M (Exp String 'Number)) -> Parse Memo (Exp String 'Number)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> M (Exp String 'Number)
number) )

pNumber :: Parse Memo (Exp Var 'Number)
pNumber :: Parse Memo (Exp String 'Number)
pNumber = Integer -> Exp String 'Number
forall v. Integer -> Exp v 'Number
Const (Integer -> Exp String 'Number)
-> (String -> Integer) -> String -> Exp String 'Number
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Integer
forall a. Read a => String -> a
read (String -> Exp String 'Number)
-> StateT Memo Maybe String -> Parse Memo (Exp String 'Number)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Bool) -> StateT Memo Maybe String
check ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit) Parse Memo (Exp String 'Number)
-> Parse Memo (Exp String 'Number)
-> Parse Memo (Exp String 'Number)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parse Memo (Exp String 'Number)
forall (t :: ExpType). Parse Memo (Exp String t)
var Parse Memo (Exp String 'Number)
-> Parse Memo (Exp String 'Number)
-> Parse Memo (Exp String 'Number)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
	String -> StateT Memo Maybe String
pick String
"(" StateT Memo Maybe String
-> Parse Memo (Exp String 'Number)
-> Parse Memo (Exp String 'Number)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Memo -> M (Exp String 'Number)) -> Parse Memo (Exp String 'Number)
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> M (Exp String 'Number)
polynomial Parse Memo (Exp String 'Number)
-> StateT Memo Maybe String -> Parse Memo (Exp String 'Number)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> StateT Memo Maybe String
pick String
")"

var :: Parse Memo (Exp Var t)
var :: Parse Memo (Exp String t)
var = String -> Exp String t
forall v (t :: ExpType). v -> Exp v t
Var (String -> Exp String t)
-> StateT Memo Maybe String -> Parse Memo (Exp String t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Bool) -> StateT Memo Maybe String
check ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isLower)

---------------------------------------------------------------------------
-- PICK AND CHECK
---------------------------------------------------------------------------

pick :: String -> Parse Memo String
pick :: String -> StateT Memo Maybe String
pick = (String -> Bool) -> StateT Memo Maybe String
check ((String -> Bool) -> StateT Memo Maybe String)
-> (String -> String -> Bool) -> String -> StateT Memo Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==)

check :: (String -> Bool) -> Parse Memo String
check :: (String -> Bool) -> StateT Memo Maybe String
check String -> Bool
p = (Memo -> M String) -> StateT Memo Maybe String
forall s a. (s -> Maybe (a, s)) -> Parse s a
parse Memo -> M String
token StateT Memo Maybe String
-> (String -> StateT Memo Maybe String) -> StateT Memo Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StateT Memo Maybe String
-> StateT Memo Maybe String -> Bool -> StateT Memo Maybe String
forall a. a -> a -> Bool -> a
B.bool StateT Memo Maybe String
forall (f :: * -> *) a. Alternative f => f a
empty (StateT Memo Maybe String -> Bool -> StateT Memo Maybe String)
-> (String -> StateT Memo Maybe String)
-> String
-> Bool
-> StateT Memo Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> StateT Memo Maybe String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Bool -> StateT Memo Maybe String)
-> (String -> Bool) -> String -> StateT Memo Maybe String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Bool
p