-- |This module represents types of formal grammar.
--
-- In the moment we use it to represent a context-free grammar, conjunctive grammar, boolean grammar.
module GrammarType where

import Data.Set (Set)

-- |'Terminal' is a type that represents terminal in the formal grammar 'Grammar'.
newtype Terminal = Terminal {Terminal -> String
terminalValue :: String}
    deriving (Terminal -> Terminal -> Bool
(Terminal -> Terminal -> Bool)
-> (Terminal -> Terminal -> Bool) -> Eq Terminal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Terminal -> Terminal -> Bool
$c/= :: Terminal -> Terminal -> Bool
== :: Terminal -> Terminal -> Bool
$c== :: Terminal -> Terminal -> Bool
Eq, Eq Terminal
Eq Terminal
-> (Terminal -> Terminal -> Ordering)
-> (Terminal -> Terminal -> Bool)
-> (Terminal -> Terminal -> Bool)
-> (Terminal -> Terminal -> Bool)
-> (Terminal -> Terminal -> Bool)
-> (Terminal -> Terminal -> Terminal)
-> (Terminal -> Terminal -> Terminal)
-> Ord Terminal
Terminal -> Terminal -> Bool
Terminal -> Terminal -> Ordering
Terminal -> Terminal -> Terminal
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 :: Terminal -> Terminal -> Terminal
$cmin :: Terminal -> Terminal -> Terminal
max :: Terminal -> Terminal -> Terminal
$cmax :: Terminal -> Terminal -> Terminal
>= :: Terminal -> Terminal -> Bool
$c>= :: Terminal -> Terminal -> Bool
> :: Terminal -> Terminal -> Bool
$c> :: Terminal -> Terminal -> Bool
<= :: Terminal -> Terminal -> Bool
$c<= :: Terminal -> Terminal -> Bool
< :: Terminal -> Terminal -> Bool
$c< :: Terminal -> Terminal -> Bool
compare :: Terminal -> Terminal -> Ordering
$ccompare :: Terminal -> Terminal -> Ordering
$cp1Ord :: Eq Terminal
Ord, Int -> Terminal -> ShowS
[Terminal] -> ShowS
Terminal -> String
(Int -> Terminal -> ShowS)
-> (Terminal -> String) -> ([Terminal] -> ShowS) -> Show Terminal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Terminal] -> ShowS
$cshowList :: [Terminal] -> ShowS
show :: Terminal -> String
$cshow :: Terminal -> String
showsPrec :: Int -> Terminal -> ShowS
$cshowsPrec :: Int -> Terminal -> ShowS
Show)

-- |'Nonterminal' is a type that represents nonterminal in the formal grammar 'Grammar'.
newtype Nonterminal = Nonterminal {Nonterminal -> String
nonterminalValue :: String}
    deriving (Nonterminal -> Nonterminal -> Bool
(Nonterminal -> Nonterminal -> Bool)
-> (Nonterminal -> Nonterminal -> Bool) -> Eq Nonterminal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nonterminal -> Nonterminal -> Bool
$c/= :: Nonterminal -> Nonterminal -> Bool
== :: Nonterminal -> Nonterminal -> Bool
$c== :: Nonterminal -> Nonterminal -> Bool
Eq, Eq Nonterminal
Eq Nonterminal
-> (Nonterminal -> Nonterminal -> Ordering)
-> (Nonterminal -> Nonterminal -> Bool)
-> (Nonterminal -> Nonterminal -> Bool)
-> (Nonterminal -> Nonterminal -> Bool)
-> (Nonterminal -> Nonterminal -> Bool)
-> (Nonterminal -> Nonterminal -> Nonterminal)
-> (Nonterminal -> Nonterminal -> Nonterminal)
-> Ord Nonterminal
Nonterminal -> Nonterminal -> Bool
Nonterminal -> Nonterminal -> Ordering
Nonterminal -> Nonterminal -> Nonterminal
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 :: Nonterminal -> Nonterminal -> Nonterminal
$cmin :: Nonterminal -> Nonterminal -> Nonterminal
max :: Nonterminal -> Nonterminal -> Nonterminal
$cmax :: Nonterminal -> Nonterminal -> Nonterminal
>= :: Nonterminal -> Nonterminal -> Bool
$c>= :: Nonterminal -> Nonterminal -> Bool
> :: Nonterminal -> Nonterminal -> Bool
$c> :: Nonterminal -> Nonterminal -> Bool
<= :: Nonterminal -> Nonterminal -> Bool
$c<= :: Nonterminal -> Nonterminal -> Bool
< :: Nonterminal -> Nonterminal -> Bool
$c< :: Nonterminal -> Nonterminal -> Bool
compare :: Nonterminal -> Nonterminal -> Ordering
$ccompare :: Nonterminal -> Nonterminal -> Ordering
$cp1Ord :: Eq Nonterminal
Ord, Int -> Nonterminal -> ShowS
[Nonterminal] -> ShowS
Nonterminal -> String
(Int -> Nonterminal -> ShowS)
-> (Nonterminal -> String)
-> ([Nonterminal] -> ShowS)
-> Show Nonterminal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nonterminal] -> ShowS
$cshowList :: [Nonterminal] -> ShowS
show :: Nonterminal -> String
$cshow :: Nonterminal -> String
showsPrec :: Int -> Nonterminal -> ShowS
$cshowsPrec :: Int -> Nonterminal -> ShowS
Show)

-- |'Symbol' represents symbol that can be appear in right part of the 'Relation'.
--
-- 'T' is for 'Terminal'.
--
-- 'N' is for 'Nonterminal'.
--
-- And 'Eps' is for empty symbol, epsilon.
data Symbol = T Terminal | N Nonterminal | Eps
    deriving (Symbol -> Symbol -> Bool
(Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool) -> Eq Symbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Symbol -> Symbol -> Bool
$c/= :: Symbol -> Symbol -> Bool
== :: Symbol -> Symbol -> Bool
$c== :: Symbol -> Symbol -> Bool
Eq, Eq Symbol
Eq Symbol
-> (Symbol -> Symbol -> Ordering)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Symbol)
-> (Symbol -> Symbol -> Symbol)
-> Ord Symbol
Symbol -> Symbol -> Bool
Symbol -> Symbol -> Ordering
Symbol -> Symbol -> Symbol
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 :: Symbol -> Symbol -> Symbol
$cmin :: Symbol -> Symbol -> Symbol
max :: Symbol -> Symbol -> Symbol
$cmax :: Symbol -> Symbol -> Symbol
>= :: Symbol -> Symbol -> Bool
$c>= :: Symbol -> Symbol -> Bool
> :: Symbol -> Symbol -> Bool
$c> :: Symbol -> Symbol -> Bool
<= :: Symbol -> Symbol -> Bool
$c<= :: Symbol -> Symbol -> Bool
< :: Symbol -> Symbol -> Bool
$c< :: Symbol -> Symbol -> Bool
compare :: Symbol -> Symbol -> Ordering
$ccompare :: Symbol -> Symbol -> Ordering
$cp1Ord :: Eq Symbol
Ord, Int -> Symbol -> ShowS
[Symbol] -> ShowS
Symbol -> String
(Int -> Symbol -> ShowS)
-> (Symbol -> String) -> ([Symbol] -> ShowS) -> Show Symbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Symbol] -> ShowS
$cshowList :: [Symbol] -> ShowS
show :: Symbol -> String
$cshow :: Symbol -> String
showsPrec :: Int -> Symbol -> ShowS
$cshowsPrec :: Int -> Symbol -> ShowS
Show)

-- |Conj is helper type  for representing the right part of a relation in a boolean grammar
data Conj = PosConj {Conj -> [Symbol]
symbols :: [Symbol]}
          | NegConj {symbols :: [Symbol]}
    deriving (Conj -> Conj -> Bool
(Conj -> Conj -> Bool) -> (Conj -> Conj -> Bool) -> Eq Conj
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Conj -> Conj -> Bool
$c/= :: Conj -> Conj -> Bool
== :: Conj -> Conj -> Bool
$c== :: Conj -> Conj -> Bool
Eq, Eq Conj
Eq Conj
-> (Conj -> Conj -> Ordering)
-> (Conj -> Conj -> Bool)
-> (Conj -> Conj -> Bool)
-> (Conj -> Conj -> Bool)
-> (Conj -> Conj -> Bool)
-> (Conj -> Conj -> Conj)
-> (Conj -> Conj -> Conj)
-> Ord Conj
Conj -> Conj -> Bool
Conj -> Conj -> Ordering
Conj -> Conj -> Conj
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 :: Conj -> Conj -> Conj
$cmin :: Conj -> Conj -> Conj
max :: Conj -> Conj -> Conj
$cmax :: Conj -> Conj -> Conj
>= :: Conj -> Conj -> Bool
$c>= :: Conj -> Conj -> Bool
> :: Conj -> Conj -> Bool
$c> :: Conj -> Conj -> Bool
<= :: Conj -> Conj -> Bool
$c<= :: Conj -> Conj -> Bool
< :: Conj -> Conj -> Bool
$c< :: Conj -> Conj -> Bool
compare :: Conj -> Conj -> Ordering
$ccompare :: Conj -> Conj -> Ordering
$cp1Ord :: Eq Conj
Ord, Int -> Conj -> ShowS
[Conj] -> ShowS
Conj -> String
(Int -> Conj -> ShowS)
-> (Conj -> String) -> ([Conj] -> ShowS) -> Show Conj
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Conj] -> ShowS
$cshowList :: [Conj] -> ShowS
show :: Conj -> String
$cshow :: Conj -> String
showsPrec :: Int -> Conj -> ShowS
$cshowsPrec :: Int -> Conj -> ShowS
Show)
    
-- |This type is synonym 'Nonterminal' and used in order to separate 'StartSymbol' from normal 'Nonterminal'.
type StartSymbol = Nonterminal

-- |'Relation' is a rule of 'Grammar'. 
-- First constructor is for working only with CFG grammars
-- Second constructor is for working with Boolean or Conjunctive grammars, 
-- though it might be used for defining grammars too
-- (right part of CFG relation is one PosConj in right part of boolean relation)   
data Relation = Relation (Nonterminal, [Symbol]) | BooleanRelation (Nonterminal, [Conj])
    deriving (Relation -> Relation -> Bool
(Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool) -> Eq Relation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relation -> Relation -> Bool
$c/= :: Relation -> Relation -> Bool
== :: Relation -> Relation -> Bool
$c== :: Relation -> Relation -> Bool
Eq, Eq Relation
Eq Relation
-> (Relation -> Relation -> Ordering)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Relation)
-> (Relation -> Relation -> Relation)
-> Ord Relation
Relation -> Relation -> Bool
Relation -> Relation -> Ordering
Relation -> Relation -> Relation
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 :: Relation -> Relation -> Relation
$cmin :: Relation -> Relation -> Relation
max :: Relation -> Relation -> Relation
$cmax :: Relation -> Relation -> Relation
>= :: Relation -> Relation -> Bool
$c>= :: Relation -> Relation -> Bool
> :: Relation -> Relation -> Bool
$c> :: Relation -> Relation -> Bool
<= :: Relation -> Relation -> Bool
$c<= :: Relation -> Relation -> Bool
< :: Relation -> Relation -> Bool
$c< :: Relation -> Relation -> Bool
compare :: Relation -> Relation -> Ordering
$ccompare :: Relation -> Relation -> Ordering
$cp1Ord :: Eq Relation
Ord, Int -> Relation -> ShowS
[Relation] -> ShowS
Relation -> String
(Int -> Relation -> ShowS)
-> (Relation -> String) -> ([Relation] -> ShowS) -> Show Relation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Relation] -> ShowS
$cshowList :: [Relation] -> ShowS
show :: Relation -> String
$cshow :: Relation -> String
showsPrec :: Int -> Relation -> ShowS
$cshowsPrec :: Int -> Relation -> ShowS
Show)

-- |This type we using to classify grammars.
data GrammarType = CFG | Conjunctive | Boolean
    deriving (GrammarType -> GrammarType -> Bool
(GrammarType -> GrammarType -> Bool)
-> (GrammarType -> GrammarType -> Bool) -> Eq GrammarType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrammarType -> GrammarType -> Bool
$c/= :: GrammarType -> GrammarType -> Bool
== :: GrammarType -> GrammarType -> Bool
$c== :: GrammarType -> GrammarType -> Bool
Eq, Eq GrammarType
Eq GrammarType
-> (GrammarType -> GrammarType -> Ordering)
-> (GrammarType -> GrammarType -> Bool)
-> (GrammarType -> GrammarType -> Bool)
-> (GrammarType -> GrammarType -> Bool)
-> (GrammarType -> GrammarType -> Bool)
-> (GrammarType -> GrammarType -> GrammarType)
-> (GrammarType -> GrammarType -> GrammarType)
-> Ord GrammarType
GrammarType -> GrammarType -> Bool
GrammarType -> GrammarType -> Ordering
GrammarType -> GrammarType -> GrammarType
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 :: GrammarType -> GrammarType -> GrammarType
$cmin :: GrammarType -> GrammarType -> GrammarType
max :: GrammarType -> GrammarType -> GrammarType
$cmax :: GrammarType -> GrammarType -> GrammarType
>= :: GrammarType -> GrammarType -> Bool
$c>= :: GrammarType -> GrammarType -> Bool
> :: GrammarType -> GrammarType -> Bool
$c> :: GrammarType -> GrammarType -> Bool
<= :: GrammarType -> GrammarType -> Bool
$c<= :: GrammarType -> GrammarType -> Bool
< :: GrammarType -> GrammarType -> Bool
$c< :: GrammarType -> GrammarType -> Bool
compare :: GrammarType -> GrammarType -> Ordering
$ccompare :: GrammarType -> GrammarType -> Ordering
$cp1Ord :: Eq GrammarType
Ord, Int -> GrammarType -> ShowS
[GrammarType] -> ShowS
GrammarType -> String
(Int -> GrammarType -> ShowS)
-> (GrammarType -> String)
-> ([GrammarType] -> ShowS)
-> Show GrammarType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GrammarType] -> ShowS
$cshowList :: [GrammarType] -> ShowS
show :: GrammarType -> String
$cshow :: GrammarType -> String
showsPrec :: Int -> GrammarType -> ShowS
$cshowsPrec :: Int -> GrammarType -> ShowS
Show)

-- |This type we using to represent a formal grammar.
newtype Grammar = Grammar (Set Nonterminal, Set Terminal, Set Relation, StartSymbol)
    deriving (Grammar -> Grammar -> Bool
(Grammar -> Grammar -> Bool)
-> (Grammar -> Grammar -> Bool) -> Eq Grammar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Grammar -> Grammar -> Bool
$c/= :: Grammar -> Grammar -> Bool
== :: Grammar -> Grammar -> Bool
$c== :: Grammar -> Grammar -> Bool
Eq, Eq Grammar
Eq Grammar
-> (Grammar -> Grammar -> Ordering)
-> (Grammar -> Grammar -> Bool)
-> (Grammar -> Grammar -> Bool)
-> (Grammar -> Grammar -> Bool)
-> (Grammar -> Grammar -> Bool)
-> (Grammar -> Grammar -> Grammar)
-> (Grammar -> Grammar -> Grammar)
-> Ord Grammar
Grammar -> Grammar -> Bool
Grammar -> Grammar -> Ordering
Grammar -> Grammar -> Grammar
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 :: Grammar -> Grammar -> Grammar
$cmin :: Grammar -> Grammar -> Grammar
max :: Grammar -> Grammar -> Grammar
$cmax :: Grammar -> Grammar -> Grammar
>= :: Grammar -> Grammar -> Bool
$c>= :: Grammar -> Grammar -> Bool
> :: Grammar -> Grammar -> Bool
$c> :: Grammar -> Grammar -> Bool
<= :: Grammar -> Grammar -> Bool
$c<= :: Grammar -> Grammar -> Bool
< :: Grammar -> Grammar -> Bool
$c< :: Grammar -> Grammar -> Bool
compare :: Grammar -> Grammar -> Ordering
$ccompare :: Grammar -> Grammar -> Ordering
$cp1Ord :: Eq Grammar
Ord, Int -> Grammar -> ShowS
[Grammar] -> ShowS
Grammar -> String
(Int -> Grammar -> ShowS)
-> (Grammar -> String) -> ([Grammar] -> ShowS) -> Show Grammar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Grammar] -> ShowS
$cshowList :: [Grammar] -> ShowS
show :: Grammar -> String
$cshow :: Grammar -> String
showsPrec :: Int -> Grammar -> ShowS
$cshowsPrec :: Int -> Grammar -> ShowS
Show)