{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}

-- |This module represents functionality for reading grammar definitions from given files and determing their type.
--
-- Depending on the type of grammar, specific algorithm for building a group will be executed.

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)

-- |Parser part.

-- |Parsers for terminal symbols in given grammar: it might be Epsilon, Nonterminal, Terminal, Conjunction or Negation
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

-- |Word part.
-- |Word is chain, generated by grammar.
-- It might be Epsilon (if word is empty), or sequence of 'Terminal' or 'Nonterminal'.
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 []

-- |Parsing relations part.
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

-- |Parser for one relation. Relation is in such form : Nonterminal -> [Symbol],
-- 1) in boolean grammar relation has form
-- Nonterminal -> a_1 & a_2 & .... & a_n & !b_1 & !b_2 & ... &!b_m, m + n >= 1, a_i and b_j - words (see above).
-- 2) in conjunctive grammar relation has form
-- Nonterminal -> a_1 & a_2 & .... & a_n, a_i - word
-- 3) in context-free grammar relation has form
-- Nonterminal -> word
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)

-- |Consider an Relation Nonterminal -> a_1 & a_2 & .... & a_n & !b_1 & !b_2 & ... &!b_m
-- we will name part 'a_1 & a_2 & .... & a_n' 'positive formula' and '& a_2 & .... & a_n' 'positive conjunction'.
-- Similarly, we will name part '!b_1 & !b_2 & .... & !b_n' 'negative formula' and '& !b_2 & .... & !b_n' 'negative conjunction'.
-- If Relation has positive and negative formula (it is relation of boolean grammar), we will call it very long rule.
--
-- Worth noting that parsing other types of relations is included in parsing very long rule:
-- relation without negative formula is the relation of conjunctive grammar,
-- relation without negative or positive formula (with only one word) is the relation of context-free grammar.
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

-- |Parsers for set of terminals and nonterminals.
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 [])

-- |Parser for whole Grammar.
-- |Order of grammar components in input is:
-- |{Start symbol};{Set of nonterminals};{Set of terminals};{Relations}
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

-- |Method for classifying type of input grammar.
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

-- |Method returns true if relation is boolean
-- (has negation and conjunction operands),
-- false otherwise
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

-- |Valid examples of input
-- 1) context-free grammar
-- S; S A D1; c2 b e
-- S-> c2 D1 A
-- A-> b
-- D1-> e
-- where 'S' - start symbol, 'S A D1' - set of nonterminals, 'c2 b e' - set of terminals,
-- 'S-> c2 D1 A, A-> b, D1-> e' - relations.
-- Another valid example:
-- S; S B; a b
-- S-> a B
-- B-> b
-- 2) conjunctive grammar
-- S; S Abc D Cr; c b d e
-- S-> D c& d Abc
-- Abc-> b
-- D-> Cr
-- Cr-> e
-- where 'S' - start symbol, 'S Abc D Cr' - set of nonterminals, 'c b d e' - set of terminals,
-- 'S-> D c& d Abc, Abc-> b, D-> Cr, Cr-> e' - relations.
-- 3) boolean grammar
-- S; S Sa; c v b
-- S-> c&! v&! Sa&! Eps
-- Sa->! b
-- where 'S' - start symbol, 'S 'Sa - set of nonterminals, 'c v b' - set of terminals,
-- 'S-> c&! v&! Sa&! Eps;Sa->! b' - relation
-- Another valid examples for boolean grammar:
-- 1)
-- S; S; c v b
-- S->! c&! v&! b&! Eps