module Swish.RDF.RDFParser
( SpecialMap
, mapPrefix
, prefixTable, specialTable
, ParseResult, RDFParser
, n3Style, n3Lexer
, ignore
, annotateParsecError
, mkTypedLit
)
where
import Swish.RDF.RDFGraph
( RDFGraph, RDFLabel(..)
, NamespaceMap
)
import Swish.Utils.LookupMap
( LookupMap(..)
, mapFind
)
import Swish.Utils.Namespace
( Namespace(..)
, ScopedName(..)
)
import Swish.RDF.Vocabulary
( namespaceRDF
, namespaceRDFS
, namespaceRDFD
, namespaceOWL
, namespaceLOG
, rdf_type
, rdf_first, rdf_rest, rdf_nil
, owl_sameAs, log_implies
, default_base
)
import Control.Applicative
import Control.Monad (MonadPlus(..), ap)
import Text.ParserCombinators.Parsec (GenParser, ParseError, char, letter, alphaNum, errorPos, sourceLine, sourceColumn)
import Text.ParserCombinators.Parsec.Error (errorMessages, showErrorMessages)
import Text.ParserCombinators.Parsec.Language (emptyDef)
import qualified Text.ParserCombinators.Parsec.Token as P
import Data.Maybe (fromMaybe)
n3Style :: P.LanguageDef st
n3Style =
emptyDef
{ P.commentStart = ""
, P.commentEnd = ""
, P.commentLine = "#"
, P.nestedComments = True
, P.identStart = letter <|> char '_'
, P.identLetter = alphaNum <|> char '_'
, P.reservedNames = []
, P.reservedOpNames= []
, P.caseSensitive = True
}
n3Lexer :: P.TokenParser st
n3Lexer = P.makeTokenParser n3Style
type SpecialMap = LookupMap (String,ScopedName)
mapPrefix :: NamespaceMap -> String -> String
mapPrefix ps pre = mapFind (pre++":") pre ps
prefixTable :: [Namespace]
prefixTable = [ namespaceRDF
, namespaceRDFS
, namespaceRDFD
, namespaceOWL
, namespaceLOG
, Namespace "" "#"
]
specialTable :: Maybe ScopedName -> [(String,ScopedName)]
specialTable mbase =
[ ("a", rdf_type ),
("equals", owl_sameAs ),
("implies", log_implies ),
("listfirst", rdf_first ),
("listrest", rdf_rest ),
("listnull", rdf_nil ),
("base", fromMaybe default_base mbase )
]
type RDFParser a b = GenParser Char a b
instance Applicative (GenParser a b) where
pure = return
(<*>) = ap
instance Alternative (GenParser a b) where
empty = mzero
(<|>) = mplus
type ParseResult = Either String RDFGraph
ignore :: (Monad m) => m a -> m ()
ignore p = p >> return ()
annotateParsecError ::
Int
-> [String]
-> ParseError
-> String
annotateParsecError extraLines ls err =
let ePos = errorPos err
lNum = sourceLine ePos
cNum = sourceColumn ePos
nLines = length ls
ln1 = lNum 1
eln = max 0 extraLines
lNums = [max 0 (ln1 eln) .. min (nLines1) (ln1 + eln)]
beforeLines = map (ls !!) $ filter (< ln1) lNums
afterLines = map (ls !!) $ filter (> ln1) lNums
errorLine = if ln1 >= nLines then "" else ls !! ln1
arrowLine = replicate (cNum1) ' ' ++ "^"
finalLine = "(line " ++ show lNum ++ ", column " ++ show cNum ++ " indicated by the '^' sign above):"
eHdr = "" : beforeLines ++ errorLine : arrowLine : afterLines ++ [finalLine]
eMsg = showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input"
(errorMessages err)
in unlines eHdr ++ eMsg
mkTypedLit ::
ScopedName
-> String
-> RDFLabel
mkTypedLit u v = Lit v (Just u)