{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Swish.RDF.Parser.Utils
( SpecialMap
, prefixTable, specialTable
, runParserWithError
, ParseResult
, ignore
, char
, ichar
, string
, stringT
, symbol
, isymbol
, lexeme
, notFollowedBy
, whiteSpace
, skipMany
, skipMany1
, endBy
, sepEndBy
, sepEndBy1
, manyTill
, noneOf
, eoln
, fullStop
, hex4
, hex8
, appendURIs
)
where
import Swish.Namespace (Namespace, makeNamespace, ScopedName)
import Swish.RDF.Graph (RDFGraph)
import Swish.RDF.Vocabulary
( namespaceRDF
, namespaceRDFS
, namespaceRDFD
, namespaceOWL
, namespaceLOG
, rdfType
, rdfFirst, rdfRest, rdfNil
, owlSameAs, logImplies
, defaultBase
)
import Data.Char (isSpace, isHexDigit, chr)
#if MIN_VERSION_base(4, 7, 0)
import Data.Functor (($>))
#endif
import Data.Maybe (fromMaybe, fromJust)
import Network.URI (URI(..), relativeTo, parseURIReference)
import Text.ParserCombinators.Poly.StateText
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import qualified Data.Text.Read as R
#if !MIN_VERSION_base(4, 7, 0)
($>) :: Functor f => f a -> b -> f b
($>) = flip (<$)
#endif
appendURIs ::
URI
-> URI
-> Either String URI
appendURIs :: URI -> URI -> Either String URI
appendURIs base :: URI
base uri :: URI
uri =
case URI -> String
uriScheme URI
uri of
"" -> URI -> Either String URI
forall a b. b -> Either a b
Right (URI -> Either String URI) -> URI -> Either String URI
forall a b. (a -> b) -> a -> b
$ URI
uri URI -> URI -> URI
`relativeTo` URI
base
_ -> URI -> Either String URI
forall a b. b -> Either a b
Right URI
uri
type SpecialMap = M.Map String ScopedName
prefixTable :: [Namespace]
prefixTable :: [Namespace]
prefixTable = [ Namespace
namespaceRDF
, Namespace
namespaceRDFS
, Namespace
namespaceRDFD
, Namespace
namespaceOWL
, Namespace
namespaceLOG
, Maybe Text -> URI -> Namespace
makeNamespace Maybe Text
forall a. Maybe a
Nothing (URI -> Namespace) -> URI -> Namespace
forall a b. (a -> b) -> a -> b
$ Maybe URI -> URI
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe URI
parseURIReference "#")
]
specialTable ::
Maybe ScopedName
-> [(String,ScopedName)]
specialTable :: Maybe ScopedName -> [(String, ScopedName)]
specialTable mbase :: Maybe ScopedName
mbase =
[ ("a", ScopedName
rdfType ),
("equals", ScopedName
owlSameAs ),
("implies", ScopedName
logImplies ),
("listfirst", ScopedName
rdfFirst ),
("listrest", ScopedName
rdfRest ),
("listnull", ScopedName
rdfNil ),
("base", ScopedName -> Maybe ScopedName -> ScopedName
forall a. a -> Maybe a -> a
fromMaybe ScopedName
defaultBase Maybe ScopedName
mbase )
]
runParserWithError ::
Parser a b
-> a
-> L.Text
-> Either String b
runParserWithError :: Parser a b -> a -> Text -> Either String b
runParserWithError parser :: Parser a b
parser state0 :: a
state0 input :: Text
input =
let (result :: Either String b
result, _, unparsed :: Text
unparsed) = Parser a b -> a -> Text -> (Either String b, a, Text)
forall s a. Parser s a -> s -> Text -> (Either String a, s, Text)
runParser Parser a b
parser a
state0 Text
input
econtext :: String
econtext = if Text -> Bool
L.null Text
unparsed
then "\n(at end of the text)\n"
else "\nRemaining input:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
case Text -> Int64 -> Ordering
L.compareLength Text
unparsed 40 of
GT -> Text -> String
L.unpack (Int64 -> Text -> Text
L.take 40 Text
unparsed) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "..."
_ -> Text -> String
L.unpack Text
unparsed
in case Either String b
result of
Left emsg :: String
emsg -> String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ String
emsg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
econtext
_ -> Either String b
result
type ParseResult = Either String RDFGraph
ignore :: (Applicative f) => f a -> f ()
ignore :: f a -> f ()
ignore f :: f a
f = f a
f f a -> () -> f ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
char :: Char -> Parser s Char
char :: Char -> Parser s Char
char c :: Char
c = (Char -> Bool) -> Parser s Char
forall s. (Char -> Bool) -> Parser s Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
ichar :: Char -> Parser s ()
ichar :: Char -> Parser s ()
ichar = Parser s Char -> Parser s ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser s Char -> Parser s ())
-> (Char -> Parser s Char) -> Char -> Parser s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Parser s Char
forall s. Char -> Parser s Char
char
string :: String -> Parser s String
string :: String -> Parser s String
string = (Char -> Parser s Char) -> String -> Parser s String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Parser s Char
forall s. Char -> Parser s Char
char
stringT :: T.Text -> Parser s T.Text
stringT :: Text -> Parser s Text
stringT s :: Text
s = String -> Parser s String
forall s. String -> Parser s String
string (Text -> String
T.unpack Text
s) Parser s String -> Parser s Text -> Parser s Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser s Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
skipMany :: Parser s a -> Parser s ()
skipMany :: Parser s a -> Parser s ()
skipMany = Parser s [a] -> Parser s ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser s [a] -> Parser s ())
-> (Parser s a -> Parser s [a]) -> Parser s a -> Parser s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser s a -> Parser s [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
skipMany1 :: Parser s a -> Parser s ()
skipMany1 :: Parser s a -> Parser s ()
skipMany1 = Parser s [a] -> Parser s ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser s [a] -> Parser s ())
-> (Parser s a -> Parser s [a]) -> Parser s a -> Parser s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser s a -> Parser s [a]
forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1
endBy ::
Parser s a
-> Parser s b
-> Parser s [a]
endBy :: Parser s a -> Parser s b -> Parser s [a]
endBy p :: Parser s a
p sep :: Parser s b
sep = Parser s a -> Parser s [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser s a
p Parser s a -> Parser s b -> Parser s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser s b
sep)
sepEndBy ::
Parser s a
-> Parser s b
-> Parser s [a]
sepEndBy :: Parser s a -> Parser s b -> Parser s [a]
sepEndBy p :: Parser s a
p sep :: Parser s b
sep = Parser s a -> Parser s b -> Parser s [a]
forall s a b. Parser s a -> Parser s b -> Parser s [a]
sepEndBy1 Parser s a
p Parser s b
sep Parser s [a] -> Parser s [a] -> Parser s [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> Parser s [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
sepEndBy1 ::
Parser s a
-> Parser s b
-> Parser s [a]
sepEndBy1 :: Parser s a -> Parser s b -> Parser s [a]
sepEndBy1 p :: Parser s a
p sep :: Parser s b
sep = do
a
x <- Parser s a
p
(Parser s b
sep Parser s b -> Parser s [a] -> Parser s [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> Parser s [a] -> Parser s [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser s a -> Parser s b -> Parser s [a]
forall s a b. Parser s a -> Parser s b -> Parser s [a]
sepEndBy Parser s a
p Parser s b
sep)) Parser s [a] -> Parser s [a] -> Parser s [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> Parser s [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a
x]
manyTill ::
Parser s a
-> Parser s b
-> Parser s [a]
manyTill :: Parser s a -> Parser s b -> Parser s [a]
manyTill p :: Parser s a
p end :: Parser s b
end = Parser s [a]
go
where
go :: Parser s [a]
go = (Parser s b
end Parser s b -> [a] -> Parser s [a]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [])
Parser s [a] -> Parser s [a] -> Parser s [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
((:) (a -> [a] -> [a]) -> Parser s a -> Parser s ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser s a
p Parser s ([a] -> [a]) -> Parser s [a] -> Parser s [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser s [a]
go)
noneOf :: String -> Parser s Char
noneOf :: String -> Parser s Char
noneOf istr :: String
istr = (Char -> Bool) -> Parser s Char
forall s. (Char -> Bool) -> Parser s Char
satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
istr)
fullStop :: Parser s ()
fullStop :: Parser s ()
fullStop = Char -> Parser s ()
forall s. Char -> Parser s ()
ichar '.'
eoln :: Parser s ()
eoln :: Parser s ()
eoln = Parser s String -> Parser s ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore ([Parser s String] -> Parser s String
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [String -> Parser s String
forall s. String -> Parser s String
string "\r\n", String -> Parser s String
forall s. String -> Parser s String
string "\r", String -> Parser s String
forall s. String -> Parser s String
string "\n"])
notFollowedBy :: (Char -> Bool) -> Parser s ()
notFollowedBy :: (Char -> Bool) -> Parser s ()
notFollowedBy p :: Char -> Bool
p = do
Char
c <- Parser s Char
forall s. Parser s Char
next
if Char -> Bool
p Char
c
then String -> Parser s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser s ()) -> String -> Parser s ()
forall a b. (a -> b) -> a -> b
$ "Unexpected character: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show [Char
c]
else Text -> Parser s ()
forall s. Text -> Parser s ()
reparse (Text -> Parser s ()) -> Text -> Parser s ()
forall a b. (a -> b) -> a -> b
$ Char -> Text
L.singleton Char
c
symbol :: String -> Parser s String
symbol :: String -> Parser s String
symbol = Parser s String -> Parser s String
forall s a. Parser s a -> Parser s a
lexeme (Parser s String -> Parser s String)
-> (String -> Parser s String) -> String -> Parser s String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser s String
forall s. String -> Parser s String
string
isymbol :: String -> Parser s ()
isymbol :: String -> Parser s ()
isymbol = Parser s String -> Parser s ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser s String -> Parser s ())
-> (String -> Parser s String) -> String -> Parser s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser s String
forall s. String -> Parser s String
symbol
lexeme :: Parser s a -> Parser s a
lexeme :: Parser s a -> Parser s a
lexeme p :: Parser s a
p = Parser s a
p Parser s a -> Parser s () -> Parser s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser s ()
forall s. Parser s ()
whiteSpace
whiteSpace :: Parser s ()
whiteSpace :: Parser s ()
whiteSpace = Parser s () -> Parser s ()
forall s a. Parser s a -> Parser s ()
skipMany (Parser s ()
forall s. Parser s ()
simpleSpace Parser s () -> Parser s () -> Parser s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser s ()
forall s. Parser s ()
oneLineComment)
simpleSpace :: Parser s ()
simpleSpace :: Parser s ()
simpleSpace = Parser s Text -> Parser s ()
forall (f :: * -> *) a. Applicative f => f a -> f ()
ignore (Parser s Text -> Parser s ()) -> Parser s Text -> Parser s ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser s Text
forall s. (Char -> Bool) -> Parser s Text
many1Satisfy Char -> Bool
isSpace
oneLineComment :: Parser s ()
= (Char -> Parser s ()
forall s. Char -> Parser s ()
ichar '#' Parser s () -> Parser s Text -> Parser s Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser s Text
forall s. (Char -> Bool) -> Parser s Text
manySatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n')) Parser s Text -> () -> Parser s ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
hexDigit :: Parser a Char
hexDigit :: Parser a Char
hexDigit = (Char -> Bool) -> Parser a Char
forall s. (Char -> Bool) -> Parser s Char
satisfy Char -> Bool
isHexDigit
hex4 :: Parser a Char
hex4 :: Parser a Char
hex4 = do
String
digs <- Int -> Parser a Char -> Parser a String
forall (p :: * -> *) a. PolyParse p => Int -> p a -> p [a]
exactly 4 Parser a Char
forall s. Parser s Char
hexDigit
let mhex :: Either String (Int, Text)
mhex = Reader Int
forall a. Integral a => Reader a
R.hexadecimal (String -> Text
T.pack String
digs)
case Either String (Int, Text)
mhex of
Left emsg :: String
emsg -> String -> Parser a Char
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (String -> Parser a Char) -> String -> Parser a Char
forall a b. (a -> b) -> a -> b
$ "Internal error: unable to parse hex4: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
emsg
Right (v :: Int
v, "") -> Char -> Parser a Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser a Char) -> Char -> Parser a Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
v
Right (_, vs :: Text
vs) -> String -> Parser a Char
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (String -> Parser a Char) -> String -> Parser a Char
forall a b. (a -> b) -> a -> b
$ "Internal error: hex4 remainder = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
vs
hex8 :: Parser a Char
hex8 :: Parser a Char
hex8 = do
String
digs <- Int -> Parser a Char -> Parser a String
forall (p :: * -> *) a. PolyParse p => Int -> p a -> p [a]
exactly 8 Parser a Char
forall s. Parser s Char
hexDigit
let mhex :: Either String (Int, Text)
mhex = Reader Int
forall a. Integral a => Reader a
R.hexadecimal (String -> Text
T.pack String
digs)
case Either String (Int, Text)
mhex of
Left emsg :: String
emsg -> String -> Parser a Char
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (String -> Parser a Char) -> String -> Parser a Char
forall a b. (a -> b) -> a -> b
$ "Internal error: unable to parse hex8: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
emsg
Right (v :: Int
v, "") -> if Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x10FFFF
then Char -> Parser a Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Parser a Char) -> Char -> Parser a Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
v
else String -> Parser a Char
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad "\\UHHHHHHHH format is limited to a maximum of \\U0010FFFF"
Right (_, vs :: Text
vs) -> String -> Parser a Char
forall (p :: * -> *) a. PolyParse p => String -> p a
failBad (String -> Parser a Char) -> String -> Parser a Char
forall a b. (a -> b) -> a -> b
$ "Internal error: hex8 remainder = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
vs