{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoMonomorphismRestriction #-} module Algebra.Ring.Polynomial.Parser ( unlabeldVarP, labeledVarP, polynomialP, rationalP, integerP, parsePolynomialWith, Parser, VariableParser, ) where import Algebra.Internal import Algebra.Ring.Polynomial.Class import Algebra.Ring.Polynomial.Monomial import AlgebraicPrelude hiding (char) import Control.Arrow (left) import Control.Monad.Combinators.Expr import qualified Data.List.NonEmpty as NE import qualified Data.Ratio as P #if MIN_VERSION_singletons(3,0,0) import Data.List.Singletons #else import Data.Singletons.Prelude.List #endif import qualified Data.Text as T import Data.Void import GHC.TypeLits (Symbol) import Text.Megaparsec import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L import qualified Prelude as P lexeme :: (MonadParsec e T.Text m) => m a -> m a lexeme :: m a -> m a lexeme = m () -> m a -> m a forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a L.lexeme m () forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m () space symbol :: (MonadParsec e T.Text m) => T.Text -> m T.Text symbol :: Text -> m Text symbol = m () -> Tokens Text -> m (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => m () -> Tokens s -> m (Tokens s) L.symbol m () forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m () space type Parser = Parsec Void T.Text type VariableParser n = Parser (Ordinal n) unlabeldVarP :: (KnownNat n) => proxy n -> T.Text -> VariableParser n unlabeldVarP :: proxy n -> Text -> VariableParser n unlabeldVarP proxy n pxy Text pfx = VariableParser n -> VariableParser n forall e (m :: * -> *) a. MonadParsec e Text m => m a -> m a lexeme (VariableParser n -> VariableParser n) -> VariableParser n -> VariableParser n forall a b. (a -> b) -> a -> b $ do Natural i <- Text -> ParsecT Void Text Identity Text forall e (m :: * -> *). MonadParsec e Text m => Text -> m Text symbol Text pfx ParsecT Void Text Identity Text -> ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Token Text -> ParsecT Void Text Identity (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '_' ParsecT Void Text Identity Char -> ParsecT Void Text Identity Natural -> ParsecT Void Text Identity Natural forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ParsecT Void Text Identity Natural forall e s (m :: * -> *) a. (MonadParsec e s m, Token s ~ Char, Num a) => m a L.decimal case Natural -> Maybe (Ordinal n) forall (n :: Nat). KnownNat n => Natural -> Maybe (Ordinal n) naturalToOrd Natural i of Just Ordinal n o -> Ordinal n -> VariableParser n forall (m :: * -> *) a. Monad m => a -> m a return Ordinal n o Maybe (Ordinal n) Nothing -> String -> VariableParser n forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> VariableParser n) -> String -> VariableParser n forall a b. (a -> b) -> a -> b $ String "Number " String -> String -> String forall w. Monoid w => w -> w -> w ++ Natural -> String forall a. Show a => a -> String show Natural i String -> String -> String forall w. Monoid w => w -> w -> w ++ String " is out of bound: " String -> String -> String forall w. Monoid w => w -> w -> w ++ Natural -> String forall a. Show a => a -> String show (proxy n -> Natural forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Natural natVal proxy n pxy) fromSingList :: Sing (list :: [Symbol]) -> [T.Text] #if MIN_VERSION_singletons(2,3,0) fromSingList :: Sing list -> [Text] fromSingList = Sing list -> [Text] forall k (a :: k). SingKind k => Sing a -> Demote k fromSing #else fromSingList = map T.pack . fromSing #endif labeledVarP :: forall list. Sing (list :: [Symbol]) -> VariableParser (Length list) labeledVarP :: Sing list -> VariableParser (Length list) labeledVarP Sing list slist = [ParsecT Void Text Identity (Ordinal (Length list))] -> ParsecT Void Text Identity (Ordinal (Length list)) forall (f :: * -> *) (m :: * -> *) a. (Foldable f, Alternative m) => f (m a) -> m a choice ([ParsecT Void Text Identity (Ordinal (Length list))] -> ParsecT Void Text Identity (Ordinal (Length list))) -> [ParsecT Void Text Identity (Ordinal (Length list))] -> ParsecT Void Text Identity (Ordinal (Length list)) forall a b. (a -> b) -> a -> b $ (Ordinal (Length list) -> Text -> ParsecT Void Text Identity (Ordinal (Length list))) -> [Ordinal (Length list)] -> [Text] -> [ParsecT Void Text Identity (Ordinal (Length list))] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith Ordinal (Length list) -> Text -> ParsecT Void Text Identity (Ordinal (Length list)) forall (f :: * -> *) e a. MonadParsec e Text f => a -> Text -> f a go (SNat (Length list) -> [Ordinal (Length list)] forall (n :: Nat). SNat n -> [Ordinal n] enumOrdinal (SNat (Length list) -> [Ordinal (Length list)]) -> SNat (Length list) -> [Ordinal (Length list)] forall a b. (a -> b) -> a -> b $ Sing (Length list) -> SNat (Length list) forall (n :: Nat). Sing n -> SNat n singToSNat (Sing (Length list) -> SNat (Length list)) -> Sing (Length list) -> SNat (Length list) forall a b. (a -> b) -> a -> b $ Sing list -> Sing (Apply LengthSym0 list) forall (t :: * -> *) a (t1 :: t a). SFoldable t => Sing t1 -> Sing (Apply LengthSym0 t1) sLength Sing list slist) ([Text] -> [ParsecT Void Text Identity (Ordinal (Length list))]) -> [Text] -> [ParsecT Void Text Identity (Ordinal (Length list))] forall a b. (a -> b) -> a -> b $ Sing list -> [Text] forall (list :: [Symbol]). Sing list -> [Text] fromSingList Sing list slist where go :: a -> Text -> f a go a i Text v = a i a -> f Text -> f a forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Text -> f Text forall e (m :: * -> *). MonadParsec e Text m => Text -> m Text symbol Text v varPowP :: KnownNat n => VariableParser n -> Parser (OrderedMonomial ord n) varPowP :: VariableParser n -> Parser (OrderedMonomial ord n) varPowP VariableParser n vp = Parser (OrderedMonomial ord n) -> Parser (OrderedMonomial ord n) forall e (m :: * -> *) a. MonadParsec e Text m => m a -> m a lexeme (Parser (OrderedMonomial ord n) -> Parser (OrderedMonomial ord n)) -> Parser (OrderedMonomial ord n) -> Parser (OrderedMonomial ord n) forall a b. (a -> b) -> a -> b $ OrderedMonomial ord n -> Natural -> OrderedMonomial ord n forall r. Unital r => r -> Natural -> r pow (OrderedMonomial ord n -> Natural -> OrderedMonomial ord n) -> Parser (OrderedMonomial ord n) -> ParsecT Void Text Identity (Natural -> OrderedMonomial ord n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Proxy ord -> Monomial n -> OrderedMonomial ord n forall k (proxy :: k -> *) (ord :: k) (n :: Nat). proxy ord -> Monomial n -> OrderedMonomial ord n orderMonomial Proxy ord forall k (t :: k). Proxy t Proxy (Monomial n -> OrderedMonomial ord n) -> (Ordinal n -> Monomial n) -> Ordinal n -> OrderedMonomial ord n forall b c a. (b -> c) -> (a -> b) -> a -> c . SNat n -> Ordinal n -> Monomial n forall (n :: Nat). SNat n -> Ordinal n -> Monomial n varMonom SNat n forall (n :: Nat). KnownNat n => SNat n sNat (Ordinal n -> OrderedMonomial ord n) -> VariableParser n -> Parser (OrderedMonomial ord n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> VariableParser n vp) ParsecT Void Text Identity (Natural -> OrderedMonomial ord n) -> ParsecT Void Text Identity Natural -> Parser (OrderedMonomial ord n) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Natural -> ParsecT Void Text Identity Natural -> ParsecT Void Text Identity Natural forall (m :: * -> *) a. Alternative m => a -> m a -> m a option (Natural 1 :: Natural) (Text -> ParsecT Void Text Identity Text forall e (m :: * -> *). MonadParsec e Text m => Text -> m Text symbol Text "^" ParsecT Void Text Identity Text -> ParsecT Void Text Identity Natural -> ParsecT Void Text Identity Natural forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ParsecT Void Text Identity Natural forall e s (m :: * -> *) a. (MonadParsec e s m, Token s ~ Char, Num a) => m a L.decimal) monomialP :: KnownNat n => VariableParser n -> Parser (OrderedMonomial ord n) monomialP :: VariableParser n -> Parser (OrderedMonomial ord n) monomialP VariableParser n v = [OrderedMonomial ord n] -> OrderedMonomial ord n forall (f :: * -> *) r. (Foldable f, Unital r) => f r -> r product ([OrderedMonomial ord n] -> OrderedMonomial ord n) -> ParsecT Void Text Identity [OrderedMonomial ord n] -> Parser (OrderedMonomial ord n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> VariableParser n -> Parser (OrderedMonomial ord n) forall (n :: Nat) ord. KnownNat n => VariableParser n -> Parser (OrderedMonomial ord n) varPowP VariableParser n v Parser (OrderedMonomial ord n) -> ParsecT Void Text Identity (Maybe Text) -> ParsecT Void Text Identity [OrderedMonomial ord n] forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a] `sepBy1` ParsecT Void Text Identity Text -> ParsecT Void Text Identity (Maybe Text) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (Text -> ParsecT Void Text Identity Text forall e (m :: * -> *). MonadParsec e Text m => Text -> m Text symbol Text "*") factorP :: (IsOrderedPolynomial poly) => proxy poly -> Parser (Coefficient poly) -> VariableParser (Arity poly) -> Parser poly factorP :: proxy poly -> Parser (Coefficient poly) -> VariableParser (Arity poly) -> Parser poly factorP proxy poly _ Parser (Coefficient poly) coeffP VariableParser (Arity poly) varP = Coefficient poly -> poly forall poly. IsPolynomial poly => Coefficient poly -> poly injectCoeff (Coefficient poly -> poly) -> Parser (Coefficient poly) -> Parser poly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser (Coefficient poly) -> Parser (Coefficient poly) forall e (m :: * -> *) a. MonadParsec e Text m => m a -> m a lexeme Parser (Coefficient poly) coeffP Parser poly -> Parser poly -> Parser poly forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> OrderedMonomial (MOrder poly) (Arity poly) -> poly forall poly. IsOrderedPolynomial poly => OrderedMonomial (MOrder poly) (Arity poly) -> poly fromOrderedMonomial (OrderedMonomial (MOrder poly) (Arity poly) -> poly) -> ParsecT Void Text Identity (OrderedMonomial (MOrder poly) (Arity poly)) -> Parser poly forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> VariableParser (Arity poly) -> ParsecT Void Text Identity (OrderedMonomial (MOrder poly) (Arity poly)) forall (n :: Nat) ord. KnownNat n => VariableParser n -> Parser (OrderedMonomial ord n) monomialP VariableParser (Arity poly) varP binary :: MonadParsec e Text m => Text -> (a -> a -> a) -> Operator m a binary :: Text -> (a -> a -> a) -> Operator m a binary Text name a -> a -> a f = m (a -> a -> a) -> Operator m a forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a InfixL (a -> a -> a f (a -> a -> a) -> m Text -> m (a -> a -> a) forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Text -> m Text forall e (m :: * -> *). MonadParsec e Text m => Text -> m Text symbol Text name) prefix :: MonadParsec e Text m => Text -> (a -> a) -> Operator m a prefix :: Text -> (a -> a) -> Operator m a prefix Text name a -> a f = m (a -> a) -> Operator m a forall (m :: * -> *) a. m (a -> a) -> Operator m a Prefix (a -> a f (a -> a) -> m Text -> m (a -> a) forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ Text -> m Text forall e (m :: * -> *). MonadParsec e Text m => Text -> m Text symbol Text name) table :: (CoeffRing a, MonadParsec e Text m) => [[Operator m a]] table :: [[Operator m a]] table = [ [ Text -> (a -> a) -> Operator m a forall e (m :: * -> *) a. MonadParsec e Text m => Text -> (a -> a) -> Operator m a prefix Text "-" a -> a forall r. Group r => r -> r negate , Text -> (a -> a) -> Operator m a forall e (m :: * -> *) a. MonadParsec e Text m => Text -> (a -> a) -> Operator m a prefix Text "+" a -> a forall a. a -> a id ] , [Text -> (a -> a -> a) -> Operator m a forall e (m :: * -> *) a. MonadParsec e Text m => Text -> (a -> a -> a) -> Operator m a binary Text "*" a -> a -> a forall r. Multiplicative r => r -> r -> r (*)] , [Text -> (a -> a -> a) -> Operator m a forall e (m :: * -> *) a. MonadParsec e Text m => Text -> (a -> a -> a) -> Operator m a binary Text "+" a -> a -> a forall r. Additive r => r -> r -> r (+), Text -> (a -> a -> a) -> Operator m a forall e (m :: * -> *) a. MonadParsec e Text m => Text -> (a -> a -> a) -> Operator m a binary Text "-" (-)] ] polynomialP :: (IsOrderedPolynomial poly) => Parser (Coefficient poly) -> VariableParser (Arity poly) -> Parser poly polynomialP :: Parser (Coefficient poly) -> VariableParser (Arity poly) -> Parser poly polynomialP Parser (Coefficient poly) coeffP VariableParser (Arity poly) varP = Parser poly body where body :: Parser poly body = Parser poly -> [[Operator (ParsecT Void Text Identity) poly]] -> Parser poly forall (m :: * -> *) a. MonadPlus m => m a -> [[Operator m a]] -> m a makeExprParser (Proxy poly -> Parser (Coefficient poly) -> VariableParser (Arity poly) -> Parser poly forall poly (proxy :: * -> *). IsOrderedPolynomial poly => proxy poly -> Parser (Coefficient poly) -> VariableParser (Arity poly) -> Parser poly factorP Proxy poly forall k (t :: k). Proxy t Proxy Parser (Coefficient poly) coeffP VariableParser (Arity poly) varP) [[Operator (ParsecT Void Text Identity) poly]] forall a e (m :: * -> *). (CoeffRing a, MonadParsec e Text m) => [[Operator m a]] table rationalP :: Field k => Parser k rationalP :: Parser k rationalP = Rational -> k forall k. Field k => Rational -> k fromRat (Rational -> k) -> (Scientific -> Rational) -> Scientific -> k forall b c a. (b -> c) -> (a -> b) -> a -> c . Scientific -> Rational forall a. Real a => a -> Rational P.toRational (Scientific -> k) -> ParsecT Void Text Identity Scientific -> Parser k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text Identity Scientific forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m Scientific L.scientific integerP :: Parser Integer integerP :: Parser Integer integerP = Integer -> Integer forall r. Ring r => Integer -> r fromInteger' (Integer -> Integer) -> Parser Integer -> Parser Integer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser Integer forall e s (m :: * -> *) a. (MonadParsec e s m, Token s ~ Char, Num a) => m a L.decimal fromRat :: Field k => P.Rational -> k fromRat :: Rational -> k fromRat Rational r = Integer -> k forall r. Ring r => Integer -> r fromInteger' (Rational -> Integer forall a. Ratio a -> a P.numerator Rational r) k -> k -> k forall r. Division r => r -> r -> r / Integer -> k forall r. Ring r => Integer -> r fromInteger' (Rational -> Integer forall a. Ratio a -> a P.denominator Rational r) parsePolynomialWith :: (IsOrderedPolynomial poly) => Parser (Coefficient poly) -> VariableParser (Arity poly) -> T.Text -> Either String poly parsePolynomialWith :: Parser (Coefficient poly) -> VariableParser (Arity poly) -> Text -> Either String poly parsePolynomialWith Parser (Coefficient poly) coeffP VariableParser (Arity poly) varP = (ParseErrorBundle Text Void -> String) -> Either (ParseErrorBundle Text Void) poly -> Either String poly forall (a :: * -> * -> *) b c d. ArrowChoice a => a b c -> a (Either b d) (Either c d) left (ParseError Text Void -> String forall s e. (VisualStream s, ShowErrorComponent e) => ParseError s e -> String parseErrorPretty (ParseError Text Void -> String) -> (ParseErrorBundle Text Void -> ParseError Text Void) -> ParseErrorBundle Text Void -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . NonEmpty (ParseError Text Void) -> ParseError Text Void forall a. NonEmpty a -> a NE.head (NonEmpty (ParseError Text Void) -> ParseError Text Void) -> (ParseErrorBundle Text Void -> NonEmpty (ParseError Text Void)) -> ParseErrorBundle Text Void -> ParseError Text Void forall b c a. (b -> c) -> (a -> b) -> a -> c . ParseErrorBundle Text Void -> NonEmpty (ParseError Text Void) forall s e. ParseErrorBundle s e -> NonEmpty (ParseError s e) bundleErrors) (Either (ParseErrorBundle Text Void) poly -> Either String poly) -> (Text -> Either (ParseErrorBundle Text Void) poly) -> Text -> Either String poly forall b c a. (b -> c) -> (a -> b) -> a -> c . Parsec Void Text poly -> String -> Text -> Either (ParseErrorBundle Text Void) poly forall e s a. Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a parse (ParsecT Void Text Identity () forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m () space ParsecT Void Text Identity () -> Parsec Void Text poly -> Parsec Void Text poly forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> Parser (Coefficient poly) -> VariableParser (Arity poly) -> Parsec Void Text poly forall poly. IsOrderedPolynomial poly => Parser (Coefficient poly) -> VariableParser (Arity poly) -> Parser poly polynomialP Parser (Coefficient poly) coeffP VariableParser (Arity poly) varP Parsec Void Text poly -> ParsecT Void Text Identity () -> Parsec Void Text poly forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* ParsecT Void Text Identity () forall e s (m :: * -> *). MonadParsec e s m => m () eof) String "input"