{- |
Module      :  ./Adl/Parse.hs
Description :  ADL syntax parser
Copyright   :  (c) Stef Joosten, Christian Maeder DFKI GmbH 2010
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

-}

module Adl.Parse where

import Adl.As

import Common.Id
import Common.Lexer (parseToken)
import Common.Parsec
import Common.Token (criticalKeywords)

import Control.Monad
import Text.ParserCombinators.Parsec

keywordstxt :: [String]
keywordstxt :: [String]
keywordstxt = (Prop -> String) -> [Prop] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Prop -> String
forall a. Show a => a -> String
showUp [Prop]
allProps [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
  [ "CONTEXT", "ENDCONTEXT", "EXTENDS"
  , "PATTERN", "ENDPATTERN"
  , "SERVICE", "INITIAL", "SQLPLUG", "PHPPLUG"
  , "POPULATION", "CONTAINS"
  , "PROP", "ALWAYS"
  , "RULE", "MAINTAINS", "SIGNALS", "SIGNAL", "ON"
  , "RELATION", "CONCEPT", "KEY"
  , "IMPORT", "GEN", "ISA", "I", "V", "S"
  , "PRAGMA", "EXPLANATION", "EXPLAIN", "IN", "REF", "ENGLISH", "DUTCH"
  , "ONE", "BIND", "TOPHP", "BINDING", "BYPLUG"
  ]

-- | a line comment starts with --. In haskell this may be part of an operator.
lineComment :: CharParser st String
lineComment :: CharParser st String
lineComment = String -> CharParser st String
forall st. String -> CharParser st String
tryString "--" CharParser st String
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> ParsecT String st Identity Char -> CharParser st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf "\n")

skip :: CharParser st ()
skip :: CharParser st ()
skip = CharParser st () -> CharParser st ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (CharParser st () -> CharParser st ())
-> CharParser st () -> CharParser st ()
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity Char -> CharParser st ()
forall (m :: * -> *) a. Monad m => m a -> m ()
forget ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
  CharParser st () -> CharParser st () -> CharParser st ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String st Identity String -> CharParser st ()
forall (m :: * -> *) a. Monad m => m a -> m ()
forget (String -> String -> ParsecT String st Identity String
forall st. String -> String -> CharParser st String
nestedComment "{-" "-}" ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String st Identity String
forall st. CharParser st String
lineComment)

pChar :: CharParser st Char
pChar :: CharParser st Char
pChar = CharParser st Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum CharParser st Char -> CharParser st Char -> CharParser st Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "_'"

pKeyS :: String -> CharParser st String
pKeyS :: String -> CharParser st String
pKeyS s :: String
s = CharParser st String -> CharParser st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> CharParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
s CharParser st String
-> ParsecT String st Identity () -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT String st Identity Char -> ParsecT String st Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT String st Identity Char
forall st. CharParser st Char
pChar) CharParser st String
-> ParsecT String st Identity () -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT String st Identity ()
forall st. CharParser st ()
skip

pKey :: String -> CharParser st ()
pKey :: String -> CharParser st ()
pKey = ParsecT String st Identity String -> CharParser st ()
forall (m :: * -> *) a. Monad m => m a -> m ()
forget (ParsecT String st Identity String -> CharParser st ())
-> (String -> ParsecT String st Identity String)
-> String
-> CharParser st ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT String st Identity String
forall st. String -> CharParser st String
pKeyS

pSymC :: String -> String -> CharParser st String
pSymC :: String -> String -> CharParser st String
pSymC s :: String
s cs :: String
cs = CharParser st String -> CharParser st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> CharParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
s CharParser st String
-> ParsecT String st Identity () -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT String st Identity Char -> ParsecT String st Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
cs)) CharParser st String
-> ParsecT String st Identity () -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT String st Identity ()
forall st. CharParser st ()
skip

-- do not parse a double colon
pColon :: CharParser st String
pColon :: CharParser st String
pColon = String -> String -> CharParser st String
forall st. String -> String -> CharParser st String
pSymC ":" ":"

-- do not parse --, ->, or -|
pMinus :: CharParser st String
pMinus :: CharParser st String
pMinus = String -> String -> CharParser st String
forall st. String -> String -> CharParser st String
pSymC "-" "->|"

pSymS :: String -> CharParser st String
pSymS :: String -> CharParser st String
pSymS s :: String
s = String -> CharParser st String
forall st. String -> CharParser st String
tryString String
s CharParser st String
-> ParsecT String st Identity () -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT String st Identity ()
forall st. CharParser st ()
skip

pSym :: String -> CharParser st ()
pSym :: String -> CharParser st ()
pSym = ParsecT String st Identity String -> CharParser st ()
forall (m :: * -> *) a. Monad m => m a -> m ()
forget (ParsecT String st Identity String -> CharParser st ())
-> (String -> ParsecT String st Identity String)
-> String
-> CharParser st ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT String st Identity String
forall st. String -> CharParser st String
pSymS

pComma :: CharParser st ()
pComma :: CharParser st ()
pComma = String -> CharParser st ()
forall st. String -> CharParser st ()
pSym ","

pEqual :: CharParser st ()
pEqual :: CharParser st ()
pEqual = String -> CharParser st ()
forall st. String -> CharParser st ()
pSym "="

pGenParens :: String -> String -> CharParser st a -> CharParser st a
pGenParens :: String -> String -> CharParser st a -> CharParser st a
pGenParens o :: String
o c :: String
c p :: CharParser st a
p =
  String -> CharParser st ()
forall st. String -> CharParser st ()
pSym String
o CharParser st () -> CharParser st a -> CharParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser st a
p CharParser st a -> CharParser st () -> CharParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> CharParser st ()
forall st. String -> CharParser st ()
pSym String
c

pParens :: CharParser st a -> CharParser st a
pParens :: CharParser st a -> CharParser st a
pParens = String -> String -> CharParser st a -> CharParser st a
forall st a. String -> String -> CharParser st a -> CharParser st a
pGenParens "(" ")"

pSqBrackets :: CharParser st a -> CharParser st a
pSqBrackets :: CharParser st a -> CharParser st a
pSqBrackets = String -> String -> CharParser st a -> CharParser st a
forall st a. String -> String -> CharParser st a -> CharParser st a
pGenParens "[" "]"

pConid :: CharParser st String
pConid :: CharParser st String
pConid = [String] -> CharParser st String -> CharParser st String
forall st. [String] -> CharParser st String -> CharParser st String
reserved [String]
keywordstxt (ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
upper ParsecT String st Identity Char
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT String st Identity Char -> CharParser st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String st Identity Char
forall st. CharParser st Char
pChar) CharParser st String
-> ParsecT String st Identity () -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT String st Identity ()
forall st. CharParser st ()
skip

-- | with true argument exclude CASL keywords
pVarid :: Bool -> CharParser st String
pVarid :: Bool -> CharParser st String
pVarid b :: Bool
b = (if Bool
b then [String] -> CharParser st String -> CharParser st String
forall st. [String] -> CharParser st String -> CharParser st String
reserved [String]
criticalKeywords else CharParser st String -> CharParser st String
forall a. a -> a
id)
  (CharParser st String -> CharParser st String)
-> CharParser st String -> CharParser st String
forall a b. (a -> b) -> a -> b
$ ((ParsecT String st Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
lower ParsecT String st Identity Char
-> ParsecT String st Identity Char
-> ParsecT String st Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '_') ParsecT String st Identity Char
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> ParsecT String st Identity Char -> CharParser st String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String st Identity Char
forall st. CharParser st Char
pChar) CharParser st String
-> ParsecT String st Identity () -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT String st Identity ()
forall st. CharParser st ()
skip

pString :: CharParser st String
pString :: CharParser st String
pString = (CharParser st String
forall st. CharParser st String
stringLit CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st String
forall st. CharParser st String
sQuoted) CharParser st String
-> ParsecT String st Identity () -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT String st Identity ()
forall st. CharParser st ()
skip

pADLid :: CharParser st Token
pADLid :: CharParser st Token
pADLid = CharParser st String -> CharParser st Token
forall st. CharParser st String -> CharParser st Token
parseToken (CharParser st String -> CharParser st Token)
-> CharParser st String -> CharParser st Token
forall a b. (a -> b) -> a -> b
$ CharParser st String
forall st. CharParser st String
pConid CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> CharParser st String
forall st. Bool -> CharParser st String
pVarid Bool
False CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st String
forall st. CharParser st String
pString

-- | parse contexts but do not require CONTEXT blocks
pArchitecture :: CharParser st Context
pArchitecture :: CharParser st Context
pArchitecture = CharParser st Context
forall st. CharParser st Context
pContext
  CharParser st Context
-> CharParser st Context -> CharParser st Context
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([PatElem] -> Context)
-> ParsecT String st Identity [PatElem] -> CharParser st Context
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Token -> [PatElem] -> Context
mkContext Maybe Token
forall a. Maybe a
Nothing) (ParsecT String st Identity [[PatElem]]
-> ParsecT String st Identity [PatElem]
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (ParsecT String st Identity [[PatElem]]
 -> ParsecT String st Identity [PatElem])
-> ParsecT String st Identity [[PatElem]]
-> ParsecT String st Identity [PatElem]
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity [PatElem]
-> ParsecT String st Identity [[PatElem]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String st Identity [PatElem]
 -> ParsecT String st Identity [[PatElem]])
-> ParsecT String st Identity [PatElem]
-> ParsecT String st Identity [[PatElem]]
forall a b. (a -> b) -> a -> b
$ Bool -> ParsecT String st Identity [PatElem]
forall st. Bool -> CharParser st [PatElem]
pContextElement Bool
True)

pContext :: CharParser st Context
pContext :: CharParser st Context
pContext = do
  String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "CONTEXT"
  Token
c <- CharParser st String -> CharParser st Token
forall st. CharParser st String -> CharParser st Token
parseToken CharParser st String
forall st. CharParser st String
pConid
  () -> CharParser st () -> CharParser st ()
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option () (CharParser st () -> CharParser st ())
-> CharParser st () -> CharParser st ()
forall a b. (a -> b) -> a -> b
$ do
    CharParser st String
forall st. CharParser st String
pColon
    Bool -> CharParser st Rule
forall st. Bool -> CharParser st Rule
pRule Bool
False
    ParsecT String st Identity [String] -> CharParser st ()
forall (m :: * -> *) a. Monad m => m a -> m ()
forget (ParsecT String st Identity [String] -> CharParser st ())
-> ParsecT String st Identity [String] -> CharParser st ()
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity [String]
-> ParsecT String st Identity [String]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL (ParsecT String st Identity [String]
 -> ParsecT String st Identity [String])
-> ParsecT String st Identity [String]
-> ParsecT String st Identity [String]
forall a b. (a -> b) -> a -> b
$ do
      String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "BINDING"
      CharParser st String
-> CharParser st () -> ParsecT String st Identity [String]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 CharParser st String
forall st. CharParser st String
pBind CharParser st ()
forall st. CharParser st ()
pComma
  ParsecT String st Identity [String]
-> ParsecT String st Identity [String]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL (ParsecT String st Identity [String]
 -> ParsecT String st Identity [String])
-> ParsecT String st Identity [String]
-> ParsecT String st Identity [String]
forall a b. (a -> b) -> a -> b
$ do
    String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "EXTENDS"
    CharParser st String
-> CharParser st () -> ParsecT String st Identity [String]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 CharParser st String
forall st. CharParser st String
pConid CharParser st ()
forall st. CharParser st ()
pComma
  [[PatElem]]
ps <- ParsecT String st Identity [PatElem]
-> ParsecT String st Identity [[PatElem]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String st Identity [PatElem]
 -> ParsecT String st Identity [[PatElem]])
-> ParsecT String st Identity [PatElem]
-> ParsecT String st Identity [[PatElem]]
forall a b. (a -> b) -> a -> b
$ Bool -> ParsecT String st Identity [PatElem]
forall st. Bool -> CharParser st [PatElem]
pContextElement Bool
False
  String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "ENDCONTEXT"
  Context -> CharParser st Context
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> CharParser st Context)
-> Context -> CharParser st Context
forall a b. (a -> b) -> a -> b
$ Maybe Token -> [PatElem] -> Context
mkContext (Token -> Maybe Token
forall a. a -> Maybe a
Just Token
c) ([PatElem] -> Context) -> [PatElem] -> Context
forall a b. (a -> b) -> a -> b
$ [[PatElem]] -> [PatElem]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[PatElem]]
ps

pBind :: CharParser st String
pBind :: CharParser st String
pBind = String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "BIND" CharParser st ()
-> ParsecT String st Identity [PatElem]
-> ParsecT String st Identity [PatElem]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT String st Identity [PatElem]
forall st. Bool -> CharParser st [PatElem]
pDeclaration Bool
False ParsecT String st Identity [PatElem]
-> CharParser st () -> ParsecT String st Identity [PatElem]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "TOPHP"
  ParsecT String st Identity [PatElem]
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (CharParser st String
forall st. CharParser st String
pConid CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st String
forall st. CharParser st String
pString)

-- | parse a context element but do not require the PATTERN block
pContextElement :: Bool -> CharParser st [PatElem]
pContextElement :: Bool -> CharParser st [PatElem]
pContextElement b :: Bool
b = CharParser st [PatElem]
forall st. CharParser st [PatElem]
pPattern CharParser st [PatElem]
-> CharParser st [PatElem] -> CharParser st [PatElem]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String st Identity [[PatElem]] -> CharParser st [PatElem]
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (CharParser st [PatElem] -> ParsecT String st Identity [[PatElem]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (CharParser st [PatElem] -> ParsecT String st Identity [[PatElem]])
-> CharParser st [PatElem]
-> ParsecT String st Identity [[PatElem]]
forall a b. (a -> b) -> a -> b
$ Bool -> CharParser st [PatElem]
forall st. Bool -> CharParser st [PatElem]
pPatElem Bool
b)
  CharParser st [PatElem]
-> CharParser st [PatElem] -> CharParser st [PatElem]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String st Identity PatElem -> CharParser st [PatElem]
forall (m :: * -> *) a. Monad m => m a -> m [a]
single (ParsecT String st Identity PatElem
forall st. CharParser st PatElem
pObjDef ParsecT String st Identity PatElem
-> ParsecT String st Identity PatElem
-> ParsecT String st Identity PatElem
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String st Identity PatElem
forall st. CharParser st PatElem
pPopulation)

pPopulation :: CharParser st PatElem
pPopulation :: CharParser st PatElem
pPopulation = do
  String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "POPULATION"
  Relation
r <- Bool -> CharParser st Relation
forall st. Bool -> CharParser st Relation
pMorphism Bool
False
  String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "CONTAINS"
  Bool -> Relation -> CharParser st PatElem
forall st. Bool -> Relation -> CharParser st PatElem
pContent Bool
False Relation
r

pPattern :: CharParser st [PatElem]
pPattern :: CharParser st [PatElem]
pPattern = String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "PATTERN" CharParser st ()
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsecT String st Identity String
forall st. CharParser st String
pConid ParsecT String st Identity String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String st Identity String
forall st. CharParser st String
pString)
           ParsecT String st Identity String
-> CharParser st [PatElem] -> CharParser st [PatElem]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity [[PatElem]] -> CharParser st [PatElem]
forall (m :: * -> *) a. Monad m => m [[a]] -> m [a]
flat (CharParser st [PatElem] -> ParsecT String st Identity [[PatElem]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (CharParser st [PatElem] -> ParsecT String st Identity [[PatElem]])
-> CharParser st [PatElem]
-> ParsecT String st Identity [[PatElem]]
forall a b. (a -> b) -> a -> b
$ Bool -> CharParser st [PatElem]
forall st. Bool -> CharParser st [PatElem]
pPatElem Bool
False)
           CharParser st [PatElem]
-> CharParser st () -> CharParser st [PatElem]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "ENDPATTERN"

pPatElem :: Bool -> CharParser st [PatElem]
pPatElem :: Bool -> CharParser st [PatElem]
pPatElem b :: Bool
b = Bool -> CharParser st [PatElem]
forall st. Bool -> CharParser st [PatElem]
pDeclaration Bool
b CharParser st [PatElem]
-> CharParser st [PatElem] -> CharParser st [PatElem]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st [PatElem]
forall st. CharParser st [PatElem]
pConceptDef CharParser st [PatElem]
-> CharParser st [PatElem] -> CharParser st [PatElem]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st [PatElem]
forall st. CharParser st [PatElem]
pExplain
  CharParser st [PatElem]
-> CharParser st [PatElem] -> CharParser st [PatElem]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String st Identity PatElem -> CharParser st [PatElem]
forall (m :: * -> *) a. Monad m => m a -> m [a]
single (Bool -> ParsecT String st Identity PatElem
forall st. Bool -> CharParser st PatElem
pRuleDef Bool
b ParsecT String st Identity PatElem
-> ParsecT String st Identity PatElem
-> ParsecT String st Identity PatElem
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String st Identity PatElem
forall st. CharParser st PatElem
pGen ParsecT String st Identity PatElem
-> ParsecT String st Identity PatElem
-> ParsecT String st Identity PatElem
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String st Identity PatElem
forall st. CharParser st PatElem
pKeyDef)

pDeclaration :: Bool -> CharParser st [PatElem]
pDeclaration :: Bool -> CharParser st [PatElem]
pDeclaration b :: Bool
b = do
  Token
n <- GenParser Char st Token -> GenParser Char st Token
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st Token -> GenParser Char st Token)
-> GenParser Char st Token -> GenParser Char st Token
forall a b. (a -> b) -> a -> b
$ CharParser st String -> GenParser Char st Token
forall st. CharParser st String -> CharParser st Token
parseToken (Bool -> CharParser st String
forall st. Bool -> CharParser st String
pVarid Bool
b) GenParser Char st Token
-> ParsecT String st Identity () -> GenParser Char st Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> ParsecT String st Identity ()
forall st. String -> CharParser st ()
pSym "::"
  Concept
c1 <- CharParser st Concept
forall st. CharParser st Concept
pConcept
  Token
s <- CharParser st String -> GenParser Char st Token
forall st. CharParser st String -> CharParser st Token
parseToken (CharParser st String -> GenParser Char st Token)
-> CharParser st String -> GenParser Char st Token
forall a b. (a -> b) -> a -> b
$ String -> CharParser st String
forall st. String -> CharParser st String
pSymS "*" CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> CharParser st String
forall st. String -> CharParser st String
pSymS "->"
  let ps :: [RangedProp]
ps = if Token -> String
tokStr Token
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "->" then
        (Prop -> RangedProp) -> [Prop] -> [RangedProp]
forall a b. (a -> b) -> [a] -> [b]
map ((Prop -> Range -> RangedProp) -> Range -> Prop -> RangedProp
forall a b c. (a -> b -> c) -> b -> a -> c
flip Prop -> Range -> RangedProp
RangedProp (Range -> Prop -> RangedProp) -> Range -> Prop -> RangedProp
forall a b. (a -> b) -> a -> b
$ Token -> Range
tokPos Token
s) [Prop
Uni, Prop
Tot] else []
  Concept
c2 <- CharParser st Concept
forall st. CharParser st Concept
pConcept
  CharParser st Bool
forall st. CharParser st Bool
pByplug
  [RangedProp]
as <- GenParser Char st [RangedProp] -> GenParser Char st [RangedProp]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL GenParser Char st [RangedProp]
forall st. CharParser st [RangedProp]
pProps
  CharParser st Bool
forall st. CharParser st Bool
pByplug
  GenParser Char st [String] -> GenParser Char st [String]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL GenParser Char st [String]
forall st. CharParser st [String]
pPragma
  CharParser st String -> CharParser st String
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL (CharParser st String -> CharParser st String)
-> CharParser st String -> CharParser st String
forall a b. (a -> b) -> a -> b
$ do
    String -> ParsecT String st Identity ()
forall st. String -> CharParser st ()
pKey "EXPLANATION"
    CharParser st String
forall st. CharParser st String
pString
  let r :: Relation
r = Token -> RelType -> Relation
Sgn Token
n (RelType -> Relation) -> RelType -> Relation
forall a b. (a -> b) -> a -> b
$ Concept -> Concept -> RelType
RelType Concept
c1 Concept
c2
  [PatElem]
p <- CharParser st [PatElem] -> CharParser st [PatElem]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL (CharParser st [PatElem] -> CharParser st [PatElem])
-> CharParser st [PatElem] -> CharParser st [PatElem]
forall a b. (a -> b) -> a -> b
$ do
    ParsecT String st Identity ()
forall st. CharParser st ()
pEqual
    ParsecT String st Identity PatElem -> CharParser st [PatElem]
forall (m :: * -> *) a. Monad m => m a -> m [a]
single (ParsecT String st Identity PatElem -> CharParser st [PatElem])
-> ParsecT String st Identity PatElem -> CharParser st [PatElem]
forall a b. (a -> b) -> a -> b
$ Bool -> Relation -> ParsecT String st Identity PatElem
forall st. Bool -> Relation -> CharParser st PatElem
pContent Bool
True Relation
r
  ()
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option () (ParsecT String st Identity () -> ParsecT String st Identity ())
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity ()
forall st. String -> CharParser st ()
pSym "."
  [PatElem] -> CharParser st [PatElem]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PatElem] -> CharParser st [PatElem])
-> [PatElem] -> CharParser st [PatElem]
forall a b. (a -> b) -> a -> b
$ [RangedProp] -> Relation -> Bool -> PatElem
Pm ([RangedProp]
ps [RangedProp] -> [RangedProp] -> [RangedProp]
forall a. [a] -> [a] -> [a]
++ [RangedProp]
as) Relation
r (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [PatElem] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PatElem]
p) PatElem -> [PatElem] -> [PatElem]
forall a. a -> [a] -> [a]
: [PatElem]
p

pRangedProp :: Prop -> CharParser st RangedProp
pRangedProp :: Prop -> CharParser st RangedProp
pRangedProp p :: Prop
p = (Range -> Prop -> RangedProp)
-> ParsecT String st Identity Range
-> ParsecT String st Identity Prop
-> CharParser st RangedProp
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 ((Prop -> Range -> RangedProp) -> Range -> Prop -> RangedProp
forall a b c. (a -> b -> c) -> b -> a -> c
flip Prop -> Range -> RangedProp
RangedProp)
    ((Token -> Range)
-> ParsecT String st Identity Token
-> ParsecT String st Identity Range
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Token -> Range
tokPos (ParsecT String st Identity Token
 -> ParsecT String st Identity Range)
-> ParsecT String st Identity Token
-> ParsecT String st Identity Range
forall a b. (a -> b) -> a -> b
$ CharParser st String -> ParsecT String st Identity Token
forall st. CharParser st String -> CharParser st Token
parseToken (CharParser st String -> ParsecT String st Identity Token)
-> CharParser st String -> ParsecT String st Identity Token
forall a b. (a -> b) -> a -> b
$ String -> CharParser st String
forall st. String -> CharParser st String
pKeyS (String -> CharParser st String) -> String -> CharParser st String
forall a b. (a -> b) -> a -> b
$ Prop -> String
forall a. Show a => a -> String
showUp Prop
p) (ParsecT String st Identity Prop -> CharParser st RangedProp)
-> ParsecT String st Identity Prop -> CharParser st RangedProp
forall a b. (a -> b) -> a -> b
$ Prop -> ParsecT String st Identity Prop
forall (m :: * -> *) a. Monad m => a -> m a
return Prop
p

pProps :: CharParser st [RangedProp]
pProps :: CharParser st [RangedProp]
pProps = CharParser st [RangedProp] -> CharParser st [RangedProp]
forall st a. CharParser st a -> CharParser st a
pSqBrackets (CharParser st [RangedProp] -> CharParser st [RangedProp])
-> CharParser st [RangedProp] -> CharParser st [RangedProp]
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity RangedProp
-> ParsecT String st Identity () -> CharParser st [RangedProp]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy
  ([ParsecT String st Identity RangedProp]
-> ParsecT String st Identity RangedProp
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT String st Identity RangedProp]
 -> ParsecT String st Identity RangedProp)
-> [ParsecT String st Identity RangedProp]
-> ParsecT String st Identity RangedProp
forall a b. (a -> b) -> a -> b
$ (Prop -> ParsecT String st Identity RangedProp)
-> [Prop] -> [ParsecT String st Identity RangedProp]
forall a b. (a -> b) -> [a] -> [b]
map Prop -> ParsecT String st Identity RangedProp
forall st. Prop -> CharParser st RangedProp
pRangedProp [Prop]
allProps) ParsecT String st Identity ()
forall st. CharParser st ()
pComma

pPragma :: CharParser st [String]
pPragma :: CharParser st [String]
pPragma = String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "PRAGMA" CharParser st ()
-> CharParser st [String] -> CharParser st [String]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity String -> CharParser st [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String st Identity String
forall st. CharParser st String
pString

pByplug :: CharParser st Bool
pByplug :: CharParser st Bool
pByplug = Bool -> CharParser st Bool -> CharParser st Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (CharParser st Bool -> CharParser st Bool)
-> CharParser st Bool -> CharParser st Bool
forall a b. (a -> b) -> a -> b
$ String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "BYPLUG" CharParser st () -> CharParser st Bool -> CharParser st Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> CharParser st Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

pConceptDef :: CharParser st [PatElem]
pConceptDef :: CharParser st [PatElem]
pConceptDef = do
  String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "CONCEPT"
  CharParser st Concept
forall st. CharParser st Concept
pConcept
  CharParser st Bool
forall st. CharParser st Bool
pByplug
  CharParser st String
forall st. CharParser st String
pString
  CharParser st String -> CharParser st String
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL CharParser st String
forall st. CharParser st String
pString
  [PatElem] -> CharParser st [PatElem]
forall (m :: * -> *) a. Monad m => a -> m a
return []

pKeyDef :: CharParser st PatElem
pKeyDef :: CharParser st PatElem
pKeyDef = do
  String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "KEY"
  Token
t <- CharParser st Token
forall st. CharParser st Token
pLabelProps
  Concept
c <- CharParser st Concept
forall st. CharParser st Concept
pConcept CharParser st Concept
-> CharParser st Concept -> CharParser st Concept
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "I" CharParser st () -> CharParser st Concept -> CharParser st Concept
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser st Concept -> CharParser st Concept
forall st a. CharParser st a -> CharParser st a
pSqBrackets CharParser st Concept
forall st. CharParser st Concept
pConcept)
  let ks :: ParsecT String u Identity [KeyAtt]
ks = ParsecT String u Identity KeyAtt
-> ParsecT String u Identity ()
-> ParsecT String u Identity [KeyAtt]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 ParsecT String u Identity KeyAtt
forall st. CharParser st KeyAtt
pKeyAtt ParsecT String u Identity ()
forall st. CharParser st ()
pComma
  [KeyAtt]
l <- CharParser st [KeyAtt] -> CharParser st [KeyAtt]
forall st a. CharParser st a -> CharParser st a
pParens CharParser st [KeyAtt]
forall u. ParsecT String u Identity [KeyAtt]
ks CharParser st [KeyAtt]
-> CharParser st [KeyAtt] -> CharParser st [KeyAtt]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st [KeyAtt] -> CharParser st [KeyAtt]
forall st a. CharParser st a -> CharParser st a
pSqBrackets CharParser st [KeyAtt]
forall u. ParsecT String u Identity [KeyAtt]
ks
  PatElem -> CharParser st PatElem
forall (m :: * -> *) a. Monad m => a -> m a
return (PatElem -> CharParser st PatElem)
-> PatElem -> CharParser st PatElem
forall a b. (a -> b) -> a -> b
$ KeyDef -> PatElem
Pk (KeyDef -> PatElem) -> KeyDef -> PatElem
forall a b. (a -> b) -> a -> b
$ Token -> Concept -> [KeyAtt] -> KeyDef
KeyDef Token
t Concept
c [KeyAtt]
l

pLabelProps :: CharParser st Token
pLabelProps :: CharParser st Token
pLabelProps = do
  Token
n <- CharParser st Token
forall st. CharParser st Token
pADLid
  GenParser Char st [Token] -> GenParser Char st [Token]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL (GenParser Char st [Token] -> GenParser Char st [Token])
-> GenParser Char st [Token] -> GenParser Char st [Token]
forall a b. (a -> b) -> a -> b
$ String
-> String -> GenParser Char st [Token] -> GenParser Char st [Token]
forall st a. String -> String -> CharParser st a -> CharParser st a
pGenParens "{" "}" (GenParser Char st [Token] -> GenParser Char st [Token])
-> GenParser Char st [Token] -> GenParser Char st [Token]
forall a b. (a -> b) -> a -> b
$ CharParser st Token
-> ParsecT String st Identity () -> GenParser Char st [Token]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 CharParser st Token
forall st. CharParser st Token
pADLid ParsecT String st Identity ()
forall st. CharParser st ()
pComma
  String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" ParsecT String st Identity String
forall st. CharParser st String
pColon
  Token -> CharParser st Token
forall (m :: * -> *) a. Monad m => a -> m a
return Token
n

pKeyAtt :: CharParser st KeyAtt
pKeyAtt :: CharParser st KeyAtt
pKeyAtt = (Maybe Token -> Rule -> KeyAtt)
-> ParsecT String st Identity (Maybe Token)
-> ParsecT String st Identity Rule
-> CharParser st KeyAtt
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Maybe Token -> Rule -> KeyAtt
KeyAtt (ParsecT String st Identity Token
-> ParsecT String st Identity (Maybe Token)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT String st Identity Token
 -> ParsecT String st Identity (Maybe Token))
-> ParsecT String st Identity Token
-> ParsecT String st Identity (Maybe Token)
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity Token
-> ParsecT String st Identity Token
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String st Identity Token
forall st. CharParser st Token
pLabelProps) (ParsecT String st Identity Rule -> CharParser st KeyAtt)
-> ParsecT String st Identity Rule -> CharParser st KeyAtt
forall a b. (a -> b) -> a -> b
$ Bool -> ParsecT String st Identity Rule
forall st. Bool -> CharParser st Rule
pRule Bool
False

choiceP :: (a -> CharParser st ()) -> [a] -> CharParser st a
choiceP :: (a -> CharParser st ()) -> [a] -> CharParser st a
choiceP p :: a -> CharParser st ()
p = [CharParser st a] -> CharParser st a
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([CharParser st a] -> CharParser st a)
-> ([a] -> [CharParser st a]) -> [a] -> CharParser st a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> CharParser st a) -> [a] -> [CharParser st a]
forall a b. (a -> b) -> [a] -> [b]
map (\ a :: a
a -> a -> CharParser st ()
p a
a CharParser st () -> CharParser st a -> CharParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> CharParser st a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a)

choiceS :: Show a => (String -> CharParser st ()) -> [a] -> CharParser st a
choiceS :: (String -> CharParser st ()) -> [a] -> CharParser st a
choiceS p :: String -> CharParser st ()
p = (a -> CharParser st ()) -> [a] -> CharParser st a
forall a st. (a -> CharParser st ()) -> [a] -> CharParser st a
choiceP ((a -> CharParser st ()) -> [a] -> CharParser st a)
-> (a -> CharParser st ()) -> [a] -> CharParser st a
forall a b. (a -> b) -> a -> b
$ String -> CharParser st ()
p (String -> CharParser st ())
-> (a -> String) -> a -> CharParser st ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

pObjDef :: CharParser st PatElem
pObjDef :: CharParser st PatElem
pObjDef = (Plugin -> Object -> PatElem)
-> ParsecT String st Identity Plugin
-> ParsecT String st Identity Object
-> CharParser st PatElem
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Plugin -> Object -> PatElem
Plug ((Plugin -> CharParser st ())
-> [Plugin] -> ParsecT String st Identity Plugin
forall a st. (a -> CharParser st ()) -> [a] -> CharParser st a
choiceP (String -> CharParser st ()
forall st. String -> CharParser st ()
pKey (String -> CharParser st ())
-> (Plugin -> String) -> Plugin -> CharParser st ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plugin -> String
forall a. Show a => a -> String
showUp)
   [Plugin
Service, Plugin
Sqlplug, Plugin
Phpplug]) ParsecT String st Identity Object
forall st. CharParser st Object
pObj

pObj :: CharParser st Object
pObj :: CharParser st Object
pObj = do
  Token
n <- CharParser st Token
forall st. CharParser st Token
pLabelProps
  Rule
e <- Bool -> CharParser st Rule
forall st. Bool -> CharParser st Rule
pRule Bool
False CharParser st Rule -> CharParser st Rule -> CharParser st Rule
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (RelType -> Rule)
-> ParsecT String st Identity RelType -> CharParser st Rule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Relation -> Rule
Tm (Relation -> Rule) -> (RelType -> Relation) -> RelType -> Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> RelType -> Relation
Sgn (String -> Token
mkSimpleId "I")) ParsecT String st Identity RelType
forall st. CharParser st RelType
pTwo
  [RangedProp]
as <- GenParser Char st [RangedProp] -> GenParser Char st [RangedProp]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL (String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "ALWAYS" CharParser st ()
-> GenParser Char st [RangedProp] -> GenParser Char st [RangedProp]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity RangedProp
-> GenParser Char st [RangedProp]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String st Identity RangedProp
forall st. CharParser st RangedProp
pProp')
  [Object]
os <- GenParser Char st [Object] -> GenParser Char st [Object]
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL (CharParser st ()
forall st. CharParser st ()
pEqual CharParser st ()
-> GenParser Char st [Object] -> GenParser Char st [Object]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char st [Object] -> GenParser Char st [Object]
forall st a. CharParser st a -> CharParser st a
pSqBrackets (CharParser st Object
-> CharParser st () -> GenParser Char st [Object]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy CharParser st Object
forall st. CharParser st Object
pObj CharParser st ()
forall st. CharParser st ()
pComma))
  Object -> CharParser st Object
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> CharParser st Object) -> Object -> CharParser st Object
forall a b. (a -> b) -> a -> b
$ Token -> Rule -> [RangedProp] -> [Object] -> Object
Object Token
n Rule
e [RangedProp]
as [Object]
os

pProp' :: CharParser st RangedProp
pProp' :: CharParser st RangedProp
pProp' = [CharParser st RangedProp] -> CharParser st RangedProp
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([CharParser st RangedProp] -> CharParser st RangedProp)
-> [CharParser st RangedProp] -> CharParser st RangedProp
forall a b. (a -> b) -> a -> b
$ (Prop -> CharParser st RangedProp)
-> [Prop] -> [CharParser st RangedProp]
forall a b. (a -> b) -> [a] -> [b]
map Prop -> CharParser st RangedProp
forall st. Prop -> CharParser st RangedProp
pRangedProp [Prop
Uni, Prop
Tot, Prop
Prop]

pExplain :: CharParser st [PatElem]
pExplain :: CharParser st [PatElem]
pExplain = do
  String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "EXPLAIN"
  (String -> CharParser st ()) -> [String] -> CharParser st String
forall a st. (a -> CharParser st ()) -> [a] -> CharParser st a
choiceP String -> CharParser st ()
forall st. String -> CharParser st ()
pKey
    [ "CONCEPT", "RELATION", "RULE", "KEY", "SERVICE", "PATTERN"
    , "POPULATION", "SQLPLUG", "PHPPLUG" ]
  CharParser st Token
forall st. CharParser st Token
pADLid
  CharParser st String
forall st. CharParser st String
pLanguageID
  CharParser st String
forall st. CharParser st String
pRefID
  CharParser st String
forall st. CharParser st String
pExpl
  [PatElem] -> CharParser st [PatElem]
forall (m :: * -> *) a. Monad m => a -> m a
return []

pLanguageID :: CharParser st String
pLanguageID :: CharParser st String
pLanguageID = String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "IN" CharParser st () -> CharParser st String -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> CharParser st String
forall st. String -> CharParser st String
pKeyS "DUTCH" CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> CharParser st String
forall st. String -> CharParser st String
pKeyS "ENGLISH")

pRefID :: CharParser st String
pRefID :: CharParser st String
pRefID = CharParser st String -> CharParser st String
forall tok st a. GenParser tok st [a] -> GenParser tok st [a]
optionL (CharParser st String -> CharParser st String)
-> CharParser st String -> CharParser st String
forall a b. (a -> b) -> a -> b
$ String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "REF" CharParser st () -> CharParser st String -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser st String
forall st. CharParser st String
pString

pExpl :: CharParser st String
pExpl :: CharParser st String
pExpl = String -> String -> CharParser st String
forall st. String -> String -> CharParser st String
nestedComment "{+" "-}"

pContent :: Bool -> Relation -> CharParser st PatElem
pContent :: Bool -> Relation -> CharParser st PatElem
pContent b :: Bool
b r :: Relation
r = ([Pair] -> PatElem)
-> ParsecT String st Identity [Pair] -> CharParser st PatElem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Relation -> [Pair] -> PatElem
Population Bool
b Relation
r) (ParsecT String st Identity [Pair] -> CharParser st PatElem)
-> ParsecT String st Identity [Pair] -> CharParser st PatElem
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity [Pair]
-> ParsecT String st Identity [Pair]
forall st a. CharParser st a -> CharParser st a
pSqBrackets (ParsecT String st Identity [Pair]
 -> ParsecT String st Identity [Pair])
-> ParsecT String st Identity [Pair]
-> ParsecT String st Identity [Pair]
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity Pair
-> ParsecT String st Identity ()
-> ParsecT String st Identity [Pair]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT String st Identity Pair
forall st. CharParser st Pair
pRecord (ParsecT String st Identity ()
 -> ParsecT String st Identity [Pair])
-> ParsecT String st Identity ()
-> ParsecT String st Identity [Pair]
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity ()
forall st. String -> CharParser st ()
pSym ";"

pRecord :: CharParser st Pair
pRecord :: CharParser st Pair
pRecord = let ps :: CharParser st Token
ps = CharParser st String -> CharParser st Token
forall st. CharParser st String -> CharParser st Token
parseToken CharParser st String
forall st. CharParser st String
pString in
  CharParser st Pair -> CharParser st Pair
forall st a. CharParser st a -> CharParser st a
pParens (CharParser st Pair -> CharParser st Pair)
-> CharParser st Pair -> CharParser st Pair
forall a b. (a -> b) -> a -> b
$ (Token -> Token -> Pair)
-> ParsecT String st Identity Token
-> ParsecT String st Identity Token
-> CharParser st Pair
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Token -> Token -> Pair
Pair ParsecT String st Identity Token
forall st. CharParser st Token
ps (ParsecT String st Identity Token -> CharParser st Pair)
-> ParsecT String st Identity Token -> CharParser st Pair
forall a b. (a -> b) -> a -> b
$ CharParser st ()
forall st. CharParser st ()
pComma CharParser st ()
-> ParsecT String st Identity Token
-> ParsecT String st Identity Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity Token
forall st. CharParser st Token
ps

pRuleDef :: Bool -> CharParser st PatElem
pRuleDef :: Bool -> CharParser st PatElem
pRuleDef b :: Bool
b = do
  RuleHeader
h <- RuleHeader
-> ParsecT String st Identity RuleHeader
-> ParsecT String st Identity RuleHeader
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option RuleHeader
Always ParsecT String st Identity RuleHeader
forall st. CharParser st RuleHeader
pSignalOrAlways
  Rule
r <- Bool -> CharParser st Rule
forall st. Bool -> CharParser st Rule
pRule (Bool -> CharParser st Rule) -> Bool -> CharParser st Rule
forall a b. (a -> b) -> a -> b
$ Bool
b Bool -> Bool -> Bool
&& RuleHeader
h RuleHeader -> RuleHeader -> Bool
forall a. Eq a => a -> a -> Bool
== RuleHeader
Always
  ()
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option () (ParsecT String st Identity () -> ParsecT String st Identity ())
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall a b. (a -> b) -> a -> b
$ do
    String -> ParsecT String st Identity ()
forall st. String -> CharParser st ()
pKey "COMPUTING"
    Bool -> CharParser st Relation
forall st. Bool -> CharParser st Relation
pMorphism Bool
False
    () -> ParsecT String st Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  String
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (ParsecT String st Identity String
 -> ParsecT String st Identity String)
-> ParsecT String st Identity String
-> ParsecT String st Identity String
forall a b. (a -> b) -> a -> b
$ do
    String -> ParsecT String st Identity ()
forall st. String -> CharParser st ()
pKey "EXPLANATION"
    ParsecT String st Identity String
forall st. CharParser st String
pString
  PatElem -> CharParser st PatElem
forall (m :: * -> *) a. Monad m => a -> m a
return (PatElem -> CharParser st PatElem)
-> PatElem -> CharParser st PatElem
forall a b. (a -> b) -> a -> b
$ RuleHeader -> Rule -> PatElem
Pr RuleHeader
h Rule
r

pSignalOrAlways :: CharParser st RuleHeader
pSignalOrAlways :: CharParser st RuleHeader
pSignalOrAlways =
  (Token -> RuleHeader)
-> ParsecT String st Identity Token -> CharParser st RuleHeader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RuleKind -> Token -> RuleHeader
RuleHeader RuleKind
SignalOn) (String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "SIGNAL" CharParser st ()
-> ParsecT String st Identity Token
-> ParsecT String st Identity Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity Token
forall st. CharParser st Token
pADLid ParsecT String st Identity Token
-> CharParser st () -> ParsecT String st Identity Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "ON")
  CharParser st RuleHeader
-> CharParser st RuleHeader -> CharParser st RuleHeader
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "RULE" CharParser st ()
-> CharParser st RuleHeader -> CharParser st RuleHeader
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Token -> RuleKind -> RuleHeader)
-> ParsecT String st Identity Token
-> ParsecT String st Identity RuleKind
-> CharParser st RuleHeader
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 ((RuleKind -> Token -> RuleHeader)
-> Token -> RuleKind -> RuleHeader
forall a b c. (a -> b -> c) -> b -> a -> c
flip RuleKind -> Token -> RuleHeader
RuleHeader) ParsecT String st Identity Token
forall st. CharParser st Token
pADLid
         ((RuleKind -> CharParser st ())
-> [RuleKind] -> ParsecT String st Identity RuleKind
forall a st. (a -> CharParser st ()) -> [a] -> CharParser st a
choiceP (String -> CharParser st ()
forall st. String -> CharParser st ()
pKey (String -> CharParser st ())
-> (RuleKind -> String) -> RuleKind -> CharParser st ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuleKind -> String
showRuleKind) [RuleKind
Maintains, RuleKind
Signals]))

pGen :: CharParser st PatElem
pGen :: CharParser st PatElem
pGen = do
  String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "GEN"
  Concept
c1 <- CharParser st Concept
forall st. CharParser st Concept
pConcept
  String -> CharParser st ()
forall st. String -> CharParser st ()
pKey "ISA"
  Concept
c2 <- CharParser st Concept
forall st. CharParser st Concept
pConcept
  PatElem -> CharParser st PatElem
forall (m :: * -> *) a. Monad m => a -> m a
return (PatElem -> CharParser st PatElem)
-> PatElem -> CharParser st PatElem
forall a b. (a -> b) -> a -> b
$ Concept -> Concept -> PatElem
Pg Concept
c1 Concept
c2

pTwo :: CharParser st RelType
pTwo :: CharParser st RelType
pTwo = RelType -> CharParser st RelType -> CharParser st RelType
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Concept -> Concept -> RelType
RelType Concept
Anything Concept
Anything)
  (CharParser st RelType -> CharParser st RelType)
-> CharParser st RelType -> CharParser st RelType
forall a b. (a -> b) -> a -> b
$ CharParser st RelType -> CharParser st RelType
forall st a. CharParser st a -> CharParser st a
pSqBrackets (CharParser st RelType -> CharParser st RelType)
-> CharParser st RelType -> CharParser st RelType
forall a b. (a -> b) -> a -> b
$ do
  Concept
c1 <- CharParser st Concept
forall st. CharParser st Concept
pConcept
  Concept
c2 <- Concept -> CharParser st Concept -> CharParser st Concept
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Concept
c1 (CharParser st Concept -> CharParser st Concept)
-> CharParser st Concept -> CharParser st Concept
forall a b. (a -> b) -> a -> b
$ do
    String -> CharParser st ()
forall st. String -> CharParser st ()
pSym "*"
    CharParser st Concept
forall st. CharParser st Concept
pConcept
  RelType -> CharParser st RelType
forall (m :: * -> *) a. Monad m => a -> m a
return (RelType -> CharParser st RelType)
-> RelType -> CharParser st RelType
forall a b. (a -> b) -> a -> b
$ Concept -> Concept -> RelType
RelType Concept
c1 Concept
c2

pConcept :: CharParser st Concept
pConcept :: CharParser st Concept
pConcept = (Token -> Concept)
-> ParsecT String st Identity Token -> CharParser st Concept
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Token -> Concept
C (ParsecT String st Identity Token -> CharParser st Concept)
-> (CharParser st String -> ParsecT String st Identity Token)
-> CharParser st String
-> CharParser st Concept
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharParser st String -> ParsecT String st Identity Token
forall st. CharParser st String -> CharParser st Token
parseToken (CharParser st String -> CharParser st Concept)
-> CharParser st String -> CharParser st Concept
forall a b. (a -> b) -> a -> b
$ CharParser st String
forall st. CharParser st String
pConid CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> CharParser st String
forall st. CharParser st String
pString CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> CharParser st String
forall st. String -> CharParser st String
pKeyS "ONE"

pMorphism :: Bool -> CharParser st Relation
pMorphism :: Bool -> CharParser st Relation
pMorphism b :: Bool
b = do
  Token
nm <- CharParser st String -> CharParser st Token
forall st. CharParser st String -> CharParser st Token
parseToken (CharParser st String -> CharParser st Token)
-> CharParser st String -> CharParser st Token
forall a b. (a -> b) -> a -> b
$ (String -> CharParser st ()) -> [String] -> CharParser st String
forall a st. (a -> CharParser st ()) -> [a] -> CharParser st a
choiceP String -> CharParser st ()
forall st. String -> CharParser st ()
pKey [String]
bRels CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> CharParser st String
forall st. Bool -> CharParser st String
pVarid Bool
b CharParser st String
-> CharParser st String -> CharParser st String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (CharParser st String
forall st. CharParser st String
sQuoted CharParser st String -> CharParser st () -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< CharParser st ()
forall st. CharParser st ()
skip)
  RelType
ty <- CharParser st RelType
forall st. CharParser st RelType
pTwo
  Relation -> CharParser st Relation
forall (m :: * -> *) a. Monad m => a -> m a
return (Relation -> CharParser st Relation)
-> Relation -> CharParser st Relation
forall a b. (a -> b) -> a -> b
$ Token -> RelType -> Relation
Sgn Token
nm RelType
ty

pRule :: Bool -> CharParser st Rule
pRule :: Bool -> CharParser st Rule
pRule = MulOp -> CharParser st Rule -> CharParser st Rule
forall st. MulOp -> CharParser st Rule -> CharParser st Rule
pPrec MulOp
Re (CharParser st Rule -> CharParser st Rule)
-> (Bool -> CharParser st Rule) -> Bool -> CharParser st Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CharParser st Rule
forall st. Bool -> CharParser st Rule
pImpl

pImpl :: Bool -> CharParser st Rule
pImpl :: Bool -> CharParser st Rule
pImpl b :: Bool
b = do
  Rule
e <- Bool -> CharParser st Rule
forall st. Bool -> CharParser st Rule
pExpr Bool
b
  Rule -> CharParser st Rule -> CharParser st Rule
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Rule
e (CharParser st Rule -> CharParser st Rule)
-> CharParser st Rule -> CharParser st Rule
forall a b. (a -> b) -> a -> b
$ do
    MulOp
o <- (String -> CharParser st ()) -> [MulOp] -> CharParser st MulOp
forall a st.
Show a =>
(String -> CharParser st ()) -> [a] -> CharParser st a
choiceS String -> CharParser st ()
forall st. String -> CharParser st ()
pSym [MulOp
Ri, MulOp
Rr]
    [Rule]
es <- CharParser st Rule
-> CharParser st () -> ParsecT String st Identity [Rule]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 (Bool -> CharParser st Rule
forall st. Bool -> CharParser st Rule
pExpr Bool
False) (CharParser st () -> ParsecT String st Identity [Rule])
-> CharParser st () -> ParsecT String st Identity [Rule]
forall a b. (a -> b) -> a -> b
$ String -> CharParser st ()
forall st. String -> CharParser st ()
pSym (MulOp -> String
forall a. Show a => a -> String
show MulOp
o)
    Rule -> CharParser st Rule
forall (m :: * -> *) a. Monad m => a -> m a
return (Rule -> CharParser st Rule) -> Rule -> CharParser st Rule
forall a b. (a -> b) -> a -> b
$ MulOp -> [Rule] -> Rule
MulExp MulOp
o ([Rule] -> Rule) -> [Rule] -> Rule
forall a b. (a -> b) -> a -> b
$ Rule
e Rule -> [Rule] -> [Rule]
forall a. a -> [a] -> [a]
: [Rule]
es

pExpr :: Bool -> CharParser st Rule
pExpr :: Bool -> CharParser st Rule
pExpr = MulOp -> CharParser st Rule -> CharParser st Rule
forall st. MulOp -> CharParser st Rule -> CharParser st Rule
pPrec MulOp
Fu (CharParser st Rule -> CharParser st Rule)
-> (Bool -> CharParser st Rule) -> Bool -> CharParser st Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CharParser st Rule
forall st. Bool -> CharParser st Rule
pFactorI

pFactorI :: Bool -> CharParser st Rule
pFactorI :: Bool -> CharParser st Rule
pFactorI = MulOp -> CharParser st Rule -> CharParser st Rule
forall st. MulOp -> CharParser st Rule -> CharParser st Rule
pPrec MulOp
Fi (CharParser st Rule -> CharParser st Rule)
-> (Bool -> CharParser st Rule) -> Bool -> CharParser st Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CharParser st Rule
forall st. Bool -> CharParser st Rule
pFactor

pFactor :: Bool -> CharParser st Rule
pFactor :: Bool -> CharParser st Rule
pFactor = MulOp -> CharParser st Rule -> CharParser st Rule
forall st. MulOp -> CharParser st Rule -> CharParser st Rule
pPrec MulOp
Fd (CharParser st Rule -> CharParser st Rule)
-> (Bool -> CharParser st Rule) -> Bool -> CharParser st Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CharParser st Rule
forall st. Bool -> CharParser st Rule
pTermD

pTermD :: Bool -> CharParser st Rule
pTermD :: Bool -> CharParser st Rule
pTermD = MulOp -> CharParser st Rule -> CharParser st Rule
forall st. MulOp -> CharParser st Rule -> CharParser st Rule
pPrec MulOp
Fc (CharParser st Rule -> CharParser st Rule)
-> (Bool -> CharParser st Rule) -> Bool -> CharParser st Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CharParser st Rule
forall st. Bool -> CharParser st Rule
pTerm

pPrec :: MulOp -> CharParser st Rule -> CharParser st Rule
pPrec :: MulOp -> CharParser st Rule -> CharParser st Rule
pPrec f :: MulOp
f p :: CharParser st Rule
p = do
  [Rule]
es <- CharParser st Rule
-> ParsecT String st Identity ()
-> ParsecT String st Identity [Rule]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 CharParser st Rule
p (ParsecT String st Identity ()
 -> ParsecT String st Identity [Rule])
-> ParsecT String st Identity ()
-> ParsecT String st Identity [Rule]
forall a b. (a -> b) -> a -> b
$ ParsecT String st Identity () -> ParsecT String st Identity ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String st Identity () -> ParsecT String st Identity ())
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String st Identity ()
forall st. String -> CharParser st ()
pSym (MulOp -> String
forall a. Show a => a -> String
show MulOp
f) ParsecT String st Identity ()
-> ParsecT String st Identity () -> ParsecT String st Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String st Identity Char -> ParsecT String st Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '[')
                   -- to avoid conflict in objects
  Rule -> CharParser st Rule
forall (m :: * -> *) a. Monad m => a -> m a
return (Rule -> CharParser st Rule) -> Rule -> CharParser st Rule
forall a b. (a -> b) -> a -> b
$ case [Rule]
es of
    [e :: Rule
e] -> Rule
e
    _ -> MulOp -> [Rule] -> Rule
MulExp MulOp
f [Rule]
es

pTerm :: Bool -> CharParser st Rule
pTerm :: Bool -> CharParser st Rule
pTerm b :: Bool
b = do
  [String]
ms <- ParsecT String st Identity String
-> ParsecT String st Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String st Identity String
forall st. CharParser st String
pMinus
  Rule
e <- CharParser st Rule -> CharParser st Rule
forall st a. CharParser st a -> CharParser st a
pParens (Bool -> CharParser st Rule
forall st. Bool -> CharParser st Rule
pRule Bool
False) CharParser st Rule -> CharParser st Rule -> CharParser st Rule
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Relation -> Rule)
-> ParsecT String st Identity Relation -> CharParser st Rule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Relation -> Rule
Tm (Bool -> ParsecT String st Identity Relation
forall st. Bool -> CharParser st Relation
pMorphism Bool
b)
  [UnOp]
rs <- ParsecT String st Identity UnOp
-> ParsecT String st Identity [UnOp]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String st Identity UnOp
 -> ParsecT String st Identity [UnOp])
-> ParsecT String st Identity UnOp
-> ParsecT String st Identity [UnOp]
forall a b. (a -> b) -> a -> b
$ (String -> CharParser st ())
-> [UnOp] -> ParsecT String st Identity UnOp
forall a st.
Show a =>
(String -> CharParser st ()) -> [a] -> CharParser st a
choiceS String -> CharParser st ()
forall st. String -> CharParser st ()
pSym [UnOp
K0, UnOp
K1, UnOp
Co]
  let p :: Rule
p = (Rule -> UnOp -> Rule) -> Rule -> [UnOp] -> Rule
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((UnOp -> Rule -> Rule) -> Rule -> UnOp -> Rule
forall a b c. (a -> b -> c) -> b -> a -> c
flip UnOp -> Rule -> Rule
UnExp) Rule
e [UnOp]
rs
  Rule -> CharParser st Rule
forall (m :: * -> *) a. Monad m => a -> m a
return (Rule -> CharParser st Rule) -> Rule -> CharParser st Rule
forall a b. (a -> b) -> a -> b
$ (Rule -> String -> Rule) -> Rule -> [String] -> Rule
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ r :: Rule
r _ -> UnOp -> Rule -> Rule
UnExp UnOp
Cp Rule
r) Rule
p [String]
ms