{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module GrammarReader (parser, parseFromFile, checkGrammarType) where
import Text.Megaparsec
import Text.Megaparsec.Char
import Data.Functor
import Data.Set (Set)
import qualified Data.Set as Set
import Data.List.Split
import GrammarType
import ParsingHelpers
data ParserToken = N' Nonterminal
| T' Terminal
| Eps'
| Conjunction
| Negation
deriving (ParserToken -> ParserToken -> Bool
(ParserToken -> ParserToken -> Bool)
-> (ParserToken -> ParserToken -> Bool) -> Eq ParserToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParserToken -> ParserToken -> Bool
$c/= :: ParserToken -> ParserToken -> Bool
== :: ParserToken -> ParserToken -> Bool
$c== :: ParserToken -> ParserToken -> Bool
Eq, Eq ParserToken
Eq ParserToken
-> (ParserToken -> ParserToken -> Ordering)
-> (ParserToken -> ParserToken -> Bool)
-> (ParserToken -> ParserToken -> Bool)
-> (ParserToken -> ParserToken -> Bool)
-> (ParserToken -> ParserToken -> Bool)
-> (ParserToken -> ParserToken -> ParserToken)
-> (ParserToken -> ParserToken -> ParserToken)
-> Ord ParserToken
ParserToken -> ParserToken -> Bool
ParserToken -> ParserToken -> Ordering
ParserToken -> ParserToken -> ParserToken
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParserToken -> ParserToken -> ParserToken
$cmin :: ParserToken -> ParserToken -> ParserToken
max :: ParserToken -> ParserToken -> ParserToken
$cmax :: ParserToken -> ParserToken -> ParserToken
>= :: ParserToken -> ParserToken -> Bool
$c>= :: ParserToken -> ParserToken -> Bool
> :: ParserToken -> ParserToken -> Bool
$c> :: ParserToken -> ParserToken -> Bool
<= :: ParserToken -> ParserToken -> Bool
$c<= :: ParserToken -> ParserToken -> Bool
< :: ParserToken -> ParserToken -> Bool
$c< :: ParserToken -> ParserToken -> Bool
compare :: ParserToken -> ParserToken -> Ordering
$ccompare :: ParserToken -> ParserToken -> Ordering
$cp1Ord :: Eq ParserToken
Ord, Int -> ParserToken -> ShowS
[ParserToken] -> ShowS
ParserToken -> String
(Int -> ParserToken -> ShowS)
-> (ParserToken -> String)
-> ([ParserToken] -> ShowS)
-> Show ParserToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParserToken] -> ShowS
$cshowList :: [ParserToken] -> ShowS
show :: ParserToken -> String
$cshow :: ParserToken -> String
showsPrec :: Int -> ParserToken -> ShowS
$cshowsPrec :: Int -> ParserToken -> ShowS
Show)
pEpsilon :: Parser ParserToken
pEpsilon :: Parser ParserToken
pEpsilon = ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Text
"Eps" ParsecT Void Text Identity ()
-> Parser ParserToken -> Parser ParserToken
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParserToken -> Parser ParserToken
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParserToken
Eps'
pNonterminal :: Parser Nonterminal
pNonterminal :: Parser Nonterminal
pNonterminal = String -> Nonterminal
Nonterminal (String -> Nonterminal)
-> ParsecT Void Text Identity String -> Parser Nonterminal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (
String -> ShowS
forall a. [a] -> [a] -> [a]
(++)
(String -> ShowS)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (String -> ShowS)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> ShowS)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> ParsecT Void Text Identity String
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar)
ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
)
pTerminal :: Parser Terminal
pTerminal :: Parser Terminal
pTerminal = String -> Terminal
Terminal (String -> Terminal)
-> ParsecT Void Text Identity String -> Parser Terminal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (
String -> ShowS
forall a. [a] -> [a] -> [a]
(++)
(String -> ShowS)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar
ParsecT Void Text Identity ShowS
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
)
pConjunction :: Parser ParserToken
pConjunction :: Parser ParserToken
pConjunction = ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Text
"&" ParsecT Void Text Identity () -> ParserToken -> Parser ParserToken
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ParserToken
Conjunction
pNegation :: Parser ParserToken
pNegation :: Parser ParserToken
pNegation = ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Text
"!" ParsecT Void Text Identity () -> ParserToken -> Parser ParserToken
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ParserToken
Negation
pWord :: Parser [ParserToken]
pWord :: Parser [ParserToken]
pWord = [ParserToken] -> [ParserToken] -> [ParserToken]
forall a. [a] -> [a] -> [a]
(++) ([ParserToken] -> [ParserToken] -> [ParserToken])
-> Parser [ParserToken]
-> ParsecT Void Text Identity ([ParserToken] -> [ParserToken])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ParserToken]
pword' ParsecT Void Text Identity ([ParserToken] -> [ParserToken])
-> Parser [ParserToken] -> Parser [ParserToken]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ParserToken] -> Parser [ParserToken]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
pword' :: Parser [ParserToken]
pword' :: Parser [ParserToken]
pword' = Parser ParserToken -> Parser [ParserToken]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Text
" " ParsecT Void Text Identity ()
-> Parser ParserToken -> Parser ParserToken
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Terminal -> ParserToken
T' (Terminal -> ParserToken) -> Parser Terminal -> Parser ParserToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Terminal
pTerminal Parser ParserToken -> Parser ParserToken -> Parser ParserToken
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Nonterminal -> ParserToken
N' (Nonterminal -> ParserToken)
-> Parser Nonterminal -> Parser ParserToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Nonterminal
pNonterminal))
Parser [ParserToken]
-> Parser [ParserToken] -> Parser [ParserToken]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(:) (ParserToken -> [ParserToken] -> [ParserToken])
-> Parser ParserToken
-> ParsecT Void Text Identity ([ParserToken] -> [ParserToken])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParserToken
pEpsilon ParsecT Void Text Identity ([ParserToken] -> [ParserToken])
-> Parser [ParserToken] -> Parser [ParserToken]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ParserToken] -> Parser [ParserToken]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
pRelations :: Parser (Set Relation)
pRelations :: Parser (Set Relation)
pRelations = do
Relation
firstRelation <- Parser Relation
pRelation
Set Relation
relations <- [Relation] -> Set Relation
forall a. Ord a => [a] -> Set a
Set.fromList ([Relation] -> Set Relation)
-> ParsecT Void Text Identity [Relation] -> Parser (Set Relation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Relation -> ParsecT Void Text Identity [Relation]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Text
"\n" ParsecT Void Text Identity () -> Parser Relation -> Parser Relation
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Relation
pRelation)
Set Relation -> Parser (Set Relation)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Relation -> Parser (Set Relation))
-> Set Relation -> Parser (Set Relation)
forall a b. (a -> b) -> a -> b
$ Relation -> Set Relation -> Set Relation
forall a. Ord a => a -> Set a -> Set a
Set.insert Relation
firstRelation Set Relation
relations
pRelation :: Parser Relation
pRelation :: Parser Relation
pRelation = do
Nonterminal
nonterminal <- Parser Nonterminal
pNonterminal
ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Text
"->"
[ParserToken]
tokens' <- Parser [ParserToken] -> Parser [ParserToken]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser [ParserToken]
pVeryLongRule Parser [ParserToken]
-> Parser [ParserToken] -> Parser [ParserToken]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [ParserToken]
pPositiveFormula Parser [ParserToken]
-> Parser [ParserToken] -> Parser [ParserToken]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser [ParserToken]
pNegativeFormula
Relation -> Parser Relation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Relation -> Parser Relation) -> Relation -> Parser Relation
forall a b. (a -> b) -> a -> b
$ Nonterminal -> [ParserToken] -> Relation
tokensToRightPart Nonterminal
nonterminal [ParserToken]
tokens'
tokensToRightPart :: Nonterminal -> [ParserToken] -> Relation
tokensToRightPart :: Nonterminal -> [ParserToken] -> Relation
tokensToRightPart Nonterminal
nonterminal [ParserToken]
currentTokens =
if ParserToken -> [ParserToken] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ParserToken
Conjunction [ParserToken]
currentTokens Bool -> Bool -> Bool
|| ParserToken -> [ParserToken] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ParserToken
Negation [ParserToken]
currentTokens
then let
conjsWithTokens :: [[ParserToken]]
conjsWithTokens = [ParserToken] -> [ParserToken] -> [[ParserToken]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [ParserToken
Conjunction] [ParserToken]
currentTokens
conjs :: [Conj]
conjs = ([ParserToken] -> Conj) -> [[ParserToken]] -> [Conj]
forall a b. (a -> b) -> [a] -> [b]
map (\[ParserToken]
t ->
if [ParserToken] -> ParserToken
forall a. [a] -> a
head [ParserToken]
t ParserToken -> ParserToken -> Bool
forall a. Eq a => a -> a -> Bool
== ParserToken
Negation
then [Symbol] -> Conj
NegConj ([Symbol] -> Conj) -> [Symbol] -> Conj
forall a b. (a -> b) -> a -> b
$ [ParserToken] -> [Symbol]
tokensToSymbols ([ParserToken] -> [Symbol]) -> [ParserToken] -> [Symbol]
forall a b. (a -> b) -> a -> b
$ [ParserToken] -> [ParserToken]
forall a. [a] -> [a]
tail [ParserToken]
t
else [Symbol] -> Conj
PosConj ([Symbol] -> Conj) -> [Symbol] -> Conj
forall a b. (a -> b) -> a -> b
$ [ParserToken] -> [Symbol]
tokensToSymbols [ParserToken]
t) [[ParserToken]]
conjsWithTokens
in (Nonterminal, [Conj]) -> Relation
BooleanRelation (Nonterminal
nonterminal, [Conj]
conjs)
else (Nonterminal, [Symbol]) -> Relation
Relation (Nonterminal
nonterminal, [ParserToken] -> [Symbol]
tokensToSymbols [ParserToken]
currentTokens)
tokensToSymbols :: [ParserToken] -> [Symbol]
tokensToSymbols :: [ParserToken] -> [Symbol]
tokensToSymbols
= (ParserToken -> Symbol) -> [ParserToken] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map
(\case
(T' Terminal
terminal) -> Terminal -> Symbol
T Terminal
terminal
(N' Nonterminal
nonterminal) -> Nonterminal -> Symbol
N Nonterminal
nonterminal
ParserToken
Negation -> String -> Symbol
forall a. HasCallStack => String -> a
error String
"Incorrect conjunction form"
ParserToken
Conjunction -> String -> Symbol
forall a. HasCallStack => String -> a
error String
"Incorrect conjunction form"
ParserToken
Eps' -> Symbol
Eps)
pVeryLongRule :: Parser [ParserToken]
pVeryLongRule :: Parser [ParserToken]
pVeryLongRule = do
[ParserToken]
word <- Parser [ParserToken]
pWord
[ParserToken]
positiveConj <- [ParserToken] -> [ParserToken] -> [ParserToken]
forall a. [a] -> [a] -> [a]
(++) [ParserToken]
word ([ParserToken] -> [ParserToken])
-> ([[ParserToken]] -> [ParserToken])
-> [[ParserToken]]
-> [ParserToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ParserToken]] -> [ParserToken]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ParserToken]] -> [ParserToken])
-> ParsecT Void Text Identity [[ParserToken]]
-> Parser [ParserToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ParserToken] -> ParsecT Void Text Identity [[ParserToken]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser [ParserToken] -> Parser [ParserToken]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser [ParserToken]
pPositiveConjunction)
([ParserToken]
positiveConj [ParserToken] -> [ParserToken] -> [ParserToken]
forall a. [a] -> [a] -> [a]
++) ([ParserToken] -> [ParserToken])
-> ([[ParserToken]] -> [ParserToken])
-> [[ParserToken]]
-> [ParserToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ParserToken]] -> [ParserToken]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ParserToken]] -> [ParserToken])
-> ParsecT Void Text Identity [[ParserToken]]
-> Parser [ParserToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ParserToken] -> ParsecT Void Text Identity [[ParserToken]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser [ParserToken]
pNegativeConjunction
pNegativeConjunction :: Parser [ParserToken]
pNegativeConjunction :: Parser [ParserToken]
pNegativeConjunction = do
ParserToken
conj <- Parser ParserToken
pConjunction
ParserToken
negation <- Parser ParserToken
pNegation
[ParserToken] -> [ParserToken] -> [ParserToken]
forall a. [a] -> [a] -> [a]
(++) [ParserToken
conj, ParserToken
negation] ([ParserToken] -> [ParserToken])
-> Parser [ParserToken] -> Parser [ParserToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ParserToken]
pWord
pPositiveConjunction :: Parser [ParserToken]
pPositiveConjunction :: Parser [ParserToken]
pPositiveConjunction = do
ParserToken
conjunction <- Parser ParserToken -> Parser ParserToken
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser ParserToken
pConjunction
[ParserToken] -> [ParserToken] -> [ParserToken]
forall a. [a] -> [a] -> [a]
(++) [ParserToken
conjunction] ([ParserToken] -> [ParserToken])
-> Parser [ParserToken] -> Parser [ParserToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ParserToken]
pWord
pPositiveFormula :: Parser [ParserToken]
pPositiveFormula :: Parser [ParserToken]
pPositiveFormula = do
[ParserToken]
word <- Parser [ParserToken]
pWord
[ParserToken] -> [ParserToken] -> [ParserToken]
forall a. [a] -> [a] -> [a]
(++) [ParserToken]
word ([ParserToken] -> [ParserToken])
-> ([[ParserToken]] -> [ParserToken])
-> [[ParserToken]]
-> [ParserToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ParserToken]] -> [ParserToken]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ParserToken]] -> [ParserToken])
-> ParsecT Void Text Identity [[ParserToken]]
-> Parser [ParserToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ParserToken] -> ParsecT Void Text Identity [[ParserToken]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser [ParserToken]
pPositiveConjunction
pNegativeFormula :: Parser [ParserToken]
pNegativeFormula :: Parser [ParserToken]
pNegativeFormula = do
ParserToken
negation <- Parser ParserToken
pNegation
[ParserToken]
negationWords <- [ParserToken] -> [ParserToken] -> [ParserToken]
forall a. [a] -> [a] -> [a]
(++) [ParserToken
negation] ([ParserToken] -> [ParserToken])
-> Parser [ParserToken] -> Parser [ParserToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ParserToken]
pWord
[ParserToken] -> [ParserToken] -> [ParserToken]
forall a. [a] -> [a] -> [a]
(++) [ParserToken]
negationWords ([ParserToken] -> [ParserToken])
-> ([[ParserToken]] -> [ParserToken])
-> [[ParserToken]]
-> [ParserToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ParserToken]] -> [ParserToken]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ParserToken]] -> [ParserToken])
-> ParsecT Void Text Identity [[ParserToken]]
-> Parser [ParserToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ParserToken] -> ParsecT Void Text Identity [[ParserToken]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser [ParserToken]
pNegativeConjunction
pNonterminals :: Parser (Set Nonterminal)
pNonterminals :: Parser (Set Nonterminal)
pNonterminals = [Nonterminal] -> Set Nonterminal
forall a. Ord a => [a] -> Set a
Set.fromList ([Nonterminal] -> Set Nonterminal)
-> ParsecT Void Text Identity [Nonterminal]
-> Parser (Set Nonterminal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Nonterminal] -> [Nonterminal] -> [Nonterminal]
forall a. [a] -> [a] -> [a]
(++) ([Nonterminal] -> [Nonterminal] -> [Nonterminal])
-> ParsecT Void Text Identity [Nonterminal]
-> ParsecT Void Text Identity ([Nonterminal] -> [Nonterminal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Nonterminal -> ParsecT Void Text Identity [Nonterminal]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Text
" " ParsecT Void Text Identity ()
-> Parser Nonterminal -> Parser Nonterminal
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Nonterminal
pNonterminal) ParsecT Void Text Identity ([Nonterminal] -> [Nonterminal])
-> ParsecT Void Text Identity [Nonterminal]
-> ParsecT Void Text Identity [Nonterminal]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Nonterminal] -> ParsecT Void Text Identity [Nonterminal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
pTerminals :: Parser (Set Terminal)
pTerminals :: Parser (Set Terminal)
pTerminals = [Terminal] -> Set Terminal
forall a. Ord a => [a] -> Set a
Set.fromList ([Terminal] -> Set Terminal)
-> ParsecT Void Text Identity [Terminal] -> Parser (Set Terminal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Terminal] -> [Terminal] -> [Terminal]
forall a. [a] -> [a] -> [a]
(++) ([Terminal] -> [Terminal] -> [Terminal])
-> ParsecT Void Text Identity [Terminal]
-> ParsecT Void Text Identity ([Terminal] -> [Terminal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Terminal -> ParsecT Void Text Identity [Terminal]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Text
" " ParsecT Void Text Identity () -> Parser Terminal -> Parser Terminal
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Terminal
pTerminal) ParsecT Void Text Identity ([Terminal] -> [Terminal])
-> ParsecT Void Text Identity [Terminal]
-> ParsecT Void Text Identity [Terminal]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Terminal] -> ParsecT Void Text Identity [Terminal]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
pGrammar :: Parser Grammar
pGrammar :: Parser Grammar
pGrammar = do
Nonterminal
startSymbol <- Parser Nonterminal
pNonterminal
ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Text
";"
Set Nonterminal
nonterminals <- Parser (Set Nonterminal)
pNonterminals
ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Text
";"
Set Terminal
terminals <- Parser (Set Terminal)
pTerminals
ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Text
"\n"
Set Relation
relations <- Parser (Set Relation)
pRelations
Grammar -> Parser Grammar
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Set Nonterminal, Set Terminal, Set Relation, Nonterminal)
-> Grammar
Grammar (Set Nonterminal
nonterminals, Set Terminal
terminals, Set Relation
relations, Nonterminal
startSymbol))
parser :: Parser Grammar
parser :: Parser Grammar
parser = Parser Grammar -> Parser Grammar
forall a. Parser a -> Parser a
makeEofParser Parser Grammar
pGrammar
checkGrammarType :: Grammar -> GrammarType
checkGrammarType :: Grammar -> GrammarType
checkGrammarType (Grammar (Set Nonterminal
_, Set Terminal
_, Set Relation
setOfRelations, Nonterminal
_)) = [Relation] -> GrammarType
checkGrammarType' ([Relation] -> GrammarType) -> [Relation] -> GrammarType
forall a b. (a -> b) -> a -> b
$ Set Relation -> [Relation]
forall a. Set a -> [a]
Set.toList Set Relation
setOfRelations
relationIsBoolean :: Relation -> Bool
relationIsBoolean :: Relation -> Bool
relationIsBoolean (BooleanRelation (Nonterminal
_, [Conj]
conjs)) = let
negConjs :: [Conj]
negConjs = (Conj -> Bool) -> [Conj] -> [Conj]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case
(NegConj [Symbol]
_) -> Bool
True
(PosConj [Symbol]
_) -> Bool
False) [Conj]
conjs
in Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Conj] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Conj]
negConjs
relationIsBoolean (Relation (Nonterminal
_,[Symbol]
_)) = Bool
False
relationIsCFG :: Relation -> Bool
relationIsCFG :: Relation -> Bool
relationIsCFG (Relation (Nonterminal
_,[Symbol]
_)) = Bool
True
relationIsCFG Relation
_ = Bool
False
checkGrammarType' :: [Relation] -> GrammarType
checkGrammarType' :: [Relation] -> GrammarType
checkGrammarType' [Relation]
relations
| (Relation -> Bool) -> [Relation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Relation -> Bool
relationIsCFG [Relation]
relations = GrammarType
CFG
| (Relation -> Bool) -> [Relation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Relation -> Bool
relationIsBoolean [Relation]
relations = GrammarType
Boolean
| Bool
otherwise = GrammarType
Conjunctive