packages feed

rdf4h 1.1.0 → 1.2.0

raw patch · 12 files changed

+74/−71 lines, 12 filesdep +knobdep −MissingH

Dependencies added: knob

Dependencies removed: MissingH

Files

rdf4h.cabal view
@@ -1,5 +1,5 @@ name:            rdf4h-version:         1.1.0+version:         1.2.0 synopsis:        A library for RDF processing in Haskell description:        'RDF for Haskell' is a library for working with RDF in Haskell.@@ -19,7 +19,7 @@ build-type:      Simple category:        RDF stability:       Experimental-tested-with:     GHC==7.6.1+tested-with:     GHC==7.6.3 extra-tmp-files: test  flag small_base@@ -54,15 +54,13 @@                  , network >= 2.2.0.0                  , HTTP >= 4000.0.0                  , hxt >= 9.0.0-                 , MissingH >= 1.2.0.0                  , text   other-modules:   Data.RDF.Utils                  , Text.RDF.RDF4H.ParserUtils                  , Text.RDF.RDF4H.Interact   hs-source-dirs:  src   extensions:      BangPatterns RankNTypes MultiParamTypeClasses Arrows FlexibleContexts OverloadedStrings-  ghc-options:     -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures -funbox-strict-fields -fno-warn-unused-do-bind-+  ghc-options:     -Wall -fno-warn-unused-do-bind -funbox-strict-fields  executable rdf4h   main-is:         Rdf4hParseMain.hs @@ -74,18 +72,16 @@                  , network >= 2.2.0.0                  , HTTP >= 4000.0.0                  , hxt >= 9.0.0-                 , MissingH >= 1.2.0.0                  , containers                  , text   hs-source-dirs:  src   extensions:      BangPatterns RankNTypes ScopedTypeVariables MultiParamTypeClasses OverloadedStrings-  ghc-options:     -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures -funbox-strict-fields -fno-warn-unused-do-bind-+  ghc-options:     -Wall -fno-warn-unused-do-bind -funbox-strict-fields  test-suite test-rdf4h   type:          exitcode-stdio-1.0   main-is:       Test.hs-  ghc-options:   -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures -funbox-strict-fields -fno-warn-unused-do-bind+  ghc-options:   -Wall -fno-warn-unused-do-bind -fno-warn-orphans -fno-warn-name-shadowing -funbox-strict-fields   extensions:    RankNTypes MultiParamTypeClasses Arrows FlexibleContexts OverloadedStrings   build-depends: base >= 4 && < 6                , parsec >= 3@@ -96,11 +92,11 @@                , network >= 2.2.0.0                , QuickCheck >= 1.2.0.0                , HUnit >= 1.2.2.1-               , MissingH >= 1.2.0.0                , bytestring                , hxt                , containers                , text+               , knob   other-modules: Data.RDF                , Data.RDF.Namespace                , Data.RDF.MGraph
src/Data/RDF/MGraph.hs view
@@ -4,6 +4,7 @@  where +import Prelude hiding (pred) import Data.RDF.Types import Data.RDF.Query import Data.RDF.Namespace@@ -50,21 +51,21 @@ type SPOMap    = Map Subject AdjacencyMap  baseUrl' :: MGraph -> Maybe BaseUrl-baseUrl' (MGraph (_, baseUrl, _)) = baseUrl+baseUrl' (MGraph (_, baseURL, _)) = baseURL  prefixMappings' :: MGraph -> PrefixMappings prefixMappings' (MGraph (_, _, pms)) = pms  addPrefixMappings' :: MGraph -> PrefixMappings -> Bool -> MGraph-addPrefixMappings' (MGraph (ts, baseUrl, pms)) pms' replace = +addPrefixMappings' (MGraph (ts, baseURL, pms)) pms' replace =    let merge = if replace then flip mergePrefixMappings else mergePrefixMappings-  in  MGraph (ts, baseUrl, merge pms pms')+  in  MGraph (ts, baseURL, merge pms pms')  empty' :: MGraph empty' = MGraph (Map.empty, Nothing, PrefixMappings Map.empty)  mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> MGraph-mkRdf' ts baseUrl pms = MGraph (mergeTs Map.empty ts, baseUrl, pms)+mkRdf' ts baseURL pms = MGraph (mergeTs Map.empty ts, baseURL, pms)  mergeTs :: SPOMap -> [Triple] -> SPOMap mergeTs = foldl' mergeT@@ -75,19 +76,17 @@ mergeT' :: SPOMap -> Subject -> Predicate -> Object -> SPOMap mergeT' m s p o =   if s `Map.member` m then-    (if p `Map.member` adjs then Map.insert s (addPredObj p o adjs) m-       else Map.insert s (addNewPredObjMap p o adjs) m)-    else Map.insert s (newPredMap p o) m+    (if p `Map.member` adjs then Map.insert s addPredObj m+       else Map.insert s addNewPredObjMap m)+    else Map.insert s newPredMap m   where     adjs = get s m-    newPredMap :: Predicate -> Object -> Map Predicate (Set Object)-    newPredMap p o = Map.singleton p (Set.singleton o)-    addNewPredObjMap :: Predicate -> Object -> Map Predicate (Set Object) ->-                       Map Predicate (Set Object)-    addNewPredObjMap p o = Map.insert p (Set.singleton o)-    addPredObj :: Predicate -> Object -> Map Predicate (Set Object) ->-                    Map Predicate (Set Object)-    addPredObj p o = Map.insert p (Set.insert o (get p adjs))+    newPredMap :: Map Predicate (Set Object)+    newPredMap = Map.singleton p (Set.singleton o)+    addNewPredObjMap :: Map Predicate (Set Object)+    addNewPredObjMap = Map.insert p (Set.singleton o) adjs+    addPredObj :: Map Predicate (Set Object)+    addPredObj = Map.insert p (Set.insert o (get p adjs)) adjs     get :: Ord k => k -> Map k v -> v     get = Map.findWithDefault undefined
src/Data/RDF/Query.hs view
@@ -12,8 +12,9 @@  ) where -import Data.RDF.Types+import Prelude hiding (pred) import Data.List+import Data.RDF.Types  -- |Answer the given list of triples in sorted order. sortTriples :: Triples -> Triples@@ -111,8 +112,8 @@  expandTriples' :: Triples -> Maybe BaseUrl -> PrefixMappings -> Triples -> Triples expandTriples' acc _ _ [] = acc-expandTriples' acc baseUrl prefixMappings (t:rest) = expandTriples' (normalize baseUrl prefixMappings t : acc) baseUrl prefixMappings rest-  where normalize baseUrl prefixMappings = expandPrefixes prefixMappings . expandBaseUrl baseUrl-        expandBaseUrl (Just _) triple = triple-        expandBaseUrl Nothing triple = triple-        expandPrefixes _ triple = triple+expandTriples' acc baseURL prefixMaps (t:rest) = expandTriples' (normalize baseURL prefixMaps t : acc) baseURL prefixMaps rest+  where normalize baseURL' prefixMaps' = expandPrefixes prefixMaps' . expandBaseUrl baseURL'+        expandBaseUrl (Just _) triple' = triple'+        expandBaseUrl Nothing triple' = triple'+        expandPrefixes _ triple' = triple'
src/Data/RDF/TriplesGraph.hs view
@@ -12,10 +12,11 @@  where -import Data.RDF.Types-import Data.RDF.Query-import Data.RDF.Namespace+import Prelude hiding (pred) import qualified Data.Map as Map+import Data.RDF.Namespace+import Data.RDF.Query+import Data.RDF.Types  -- |A simple implementation of the 'RDF' type class that represents -- the graph internally as a list of triples.@@ -55,12 +56,12 @@ prefixMappings' (TriplesGraph (_, _, pms)) = pms  addPrefixMappings' :: TriplesGraph -> PrefixMappings -> Bool -> TriplesGraph-addPrefixMappings' (TriplesGraph (ts, baseUrl, pms)) pms' replace =+addPrefixMappings' (TriplesGraph (ts, baseURL, pms)) pms' replace =   let merge = if replace then flip mergePrefixMappings else mergePrefixMappings-  in  TriplesGraph (ts, baseUrl, merge pms pms')+  in  TriplesGraph (ts, baseURL, merge pms pms')    baseUrl' :: TriplesGraph -> Maybe BaseUrl-baseUrl' (TriplesGraph (_, baseUrl, _)) = baseUrl+baseUrl' (TriplesGraph (_, baseURL, _)) = baseURL  empty' :: TriplesGraph empty' = TriplesGraph ([], Nothing, PrefixMappings Map.empty)@@ -70,7 +71,7 @@ -- from the results of the select' and query' functions, since it is cheap to do -- there in most cases, but not when triplesOf' is called. mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> TriplesGraph-mkRdf' ts baseUrl pms = TriplesGraph (ts, baseUrl, pms)+mkRdf' ts baseURL pms = TriplesGraph (ts, baseURL, pms)  triplesOf' :: TriplesGraph -> Triples triplesOf' (TriplesGraph (ts, _, _)) = ts
src/Data/RDF/Types.hs view
@@ -31,6 +31,7 @@  ) where +import Prelude hiding (pred) import qualified Data.Text as T import System.IO import Text.Printf
src/Text/RDF/RDF4H/Interact.hs view
@@ -16,7 +16,7 @@  import qualified Data.Text as T -import Data.RDF.Types+import Data.RDF.Types hiding (baseUrl) import Data.RDF.Utils() import Data.RDF.TriplesGraph() import Data.RDF.MGraph()
src/Text/RDF/RDF4H/NTriplesParser.hs view
@@ -5,6 +5,7 @@   NTriplesParser(NTriplesParser), ParseFailure ) where +import Prelude hiding (init,pred) import Data.RDF.Types import Text.RDF.RDF4H.ParserUtils import Data.Char(isLetter, isDigit, isLower)@@ -187,6 +188,7 @@   <|> liftM T.pack     (many (satisfy (\ c -> is_nonquote_char c && c /= '\\'))) +b_tab, b_ret, b_nl, b_slash, b_quote :: T.Text b_tab = T.singleton '\t' b_ret = T.singleton '\r' b_nl  = T.singleton '\n'
src/Text/RDF/RDF4H/NTriplesSerializer.hs view
@@ -5,15 +5,13 @@   NTriplesSerializer(NTriplesSerializer) ) where +import Control.Monad (void) import Data.RDF.Types import Data.RDF.Utils import qualified Data.Text as T-import Data.Text.Encoding-import qualified Data.ByteString as B-import Control.Monad (void)+import qualified Data.Text.IO as T import System.IO - data NTriplesSerializer = NTriplesSerializer  instance RdfSerializer NTriplesSerializer where@@ -44,7 +42,7 @@ _writeNode h node =   case node of     (UNode bs)  -> hPutChar h '<' >>-                     hPutStrRev h bs >>+                     T.hPutStr h bs >>                      hPutChar h '>'     (BNode gId) -> hPutStrRev h gId     (BNodeGen i)-> putStr "_:genid" >> hPutStr h (show i)@@ -56,10 +54,10 @@     (PlainL lit)       -> _writeLiteralString h lit     (PlainLL lit lang) -> _writeLiteralString h lit >>                             hPutStr h "@" >>-                            B.hPutStr h (encodeUtf8 lang)+                            T.hPutStr h lang     (TypedL lit dtype) -> _writeLiteralString h lit >>                             hPutStr h "^^<" >>-                            hPutStrRev h dtype >>+                            T.hPutStr h dtype >>                             hPutStr h ">"  -- TODO: this is REALLY slow.
src/Text/RDF/RDF4H/ParserUtils.hs view
@@ -7,8 +7,6 @@ import Network.URI import Network.HTTP import Data.Char(intToDigit)--- import Data.ByteString.Lazy.Char8(ByteString)--- import qualified Data.ByteString as B import Data.Text.Encoding (decodeUtf8) import qualified Data.ByteString.Char8 as B import qualified Data.Text as T@@ -34,10 +32,10 @@   where     showRspCode (a, b, c) = map intToDigit [a, b, c]     httpError resp = showRspCode (rspCode resp) ++ " " ++ rspReason resp-    p url =-      simpleHTTP (request url) >>= \resp ->+    p url' =+      simpleHTTP (request url') >>= \resp ->         case resp of-          (Left e)    -> return (errResult $ "couldn't retrieve from URL: " ++ show url ++ " [" ++ show e ++ "]")+          (Left e)    -> return (errResult $ "couldn't retrieve from URL: " ++ show url' ++ " [" ++ show e ++ "]")           (Right res) -> case rspCode res of                            (2, 0, 0) -> return $ parseFunc (decodeUtf8 (rspBody res))                            _         -> return (errResult $ "couldn't retrieve from URL: " ++ httpError res)
src/Text/RDF/RDF4H/TurtleParser.hs view
@@ -215,7 +215,7 @@   liftM (`mkLNode` xsdBooleanUri) t_boolean   where     mkLNode :: T.Text -> T.Text -> Node-    mkLNode bsType bs = LNode (typedL bsType bs)+    mkLNode bsType bs' = LNode (typedL bsType bs')  str_literal :: GenParser ParseState Node str_literal =@@ -293,9 +293,9 @@  t_language  :: GenParser ParseState T.Text t_language =-  do init <- many1 lower;+  do initial <- many1 lower;      rest <- many (do {char '-'; cs <- many1 (lower <|> digit); return ( s2t ('-':cs))})-     return $! ( s2t init `T.append` T.concat rest)+     return $! ( s2t initial `T.append` T.concat rest)  identifier :: GenParser ParseState Char -> GenParser ParseState Char -> GenParser ParseState T.Text identifier initial rest = initial >>= \i -> many rest >>= \r -> return ( s2t (i:r))@@ -425,7 +425,7 @@                                                   else bUrl)                                                  `T.append` urlFrag)   where-    isHash bs = T.length bs == 1 && T.head bs == '#'+    isHash bs' = T.length bs' == 1 && T.head bs' == '#'  {-# INLINE isAbsoluteUri #-} isAbsoluteUri :: T.Text -> Bool@@ -572,7 +572,7 @@ -- Returns either a @ParseFailure@ or a new RDF containing the parsed triples. parseFile' :: forall rdf. (RDF rdf) => Maybe BaseUrl -> Maybe T.Text -> String -> IO (Either ParseFailure rdf) parseFile' bUrl docUrl fpath =-  TIO.readFile fpath >>= \bs -> return $ handleResult bUrl (runParser t_turtleDoc initialState (maybe "" t2s docUrl) bs)+  TIO.readFile fpath >>= \bs' -> return $ handleResult bUrl (runParser t_turtleDoc initialState (maybe "" t2s docUrl) bs')   where initialState = (bUrl, docUrl, 1, PrefixMappings Map.empty, [], [], [], Seq.empty)  -- |Parse the given string as a Turtle document. The arguments and return type have the same semantics
src/Text/RDF/RDF4H/TurtleSerializer.hs view
@@ -9,10 +9,11 @@  import Data.RDF.Types import Data.RDF.Query-import Data.RDF.Namespace+import Data.RDF.Namespace hiding (rdf) import Data.RDF.Utils import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8)+import qualified Data.Text.IO as T import qualified Data.ByteString.Char8 as B import Data.Map(Map) import qualified Data.Map as Map@@ -95,7 +96,7 @@ writeSubjGroup h dUrl pms ts@(t:_) =   writeNode h dUrl (subjectOf t) pms >> hPutChar h ' ' >>   writePredGroup h dUrl pms (head ts') >>-  mapM_ (\t -> hPutStr h ";\n\t" >> writePredGroup h dUrl pms t) (tail ts') >>+  mapM_ (\t' -> hPutStr h ";\n\t" >> writePredGroup h dUrl pms t') (tail ts') >>   hPutStrLn h " ."   where     ts' = groupBy equalPredicates ts@@ -110,7 +111,7 @@   -- so we pass the docUrl through to writeNode in all cases.   writeNode h docUrl (predicateOf t) pms >> hPutChar h ' ' >>    writeNode h docUrl (objectOf t) pms >>-  mapM_ (\t -> hPutStr h ", " >> writeNode h docUrl (objectOf t) pms) ts+  mapM_ (\t' -> hPutStr h ", " >> writeNode h docUrl (objectOf t') pms) ts  writeNode :: Handle -> Maybe T.Text -> Node -> Map T.Text T.Text -> IO () writeNode h mdUrl node prefixes =@@ -155,7 +156,7 @@     (PlainL lit)       -> writeLiteralString h lit     (PlainLL lit lang) -> writeLiteralString h lit >>                             hPutStr h "@" >>-                            B.hPutStr h (encodeUtf8 lang)+                            T.hPutStr h lang     (TypedL lit dtype) -> writeLiteralString h lit >>                             hPutStr h "^^" >>                             writeUNodeUri h (T.reverse dtype) pms
src/Text/RDF/RDF4H/XmlParser.hs view
@@ -1,3 +1,5 @@+{-# Language Arrows #-}+ -- |An parser for the RDF/XML format  -- <http://www.w3.org/TR/REC-rdf-syntax/>. @@ -5,13 +7,14 @@   parseXmlRDF, getRDF ) where -import Data.RDF.Types-import Data.RDF.Utils-import qualified Data.Map as Map-import Control.Arrow-import Text.XML.HXT.Core-import qualified Data.Text as T-import Data.String.Utils+import Control.Arrow (Arrow,(>>>),(<<<),(&&&),(***),arr,returnA)+import Control.Arrow.ArrowState (ArrowState,nextState)+import Data.List (isPrefixOf)+import qualified Data.Map as Map (fromList)+import Data.RDF.Types (RDF,Node(BNodeGen),BaseUrl(..),Triple(..),Triples,Subject,Predicate,Object,PrefixMappings(..),ParseFailure(ParseFailure),mkRdf,lnode,plainL,plainLL,typedL,unode,bnode)+import Data.RDF.Utils (s2t,t2s)+import qualified Data.Text as T (Text)+import Text.XML.HXT.Core (ArrowXml,XmlTree,IfThen((:->)),(>.),(>>.),first,neg,(<+>),expandURI,getName,getAttrValue,getAttrValue0,getAttrl,hasAttrValue,hasAttr,constA,choiceA,getChildren,ifA,arr2A,second,hasName,isElem,xshow,listA,isA,isText,getText,this,unlistA,orElse,sattr,mkelem,xread,runSLA)  -- TODO: Create instance: --  RdfParse XmlParser@@ -62,7 +65,7 @@             triples <- parseDescription' >. id -< (bUrl, rdf)             returnA -< mkRdf triples (Just bUrl) prefixMap   where toAttrMap = (getAttrl >>> (getName &&& (getChildren >>> getText))) >. id-        toPrefixMap = PrefixMappings . Map.fromList . map (\(n, m) -> (s2t (drop 6 n), s2t m)) . filter (startswith "xmlns:" . fst)+        toPrefixMap = PrefixMappings . Map.fromList . map (\(n, m) -> (s2t (drop 6 n), s2t m)) . filter (isPrefixOf "xmlns:" . fst)  -- |Read the initial state from an rdf element parseDescription' :: forall a. (ArrowXml a, ArrowState GParseState a) => a (BaseUrl, XmlTree) Triple@@ -138,7 +141,7 @@     ]   where parseObjectDescription = proc desc -> do                                       o <- mkNode s -< desc-                                      t0 <- arr (\(sub, (p, o)) -> Triple sub p o) -< (stateSubject s, (p, o))+                                      t0 <- arr (\(sub, (p', o)) -> Triple sub p' o) -< (stateSubject s, (p, o))                                       t <- arr fst <+> (parseDescription <<< arr snd) -< (t0, (s { stateSubject = o }, desc))                                       returnA -< t @@ -178,7 +181,7 @@  -- |Read a Triple and it's type when rdf:datatype is available getTypedTriple :: forall a. (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Triple-getTypedTriple state = nameToUNode &&& (attrExpandURI state "rdf:datatype" &&& xshow getChildren >>> arr (\(t, v) -> mkTypedLiteralNode ( (s2t t)) v))+getTypedTriple state = nameToUNode &&& (attrExpandURI state "rdf:datatype" &&& xshow getChildren >>> arr (\(t, v) -> mkTypedLiteralNode (s2t t) v))     >>> arr (attachSubject (stateSubject state))  getResourceTriple :: forall a. (ArrowXml a, ArrowState GParseState a)@@ -200,7 +203,10 @@                        , this :-> mkBlankNode                        ] -rdfXmlLiteral = (s2t) "http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral"+rdfXmlLiteral :: T.Text+rdfFirst,rdfRest,rdfNil,rdfType,rdfStatement,rdfSubject,rdfPredicate,rdfObject :: Node++rdfXmlLiteral = s2t "http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral" rdfFirst = (unode . s2t) "rdf:first" rdfRest = (unode . s2t) "rdf:rest" rdfNil = (unode . s2t) "rdf:nil"