{- |
Module      :  ./CommonLogic/Lexer_KIF.hs
Description :  Parser of the Knowledge Interchange Format
Copyright   :  (c) Karl Luc, DFKI Bremen 2010, Soeren Schulze 2012
License     :  GPLv2 or higher

Maintainer  :  s.schulze@uni-bremen.de
Stability   :  experimental
Portability :  portable
-}

module CommonLogic.Lexer_KIF where

import Common.Id as Id
import qualified Common.Lexer as Lexer
import Common.Parsec

import Text.ParserCombinators.Parsec as Parsec
import Data.Char (isSpace, isUpper, isLower, isDigit, isAscii)
import Control.Monad (liftM)

-- literally from Lexer_CLIF.hs -- abstract?
skip :: CharParser st String
skip :: CharParser st String
skip = ([String] -> String)
-> ParsecT String st Identity [String] -> CharParser st String
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ParsecT String st Identity [String] -> CharParser st String)
-> ParsecT String st Identity [String] -> CharParser st String
forall a b. (a -> b) -> a -> b
$ CharParser st String -> ParsecT String st Identity [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many CharParser st String
forall st. CharParser st String
white

pToken :: CharParser st String -> CharParser st Token
pToken :: CharParser st String -> CharParser st Token
pToken p :: CharParser st String
p = CharParser st String -> CharParser st Token
forall st. CharParser st String -> CharParser st Token
Lexer.pToken CharParser st String
p CharParser st Token -> CharParser st String -> CharParser st Token
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< CharParser st String
forall st. CharParser st String
skip

oParenT :: CharParser st Token
oParenT :: CharParser st Token
oParenT = CharParser st String -> CharParser st Token
forall st. CharParser st String -> CharParser st Token
pToken (CharParser st String -> CharParser st Token)
-> CharParser st String -> CharParser st Token
forall a b. (a -> b) -> a -> b
$ String -> CharParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "("

cParenT :: CharParser st Token
cParenT :: CharParser st Token
cParenT = CharParser st String -> CharParser st Token
forall st. CharParser st String -> CharParser st Token
pToken (CharParser st String -> CharParser st Token)
-> CharParser st String -> CharParser st Token
forall a b. (a -> b) -> a -> b
$ String -> CharParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string ")"

parens :: CharParser st a -> CharParser st a
parens :: CharParser st a -> CharParser st a
parens p :: CharParser st a
p = CharParser st Token
forall st. CharParser st Token
oParenT CharParser st Token -> 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 Token -> CharParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< CharParser st Token
forall st. CharParser st Token
cParenT

key :: String -> CharParser st Id.Token
key :: String -> CharParser st Token
key s :: String
s = CharParser st String -> CharParser st Token
forall st. CharParser st String -> CharParser st Token
pToken (CharParser st String -> CharParser st Token)
-> CharParser st String -> CharParser st Token
forall a b. (a -> b) -> a -> b
$ CharParser st String -> CharParser st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (CharParser st String -> CharParser st String)
-> CharParser st String -> CharParser st String
forall a b. (a -> b) -> a -> b
$ 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 ((Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
kifWordChar)

word :: CharParser st String
word :: CharParser st String
word = (Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
kifInitialChar 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 ((Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
kifWordChar)

quotedChar :: CharParser st Char
quotedChar :: CharParser st Char
quotedChar =
  (Char -> Bool) -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
kifChar 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
<|> (Char -> Bool) -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
kifUnofficial
  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
<|> (Char -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\\' CharParser st Char -> CharParser st Char -> CharParser st Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> CharParser st Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\"')

quotedString :: CharParser st String
quotedString :: CharParser st String
quotedString = do
  Char
q1 <- Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\"'
  String
s <- 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
quotedChar
  Char
q2 <- Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '\"'
  String -> CharParser st String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> CharParser st String) -> String -> CharParser st String
forall a b. (a -> b) -> a -> b
$ Char
q1 Char -> String -> String
forall a. a -> [a] -> [a]
: String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
q2]

variable :: CharParser st String
variable :: CharParser st String
variable = 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]
<:> CharParser st String
forall st. CharParser st String
word

-- Row variables are called Sequences Markers in CommonLogic
rowvar :: CharParser st String
rowvar :: CharParser st String
rowvar = 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 b. Monad m => m a -> m b -> m b
>> (String -> String) -> CharParser st String -> CharParser st String
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ("..." String -> String -> String
forall a. [a] -> [a] -> [a]
++) CharParser st String
forall st. CharParser st String
word

sign :: CharParser st String
sign :: CharParser st String
sign = String -> CharParser st String -> CharParser st String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (String -> CharParser st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string "-")

number :: CharParser st String
number :: CharParser st String
number = CharParser st String
forall st. CharParser st String
sign 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 (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
kifDigit)
         CharParser st String
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> String -> CharParser st String -> CharParser st String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (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 (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
kifDigit))
         CharParser st String
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
<++> String -> CharParser st String -> CharParser st String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option "" (String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "eE" ParsecT String st Identity Char
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a. Monad m => m a -> m [a] -> m [a]
<:> CharParser st String
forall st. CharParser st String
sign 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 (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
kifDigit))

kifUpper :: Char -> Bool
kifUpper :: Char -> Bool
kifUpper ch :: Char
ch = Char -> Bool
Data.Char.isUpper Char
ch Bool -> Bool -> Bool
&& Char -> Bool
Data.Char.isAscii Char
ch

kifLower :: Char -> Bool
kifLower :: Char -> Bool
kifLower ch :: Char
ch = Char -> Bool
Data.Char.isLower Char
ch Bool -> Bool -> Bool
&& Char -> Bool
Data.Char.isAscii Char
ch

kifSpecial :: Char -> Bool
kifSpecial :: Char -> Bool
kifSpecial ch :: Char
ch = Char
ch Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "!$%&*+-,./<=>?@_~"

-- These characters are used in documentation texts in SUMO.
kifUnofficial :: Char -> Bool
kifUnofficial :: Char -> Bool
kifUnofficial ch :: Char
ch = Char
ch Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ",()#':{}`;^"

kifWordChar :: Char -> Bool
kifWordChar :: Char -> Bool
kifWordChar ch :: Char
ch = Char -> Bool
kifUpper Char
ch Bool -> Bool -> Bool
|| Char -> Bool
kifLower Char
ch Bool -> Bool -> Bool
|| Char -> Bool
kifSpecial Char
ch Bool -> Bool -> Bool
|| Char -> Bool
kifDigit Char
ch
                 Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '#'
-- '#' is used in expanded IRIs

kifChar :: Char -> Bool
kifChar :: Char -> Bool
kifChar ch :: Char
ch = Char -> Bool
kifUpper Char
ch Bool -> Bool -> Bool
|| Char -> Bool
kifLower Char
ch Bool -> Bool -> Bool
|| Char -> Bool
kifSpecial Char
ch Bool -> Bool -> Bool
|| Char -> Bool
kifDigit Char
ch
             Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
ch

kifInitialChar :: Char -> Bool
kifInitialChar :: Char -> Bool
kifInitialChar ch :: Char
ch = Char -> Bool
kifUpper Char
ch Bool -> Bool -> Bool
|| Char -> Bool
kifLower Char
ch

kifDigit :: Char -> Bool
kifDigit :: Char -> Bool
kifDigit = Char -> Bool
isDigit

commentLine :: CharParser st String
commentLine :: CharParser st String
commentLine = 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 (String -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf "\n")

white :: CharParser st String
white :: CharParser st String
white =
    ParsecT String st Identity Char -> CharParser st String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSpace)
  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
commentLine