Fixes #4 reversed URIs bug in NTriplesSerializer.

1. Reported on GitHub #4 . The characters in URIs were reversed when written to handle. 2. reverseRdfTest added to testsuite/tests/Data/RDF/TriplesGraph_Test.hs . QuickCheck confirms reported issue. 3. Fixed in Text.RDF.RDF4H.NTriplesSerializer.hs , corresponding QuickCheck test now passes. 4. Other: dependency on MissingH removed.
robstewart57 · Oct 19, 2013 · 0cc25b8 · 0cc25b8
1 parent 3233577
commit 0cc25b8
Show file tree

Hide file tree

Showing 4 changed files with 62 additions and 21 deletions.
diff --git a/rdf4h.cabal b/rdf4h.cabal
@@ -54,7 +54,6 @@ library
                  , 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
@@ -63,7 +62,6 @@ library
   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
 
-
 executable rdf4h
   main-is:         Rdf4hParseMain.hs 
   if flag(small_base)
@@ -74,7 +72,6 @@ executable rdf4h
                  , network >= 2.2.0.0
                  , HTTP >= 4000.0.0
                  , hxt >= 9.0.0
-                 , MissingH >= 1.2.0.0
                  , containers
                  , text
   hs-source-dirs:  src
@@ -96,11 +93,11 @@ test-suite test-rdf4h
                , 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

diff --git a/src/Text/RDF/RDF4H/NTriplesSerializer.hs b/src/Text/RDF/RDF4H/NTriplesSerializer.hs
@@ -5,15 +5,13 @@ module Text.RDF.RDF4H.NTriplesSerializer(
   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 :: Handle -> Node -> IO ()
 _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 @@ _writeLValue h lv =
     (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.

diff --git a/src/Text/RDF/RDF4H/TurtleParser.hs b/src/Text/RDF/RDF4H/TurtleParser.hs
@@ -215,7 +215,7 @@ t_literal =
   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_ws =
 
 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 @@ absolutizeUrl mbUrl mdUrl urlFrag =
                                                   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 @@ parseURL' bUrl docUrl = _parseURL (parseString' bUrl docUrl)
 -- 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 

diff --git a/testsuite/tests/Data/RDF/TriplesGraph_Test.hs b/testsuite/tests/Data/RDF/TriplesGraph_Test.hs
@@ -1,14 +1,23 @@
 module Data.RDF.TriplesGraph_Test where
 
+import Control.Applicative ((<$>))
+import Control.Monad
+import Data.ByteString (pack)
+import qualified Data.ByteString.Char8 as C
+import Data.Knob
+import qualified Data.Map as Map
+import Data.RDF.GraphTestUtils
+import Data.RDF.Namespace
+import Data.RDF.TriplesGraph
+import Data.RDF.Types
+import qualified Data.Text as T 
+import System.IO
 import Test.Framework (testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Test.QuickCheck.Arbitrary
+import Test.QuickCheck.Monadic (assert, monadicIO,run)
 import Test.QuickCheck.Property
-import Data.RDF.Types
-import Data.RDF.TriplesGraph
-import Data.RDF.GraphTestUtils
-import qualified Data.Map as Map
-import Control.Monad
+import Text.RDF.RDF4H.NTriplesSerializer
 
 tests = [ testGroup "TriplesGraph"
             [ testProperty "empty"              prop_tg_empty
@@ -31,6 +40,7 @@ tests = [ testGroup "TriplesGraph"
             , testProperty "select_match_so"    prop_tg_select_match_so
             , testProperty "select_match_po"    prop_tg_select_match_po
             , testProperty "select_match_spo"   prop_tg_select_match_spo
+            , testProperty "reversed RDF handle write" reverseRdfTest
             ]
         ]
 
@@ -114,3 +124,39 @@ prop_tg_select_match_po = p_select_match_po _triplesOf
 
 prop_tg_select_match_spo :: TriplesGraph -> Property
 prop_tg_select_match_spo = p_select_match_spo _triplesOf
+
+----------------------------------------------------
+--  Unit test cases for TriplesGraph              --
+----------------------------------------------------
+
+-- Reported by Daniel Bergey:
+--   https://github.com/robstewart57/rdf4h/issues/4
+
+reverseRdfTest :: Property
+reverseRdfTest = monadicIO $ do
+    fileContents <- run $ do
+      knob <- newKnob (pack [])
+      h <- newFileHandle knob "test.rdf" WriteMode
+      hWriteRdf NTriplesSerializer h rdfGraph
+      hClose h
+      C.unpack <$> Data.Knob.getContents knob
+    let expected = "<file:///this/is/not/a/palindrome> <file:///this/is/not/a/palindrome> \"literal string\" .\n"
+    assert $ expected == fileContents
+
+  where
+    rdfGraph :: TriplesGraph
+    rdfGraph = mkRdf tris baseURL globalPrefix
+
+    globalPrefix :: PrefixMappings
+    globalPrefix = ns_mappings []
+
+    baseURL :: Maybe BaseUrl
+    baseURL = Just $ BaseUrl "file://"
+
+    testURL = "file:///this/is/not/a/palindrome"
+
+    tris :: [Triple]
+    tris = [Triple
+           (unode testURL)
+           (unode testURL)
+           (LNode . PlainL . T.pack $ "literal string")]