content: {- |
  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 = liftM concat $ many white
  
  pToken :: CharParser st String -> CharParser st Token
  pToken p = Lexer.pToken p << skip
  
  oParenT :: CharParser st Token
  oParenT = pToken $ string "("
  
  cParenT :: CharParser st Token
  cParenT = pToken $ string ")"
  
  parens :: CharParser st a -> CharParser st a
  parens p = oParenT >> p << cParenT
  
  key :: String -> CharParser st Id.Token
  key s = pToken $ try $ string s << notFollowedBy (satisfy kifWordChar)
  
  word :: CharParser st String
  word = satisfy kifInitialChar <:> many (satisfy kifWordChar)
  
  quotedChar :: CharParser st Char
  quotedChar =
    satisfy kifChar <|> satisfy kifUnofficial
    <|> (char '\\' >> char '\"')
  
  quotedString :: CharParser st String
  quotedString = do
    q1 <- char '\"'
    s <- many quotedChar
    q2 <- char '\"'
    return $ q1 : s ++ [q2]
  
  variable :: CharParser st String
  variable = char '?' <:> word
  
  -- Row variables are called Sequences Markers in CommonLogic
  rowvar :: CharParser st String
  rowvar = char '@' >> liftM ("..." ++) word
  
  sign :: CharParser st String
  sign = option "" (string "-")
  
  number :: CharParser st String
  number = sign <++> many1 (satisfy kifDigit)
           <++> option "" (char '.' <:> many1 (satisfy kifDigit))
           <++> option "" (oneOf "eE" <:> sign <++> many1 (satisfy kifDigit))
  
  kifUpper :: Char -> Bool
  kifUpper ch = Data.Char.isUpper ch && Data.Char.isAscii ch
  
  kifLower :: Char -> Bool
  kifLower ch = Data.Char.isLower ch && Data.Char.isAscii ch
  
  kifSpecial :: Char -> Bool
  kifSpecial ch = ch `elem` "!$%&*+-,./<=>?@_~"
  
  -- These characters are used in documentation texts in SUMO.
  kifUnofficial :: Char -> Bool
  kifUnofficial ch = ch `elem` ",()#':{}`;^"
  
  kifWordChar :: Char -> Bool
  kifWordChar ch = kifUpper ch || kifLower ch || kifSpecial ch || kifDigit ch
                   || ch == '-' || ch == '#'
  -- '#' is used in expanded IRIs
  
  kifChar :: Char -> Bool
  kifChar ch = kifUpper ch || kifLower ch || kifSpecial ch || kifDigit ch
               || isSpace ch
  
  kifInitialChar :: Char -> Bool
  kifInitialChar ch = kifUpper ch || kifLower ch
  
  kifDigit :: Char -> Bool
  kifDigit = isDigit
  
  commentLine :: CharParser st String
  commentLine = char ';' <:> many (noneOf "\n")
  
  white :: CharParser st String
  white =
      many1 (satisfy isSpace)
    <|>
      commentLine
  