{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.RDF.RDF4H.ParserUtils
( Parser(..)
, parseFromURL
, rdfTypeNode, rdfNilNode, rdfFirstNode, rdfRestNode
, rdfSubjectNode, rdfPredicateNode, rdfObjectNode, rdfStatementNode
, rdfTag, rdfID, rdfAbout, rdfParseType, rdfResource, rdfNodeID, rdfDatatype
, rdfType, rdfLi, rdfListIndex
, rdfDescription, rdfXmlLiteral
, rdfAboutEach, rdfAboutEachPrefix, rdfBagID
, xmlLang
, xsdIntUri, xsdDoubleUri, xsdDecimalUri, xsdBooleanUri
#if MIN_VERSION_base(4,10,0)
#else
, fromRight
#endif
) where
import Data.RDF.Types
import Data.RDF.Namespace
import Control.Exception.Lifted
import Network.HTTP.Conduit
import Data.Text.Encoding (decodeUtf8)
#if MIN_VERSION_base(4,9,0)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ((<>))
#else
#endif
#else
#endif
import qualified Data.ByteString.Lazy as BS
import Data.Text (Text)
import qualified Data.Text as T
#if MIN_VERSION_base(4,10,0)
#else
fromRight :: b -> Either a b -> b
fromRight _ (Right b) = b
fromRight b _ = b
#endif
data Parser = Parsec | Attoparsec
errResult :: String -> Either ParseFailure (RDF rdfImpl)
errResult :: forall rdfImpl. String -> Either ParseFailure (RDF rdfImpl)
errResult String
msg = ParseFailure -> Either ParseFailure (RDF rdfImpl)
forall a b. a -> Either a b
Left (String -> ParseFailure
ParseFailure String
msg)
parseFromURL :: (T.Text -> Either ParseFailure (RDF rdfImpl)) -> String -> IO (Either ParseFailure (RDF rdfImpl))
parseFromURL :: forall rdfImpl.
(Text -> Either ParseFailure (RDF rdfImpl))
-> String -> IO (Either ParseFailure (RDF rdfImpl))
parseFromURL Text -> Either ParseFailure (RDF rdfImpl)
parseFunc String
url = do
Either HttpException ByteString
result <- IO ByteString -> IO (Either HttpException ByteString)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
Control.Exception.Lifted.try (IO ByteString -> IO (Either HttpException ByteString))
-> IO ByteString -> IO (Either HttpException ByteString)
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
simpleHttp String
url
case Either HttpException ByteString
result of
Left (HttpException
err :: HttpException) ->
case HttpException
err of
(HttpExceptionRequest Request
_req HttpExceptionContent
content) ->
case HttpExceptionContent
content of
HttpExceptionContent
ConnectionTimeout ->
Either ParseFailure (RDF rdfImpl)
-> IO (Either ParseFailure (RDF rdfImpl))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseFailure (RDF rdfImpl)
-> IO (Either ParseFailure (RDF rdfImpl)))
-> Either ParseFailure (RDF rdfImpl)
-> IO (Either ParseFailure (RDF rdfImpl))
forall a b. (a -> b) -> a -> b
$ String -> Either ParseFailure (RDF rdfImpl)
forall rdfImpl. String -> Either ParseFailure (RDF rdfImpl)
errResult String
"Connection timed out"
HttpExceptionContent
_ -> Either ParseFailure (RDF rdfImpl)
-> IO (Either ParseFailure (RDF rdfImpl))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseFailure (RDF rdfImpl)
-> IO (Either ParseFailure (RDF rdfImpl)))
-> Either ParseFailure (RDF rdfImpl)
-> IO (Either ParseFailure (RDF rdfImpl))
forall a b. (a -> b) -> a -> b
$ String -> Either ParseFailure (RDF rdfImpl)
forall rdfImpl. String -> Either ParseFailure (RDF rdfImpl)
errResult (String
"HttpExceptionRequest content: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HttpExceptionContent -> String
forall a. Show a => a -> String
show HttpExceptionContent
content)
(InvalidUrlException{}) ->
Either ParseFailure (RDF rdfImpl)
-> IO (Either ParseFailure (RDF rdfImpl))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseFailure (RDF rdfImpl)
-> IO (Either ParseFailure (RDF rdfImpl)))
-> Either ParseFailure (RDF rdfImpl)
-> IO (Either ParseFailure (RDF rdfImpl))
forall a b. (a -> b) -> a -> b
$ String -> Either ParseFailure (RDF rdfImpl)
forall rdfImpl. String -> Either ParseFailure (RDF rdfImpl)
errResult String
"Invalid URL exception"
Right ByteString
bs -> do
let s :: Text
s = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.toStrict ByteString
bs
Either ParseFailure (RDF rdfImpl)
-> IO (Either ParseFailure (RDF rdfImpl))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either ParseFailure (RDF rdfImpl)
parseFunc Text
s)
rdfTypeNode, rdfNilNode, rdfFirstNode, rdfRestNode :: Node
rdfTypeNode :: Node
rdfTypeNode = Text -> Node
UNode (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Text
mkUri Namespace
rdf Text
"type"
rdfNilNode :: Node
rdfNilNode = Text -> Node
UNode (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Text
mkUri Namespace
rdf Text
"nil"
rdfFirstNode :: Node
rdfFirstNode = Text -> Node
UNode (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Text
mkUri Namespace
rdf Text
"first"
rdfRestNode :: Node
rdfRestNode = Text -> Node
UNode (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Text
mkUri Namespace
rdf Text
"rest"
rdfSubjectNode, rdfPredicateNode, rdfObjectNode, rdfStatementNode :: Node
rdfSubjectNode :: Node
rdfSubjectNode = Text -> Node
UNode (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Text
mkUri Namespace
rdf Text
"subject"
rdfPredicateNode :: Node
rdfPredicateNode = Text -> Node
UNode (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Text
mkUri Namespace
rdf Text
"predicate"
rdfObjectNode :: Node
rdfObjectNode = Text -> Node
UNode (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Text
mkUri Namespace
rdf Text
"object"
rdfStatementNode :: Node
rdfStatementNode = Text -> Node
UNode (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ Namespace -> Text -> Text
mkUri Namespace
rdf Text
"Statement"
rdfTag, rdfID, rdfAbout, rdfParseType, rdfResource, rdfNodeID, rdfDatatype :: Text
rdfTag :: Text
rdfTag = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"RDF"
rdfID :: Text
rdfID = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"ID"
rdfAbout :: Text
rdfAbout = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"about"
rdfParseType :: Text
rdfParseType = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"parseType"
rdfResource :: Text
rdfResource = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"resource"
rdfNodeID :: Text
rdfNodeID = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"nodeID"
rdfDatatype :: Text
rdfDatatype = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"datatype"
rdfType, rdfLi, rdfListIndex :: Text
rdfType :: Text
rdfType = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"type"
rdfLi :: Text
rdfLi = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"li"
rdfListIndex :: Text
rdfListIndex = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"_"
rdfXmlLiteral, rdfDescription :: Text
rdfXmlLiteral :: Text
rdfXmlLiteral = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"XMLLiteral"
rdfDescription :: Text
rdfDescription = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"Description"
rdfAboutEach, rdfAboutEachPrefix, rdfBagID :: Text
rdfAboutEach :: Text
rdfAboutEach = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"aboutEach"
rdfAboutEachPrefix :: Text
rdfAboutEachPrefix = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"aboutEachPrefix"
rdfBagID :: Text
rdfBagID = Namespace -> Text -> Text
mkUri Namespace
rdf Text
"bagID"
xmlLang :: Text
xmlLang :: Text
xmlLang = Namespace -> Text -> Text
mkUri Namespace
xml Text
"lang"
xsdIntUri, xsdDoubleUri, xsdDecimalUri, xsdBooleanUri :: Text
xsdIntUri :: Text
xsdIntUri = Namespace -> Text -> Text
mkUri Namespace
xsd Text
"integer"
xsdDoubleUri :: Text
xsdDoubleUri = Namespace -> Text -> Text
mkUri Namespace
xsd Text
"double"
xsdDecimalUri :: Text
xsdDecimalUri = Namespace -> Text -> Text
mkUri Namespace
xsd Text
"decimal"
xsdBooleanUri :: Text
xsdBooleanUri = Namespace -> Text -> Text
mkUri Namespace
xsd Text
"boolean"