Commits

Doug Burke committed bec10db

Use a URI rather than a string for QName/parsing

  • Participants
  • Parent commits cc2ec52
  • Branches parser-rewrite-polyparse

Comments (0)

Files changed (17)

 
   - Namespace now uses Maybe String to store the optional prefix rather than
     an ad-hoc ""/"?" solution and URI rather than String for the URI.
+    QName also uses URIs and no longer exports the constructor so newQName
+    or related should be used to create QNames.
+
+    We have currently lost N3 formatting of the default prefix (any default
+    prefix elements end up getting written out fully qualified). The output
+    is still valid N3 but perhaps not what you'd expect.
 
 0.3.2.1:
 

File Swish/RDF/N3Parser.hs

+{-# LANGUAGE OverloadedStrings #-} -- only used in 'fromMaybe "" mbase' line of parseN3
+
 --------------------------------------------------------------------------------
 --  See end of this file for licence information.
 --------------------------------------------------------------------------------
 --
 --  Maintainer  :  Douglas Burke
 --  Stability   :  experimental
---  Portability :  H98
+--  Portability :  OverloadedStrings
 --
 --  This Module implements a Notation 3 parser (see [1], [2], [3]), returning a
 --  new 'RDFGraph' consisting of triples and namespace information parsed from
     ( Namespace(..)
     , ScopedName(..)
     , getScopedNameURI
-    , makeScopedName, makeUriScopedName
+    , makeURIScopedName
     , makeQNameScopedName
     , nullScopedName
     )
     , mkTypedLit
     , hex4  
     , hex8  
+    , appendURIs
     )
 
 import Control.Applicative
 import Control.Monad (forM_, foldM)
 
-import Network.URI (URI, 
-                    relativeTo,
-                    parseURI, parseURIReference, uriToString)
+import Network.URI (URI(..), parseURIReference)
 
 import Data.Char (isSpace, isDigit, chr) 
 import Data.Maybe (fromMaybe, fromJust)
         s' = mapReplaceOrAdd (nam,snam) (syntaxUris st)
 
 setSUri :: String -> URI -> N3State -> N3State
-setSUri nam suri = setSName nam (makeScopedName Nothing suri "")
+setSUri nam = setSName nam . makeURIScopedName
 
 -- | Set the list of tokens that can be used without needing the leading 
 -- \@ symbol.
 getSName :: N3State -> String -> ScopedName
 getSName st nam =  mapFind nullScopedName nam (syntaxUris st)
 
-getSUri :: N3State -> String -> String
+getSUri :: N3State -> String -> URI
 getSUri st nam = getScopedNameURI $ getSName st nam
 
 --  Map prefix to URI
 test = either error id . parseAnyfromString document Nothing
 -}
 
+hashURI :: URI
+hashURI = fromJust $ parseURIReference "#"
+
+-- TODO: change from QName to URI for the base?
+
 -- | Function to supply initial context and parse supplied term.
 --
 parseAnyfromText :: N3Parser a      -- ^ parser to apply
               }
   
       puri = case mbase of
-        Just base -> appendUris (getQNameURI base) "#"
-        _ -> Right $ fromJust $ parseURIReference "#"
+        Just base -> appendURIs (getQNameURI base) hashURI
+        _ -> Right $ hashURI
 
       -- this is getting a bit ugly
         
             _ -> fail $ "Undefined prefix: '" ++ pref ++ "'"
 -}
 
-parseAbsURIrefFromText :: L.Text -> Either String String
+parseAbsURIrefFromText :: L.Text -> Either String URI
 parseAbsURIrefFromText =
-    parseAnyfromText (fmap showURI explicitURI) Nothing
+    parseAnyfromText explicitURI Nothing
 
-parseLexURIrefFromText :: L.Text -> Either String String
+parseLexURIrefFromText :: L.Text -> Either String URI
 parseLexURIrefFromText =
     parseAnyfromText lexUriRef Nothing
 
   lexeme $ string s *> notFollowedBy (== ':')
   return s
 
-showURI :: URI -> String
-showURI u = uriToString id u ""
-
 {-
 Since operatorLabel can be used to add a label with an 
 unknown namespace, we need to ensure that the namespace
   -- TODO: do the whitespace definitions match?
   ustr <- between lb rb $ many (satisfy (/= '>'))
   let uclean = filter (not . isSpace) ustr
+  
+  case parseURIReference uclean of
+    Nothing -> fail $ "Unable to convert <" ++ uclean ++ "> to a URI"
+    Just uref -> do
+      s <- stGet
+      let base = getSUri s "base"
+      either fail return $ appendURIs base uref
       
-  s <- stGet
-  let base = getSUri s "base"
-      
-  case appendUris base uclean of 
-    Right uri -> return uri
-    Left emsg -> fail emsg
-      
-appendUris :: String -> String -> Either String URI
-appendUris base uri =
-  case parseURI uri of
-    Just absuri -> Right absuri
-    _ -> case parseURIReference uri of
-      Just reluri -> 
-        let baseuri = fromJust $ parseURI base
-        in case relativeTo reluri baseuri of
-          Just resuri -> Right resuri
-          _ -> Left $ "Unable to append <" ++ uri ++ "> to base=<" ++ base ++ ">"
-          
-      _ -> Left $ "Invalid URI: <" ++ uri ++ ">"
-      
--- production from the old parser
-lexUriRef :: N3Parser String
-lexUriRef = fmap showURI $ lexeme explicitURI
+-- production from the old parser; used in SwishScript
+lexUriRef :: N3Parser URI
+lexUriRef = lexeme explicitURI
 
 {-
 barename ::=	[A-Z_a-z#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x02ff#x0370-#x037d#x037f-#x1fff#x200c-#x200d#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff][\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*
 
 n3symbol :: N3Parser ScopedName
 n3symbol = 
-  ((makeUriScopedName . showURI) <$> explicitURI)
+  (makeURIScopedName <$> explicitURI)
   <|> qname
 
 symbolCsl :: N3Parser [ScopedName]
   st <- stGet
   if getAllowLocalNames st
     then ScopedName <$> getDefaultPrefix <*> pure name
-    else fail "Invalid 'bare' word" -- TODO: not ideal error message; can we handle this case differently?
+    else fail ("Invalid 'bare' word: " ++ name)-- TODO: not ideal error message; can we handle this case differently?
 
 {-
 existential ::=		|	 "@forSome"  symbol_csl

File Swish/RDF/NTParser.hs

 
 import Swish.RDF.GraphClass (arc)
 
-import Swish.Utils.Namespace (ScopedName(..), makeUriScopedName)
+import Swish.Utils.Namespace (ScopedName(..), makeURIScopedName)
 
 import Swish.RDF.Vocabulary (langName)
 
 -}
 
 import Control.Applicative
-import Control.Monad (when)
 
 import Network.URI (parseURI)
 
 import qualified Data.Text.Lazy as L
 
 import Data.Char (chr) 
-import Data.Maybe (fromMaybe, isNothing)
+import Data.Maybe (fromMaybe)
 
 import Text.ParserCombinators.Poly.StateText
 
   ustr <- L.unpack <$> bracket (char '<') (char '>') (many1Satisfy (/= '>'))
   -- ustr <- bracket (char '<') (char '>') $ many1 character -- looks like need to exclude > from character
   -- ustr <- char '<' *> manyTill character (char '>')
-  when (isNothing (parseURI ustr)) $
-    failBad ("Invalid URI: <" ++ ustr ++ ">")
-  return $ makeUriScopedName ustr
+  
+  maybe (failBad ("Invalid URI: <" ++ ustr ++ ">"))
+    (return . makeURIScopedName)
+    (parseURI ustr)
 
 urirefLbl :: NTParser RDFLabel
 urirefLbl = Res <$> uriref

File Swish/RDF/RDFGraph.hs

     , ScopedName(..)
     , getQName
     , makeQNameScopedName
-    , makeUriScopedName
+    , makeURIScopedName
     , nullScopedName
     )
 
 
 import Control.Applicative (Applicative, liftA, (<$>), (<*>))
 
-import Network.URI (URI, parseURI, uriToString)
+import Network.URI (URI)
 
 import Data.Monoid (Monoid(..))
 import Data.Char (ord, isDigit, toLower)
   
 -- | Converts to a Resource.
 instance ToRDFLabel URI where  
-  toRDFLabel u = Res $ makeUriScopedName $ uriToString id u ""
+  toRDFLabel = Res . makeURIScopedName
   
 -- | Converts from a Resource.
 instance FromRDFLabel URI where
-  fromRDFLabel (Res sn) = parseURI $ getScopedNameURI sn
+  fromRDFLabel (Res sn) = Just $ getScopedNameURI sn
   fromRDFLabel _        = Nothing
 
 -- | Get the canonical string for RDF label.
 --  the same hash value.
 --    
 showCanon :: RDFLabel -> String
-showCanon (Res sn)           = "<"++getScopedNameURI sn++">"
+showCanon (Res sn)           = "<"++show (getScopedNameURI sn)++">"
 showCanon (Lit st (Just nam))
         | isLang nam = quote1Str st ++ "@"  ++ langTag nam
-        | otherwise  = quote1Str st ++ "^^" ++ getScopedNameURI nam
+        | otherwise  = quote1Str st ++ "^^" ++ show (getScopedNameURI nam)
 showCanon s                  = show s
 
 {-

File Swish/RDF/RDFParser.hs

     , mkTypedLit
     , hex4
     , hex8
+    , appendURIs
     )
     where
 
 
 import Text.ParserCombinators.Poly.StateText
 
-import Network.URI (parseURIReference)
+import Network.URI (URI(..), relativeTo, parseURIReference)
 
 import Data.Char (isSpace, isHexDigit, chr)
 import Data.Maybe (fromMaybe, fromJust)
 
 -- Code
 
+-- | Append the two URIs. Should probably be moved
+--   out of RDFParser. It is also just a thin wrapper around
+--   `Network.URI.relativeTo`.
+
+appendURIs ::
+  URI     -- ^ The base URI
+  -> URI  -- ^ The URI to append (it can be an absolute URI).
+  -> Either String URI
+appendURIs base uri =
+  case uriScheme uri of
+    "" -> case uri `relativeTo` base of
+          Just out -> Right out
+          _ -> Left $ "Unable to append <" ++ show uri ++ "> to base=<" ++ show base ++ ">"
+    _  -> Right uri
+  
 -- | Type for special name lookup table
 type SpecialMap = LookupMap (String,ScopedName)
 

File Swish/RDF/SwishCommands.hs

+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 --  See end of this file for licence information.
 --------------------------------------------------------------------------------
 --
 --  Maintainer  :  Douglas Burke
 --  Stability   :  experimental
---  Portability :  H98
+--  Portability :  OverloadedStrings
 --
 --  SwishCommands:  functions to deal with indivudual Swish command options.
 --
 
 import Swish.RDF.N3Parser (parseN3)
 import Swish.RDF.NTParser (parseNT)
+import Swish.RDF.RDFParser (appendURIs)
 
 import Swish.RDF.GraphClass
     ( LDGraph(..)
     , stdin, stdout
     )
 
-import Network.URI (URI, 
-                    relativeTo,
-                    parseURI, parseURIReference, uriToString)
+import Network.URI (parseURIReference)
 
 import Control.Monad.Trans (MonadTrans(..))
 import Control.Monad.State (modify, gets)
 -}
 
 defURI :: QName
-defURI = qnameFromURI "http://id.ninebynine.org/2003/Swish/"
+defURI = "http://id.ninebynine.org/2003/Swish/"
 
 calculateBaseURI ::
   Maybe FilePath -- ^ file name
   -> SwishStateIO QName -- ^ base URI
-  
 calculateBaseURI Nothing = fromMaybe defURI `liftM` gets base
-    
-calculateBaseURI (Just fnam) = do
-  mbase <- gets base
-  case mbase of
-    Just buri -> case appendUris (getQNameURI buri) fnam of
-      Left emsg -> fail emsg -- TODO: think about this ...
-      Right res -> return $ qnameFromURI $ showURI res
-    Nothing -> lift $ qnameFromFilePath fnam
+calculateBaseURI (Just fnam) =
+  case parseURIReference fnam of
+    Just furi -> do
+      mbase <- gets base
+      case mbase of
+        Just buri -> case appendURIs (getQNameURI buri) furi of
+          Left emsg -> fail emsg -- TODO: think about this ...
+          Right res -> return $ qnameFromURI res
+        Nothing -> lift $ qnameFromFilePath fnam
+        
+    Nothing -> fail $ "Unable to convert to URI: filepath=" ++ fnam
 
--- this is also in N3Parser
-showURI :: URI -> String
-showURI u = uriToString id u ""
-
--- this is also in N3Parser
-appendUris :: String -> String -> Either String URI
-appendUris buri uri =
-  case parseURI uri of
-    Just absuri -> Right absuri
-    _ -> case parseURIReference uri of
-      Just reluri -> case parseURI buri of
-        Just baseuri -> case relativeTo reluri baseuri of
-          Just resuri -> Right resuri
-          _ -> Left $ "Unable to append <" ++ uri ++ "> to base=<" ++ buri ++ ">"
-          
-        _ -> Left $ "Invalid base URI: <" ++ buri ++ ">"
-      _ -> Left $ "Invalid URI: <" ++ uri ++ ">"
-      
 swishParseScript ::
   Maybe String -- file name (or "stdin" if Nothing)
   -> T.Text    -- script contents

File Swish/RDF/SwishMain.hs

 validateBase :: Maybe String -> Either (String, SwishStatus) SwishAction
 validateBase Nothing  = Right $ SA (Nothing, swishBase Nothing)
 validateBase (Just b) =
-  case parseURI b of
-    Just _ -> Right $ SA (Nothing, swishBase (Just (qnameFromURI b)))
+  case fmap qnameFromURI (parseURI b) of
+    j@(Just _) -> Right $ SA (Nothing, swishBase j)
     _      -> Left ("Invalid base URI <" ++ b ++ ">", SwishArgumentError)
   
 ------------------------------------------------------------
---  Interactive test function (e.g. for use in Hugs)
+--  Interactive test function (e.g. for use in ghci)
 ------------------------------------------------------------
 
 -- this ignores the "flags" options, namely

File Swish/RDF/SwishScript.hs

     )
 
 import Swish.RDF.N3Formatter (formatGraphAsBuilder)
-
 import Swish.RDF.Datatype (typeMkRules)
-
 import Swish.RDF.Proof (explainProof, showsProof)
-
-import Swish.RDF.Ruleset
-    ( makeRuleset, getRulesetRule, getMaybeContextRule )
-
-import Swish.RDF.Rule
-    ( Formula(..), Rule(..) -- , RuleMap
-    )
-
+import Swish.RDF.Ruleset (makeRuleset, getRulesetRule, getMaybeContextRule)
+import Swish.RDF.Rule (Formula(..), Rule(..)) 
 import Swish.RDF.VarBinding (composeSequence)
 
 import Swish.Utils.Namespace (ScopedName(..))
 import Control.Monad (unless, when, liftM)
 import Control.Monad.State (modify, gets, lift)
 
+import Network.URI (URI(..))
+
 import Data.Monoid (Monoid(..))
-import Data.List (isPrefixOf)
 
 import qualified System.IO.Error as IO
 
 nameItem = 
   ssAddGraph <$> n3SymLex <*> (symbol ":-" *> graphOrList)
   
-maybeURI :: N3Parser (Maybe String)
+maybeURI :: N3Parser (Maybe URI)
 maybeURI = (Just <$> lexUriRef) <|> return Nothing
 
 --  @read name  [ <uri> ]
             Nothing  -> Left ("Graph or list not present: "++show nam)
             Just grs -> Right grs
 
-ssRead :: ScopedName -> Maybe String -> SwishStateIO ()
+ssRead :: ScopedName -> Maybe URI -> SwishStateIO ()
 ssRead nam muri = ssAddGraph nam [ssReadGraph muri]
 
-ssReadGraph :: Maybe String -> SwishStateIO (Either String RDFGraph)
+ssReadGraph :: Maybe URI -> SwishStateIO (Either String RDFGraph)
 ssReadGraph muri = 
   let gf inp = case inp of
         Left  es -> Left es
   in gf `liftM` getResourceData muri
 
 ssWriteList ::
-    Maybe String -> SwishStateIO (Either String [RDFGraph]) -> String
+    Maybe URI -> SwishStateIO (Either String [RDFGraph]) -> String
     -> SwishStateIO ()
-ssWriteList muri gf comment =
-        do  { esgs <- gf
-            ; case esgs of
-                Left  er   -> modify $ setError ("Cannot write list: "++er)
-                Right []   -> putResourceData Nothing (B.fromLazyText (L.concat ["# ", L.pack comment, "\n+ Swish: Writing empty list"]))
-                Right [gr] -> ssWriteGraph muri gr comment
-                Right grs  -> mapM_ writegr (zip [(0::Int)..] grs)
-                  where
-                    writegr (n,gr) = ssWriteGraph (murin muri n) gr
-                        ("["++show n++"] "++comment)
-                    murin Nothing    _ = Nothing
-                    murin (Just uri) n = Just (inituri++show n++lasturi)
-                        where
-                            splituri1 = splitBy (=='/') uri
-                            splituri2 = splitBy (=='.') (lastseg splituri1)
-                            inituri   = concat (initseg splituri1 ++ initseg splituri2)
-                            lasturi   = lastseg splituri2
-            }
-
-splitBy :: (a->Bool) -> [a] -> [[a]]
-splitBy _ []  = []
-splitBy p (s0:str) = let (s1,sr) = break p str in
-    (s0:s1):splitBy p sr
-
-lastseg :: [[a]] -> [a]
-lastseg []   = []
-lastseg [_]  = []
-lastseg ass  = last ass
-
-initseg :: [[a]] -> [[a]]
-initseg []   = []
-initseg [as] = [as]
-initseg ass  = init ass
+ssWriteList muri gf comment = do
+  esgs <- gf
+  case esgs of
+    Left  er   -> modify $ setError ("Cannot write list: "++er)
+    Right []   -> putResourceData Nothing (B.fromLazyText (L.concat ["# ", L.pack comment, "\n+ Swish: Writing empty list"]))
+    Right [gr] -> ssWriteGraph muri gr comment
+    Right grs  -> mapM_ writegr (zip [(0::Int)..] grs)
+      where
+        writegr (n,gr) = ssWriteGraph (murin muri n) gr
+                         ("["++show n++"] "++comment)
+        murin Nothing    _ = Nothing
+        murin (Just uri) n = 
+          let rp = reverse $ uriPath uri
+              (rLastSet, rRest) = break (=='/') rp
+              (before, after) = break (=='.') $ reverse rLastSet
+              newPath = reverse rRest ++ "/" ++ before ++ show n ++ after
+          in case rLastSet of
+            "" -> error $ "Invalid URI (path ends in /): " ++ show uri
+            _ -> Just $ uri { uriPath = newPath }
+         
+  
 
 {-
 ssWrite ::
             }
 -}
 
-ssWriteGraph :: Maybe String -> RDFGraph -> String -> SwishStateIO ()
+ssWriteGraph :: Maybe URI -> RDFGraph -> String -> SwishStateIO ()
 ssWriteGraph muri gr comment =
     putResourceData muri (c `mappend` formatGraphAsBuilder gr)
     where
 --  Temporary implementation:  just read local file WNH     
 --  (Add logic to separate filenames from URIs, and
 --  attempt HTTP GET, or similar.)
-getResourceData :: Maybe String -> SwishStateIO (Either String L.Text)
+getResourceData :: Maybe URI -> SwishStateIO (Either String L.Text)
 getResourceData muri =
     case muri of
         Nothing  -> fromStdin
             ; return $ Right dat
             }
     fromUri = fromFile
-    fromFile uri | "file://" `isPrefixOf` uri = do
-      dat <- lift $ LIO.readFile $ drop 7 uri
-      return $ Right dat
-                 | otherwise = error $ "Unsupported file name for read: " ++ uri
+    fromFile uri | uriScheme uri == "file:" = Right `fmap` (lift $ LIO.readFile $ uriPath uri)
+                 | otherwise = error $ "Unsupported file name for read: " ++ show uri
                                
 --  Temporary implementation:  just write local file
 --  (Need to add logic to separate filenames from URIs, and
 --  attempt HTTP PUT, or similar.)
-putResourceData :: Maybe String -> B.Builder -> SwishStateIO ()
+putResourceData :: Maybe URI -> B.Builder -> SwishStateIO ()
 putResourceData muri gsh =
     do  { ios <- lift $ IO.try $
             case muri of
         }
     where
         toStdout  = LIO.putStrLn gstr
-        toUri uri | "file://" `isPrefixOf` uri = LIO.writeFile (drop 7 uri) gstr
-                  | otherwise = error $ "Unsupported file name for write: " ++ uri
+        toUri uri | uriScheme uri == "file:" = LIO.writeFile (uriPath uri) gstr
+                  | otherwise                = error $ "Unsupported file name for write: " ++ show uri
         gstr = B.toLazyText gsh
 
 {- $syntax

File Swish/Utils/Namespace.hs

     , getScopePrefix, getScopeURI
     , getQName, getScopedNameURI
     , matchName
-    , makeScopedName, makeQNameScopedName, makeUriScopedName
+    , makeScopedName
+    , makeQNameScopedName
+    , makeURIScopedName
     , nullScopedName
     , namespaceToBuilder
     )
     where
 
-import Swish.Utils.QName (QName(..), getQNameURI)
+import Swish.Utils.QName (QName, newQName, getQNameURI, getNamespace, getLocalName)
 import Swish.Utils.LookupMap (LookupEntryClass(..))
 
 import Data.Monoid (Monoid(..))
 nsEq (Namespace _ u1) (Namespace _ u2) = u1 == u2
 
 makeNamespaceQName :: Namespace -> String -> QName
-makeNamespaceQName (Namespace _ uri) = QName (show uri)
+makeNamespaceQName (Namespace _ uri) = newQName uri
 
 {-
 nullNamespace :: Namespace
 getScopeURI = nsURI . snScope
 
 instance IsString ScopedName where
-  fromString = makeUriScopedName
+  fromString s =   -- ^ This is not total since it will fail if the input string is not a valid URI
+    maybe (error ("Unable to convert " ++ s ++ " into a ScopedName"))
+          makeURIScopedName (parseURIReference s)
     
 instance Eq ScopedName where
     (==) = snEq
 
 -- |Get QName corresponding to a scoped name
 getQName :: ScopedName -> QName
-getQName n = QName (show (getScopeURI n)) (snLocal n)
+getQName n = newQName (getScopeURI n) (snLocal n)
 
 -- |Get URI corresponding to a scoped name (using RDF conventions)
-getScopedNameURI :: ScopedName -> String
+getScopedNameURI :: ScopedName -> URI
 getScopedNameURI = getQNameURI . getQName
 
 -- |Test if supplied string matches the display form of a
 to know whether this is sensible (probably is, but should look at).
 -}
 
-toBeReplaced :: String -> String -> ScopedName
-toBeReplaced u l =
-  let uri = fromMaybe (error ("Unable to convert " ++ u ++ " to a URI")) $ parseURIReference u
-  in makeScopedName Nothing uri l
-
 -- |Construct a ScopedName from a QName
 makeQNameScopedName :: QName -> ScopedName
-makeQNameScopedName (QName u l) = toBeReplaced u l
+{-
+The following is not correct
+makeQNameScopedName qn = makeScopedName Nothing (getNamespace qn) (getLocalName qn)
+since you get
+swish> let sn1 = makeQNameScopedName  "file:///foo/bar/baz"
+swish> sn1
+<file:///foo/barbaz>
+-}
+makeQNameScopedName qn = 
+  let ns = getNamespace qn
+      ln = getLocalName qn
+  in makeScopedName Nothing ns ln
 
--- |Construct a ScopedName for a bare URI
-makeUriScopedName :: String -> ScopedName
-makeUriScopedName u = toBeReplaced u ""
+-- |Construct a ScopedName for a bare URI (the label is set to "").
+makeURIScopedName :: URI -> ScopedName
+makeURIScopedName uri = makeScopedName Nothing uri ""
 
 -- |This should never appear as a valid name
 nullScopedName :: ScopedName
-nullScopedName = makeScopedName Nothing nullURI ""
+nullScopedName = makeURIScopedName nullURI
 
 --------------------------------------------------------------------------------
 --

File Swish/Utils/QName.hs

 --
 --------------------------------------------------------------------------------
 
+-- At present we support using URI references rather than forcing an absolute
+-- URI. This is partly to support the existing tests (to lazy to resolve whether
+-- the tests really should be using relative URIs in this case).
+
 module Swish.Utils.QName
-    ( QName(..) -- , maybeQnEq
-    , newQName, qnameFromPair, qnameFromURI
-    , getNamespace, getLocalName, getQNameURI
-    , splitURI
+    ( QName
+    , newQName
+    , qnameFromURI
+    , getNamespace
+    , getLocalName
+    , getQNameURI
     , qnameFromFilePath
     )
-where
-
-import Data.Char (isAlpha, isAlphaNum)
+    where
 
 import System.Directory (canonicalizePath)
-import System.FilePath (splitDirectories)
+-- import System.FilePath (splitDirectories)
+
+import Network.URI (URI(..), URIAuth(..), parseURIReference)
+
 import Data.String (IsString(..))
-import Data.List (intercalate)
+-- import Data.Char (isAlpha, isAlphaNum)
+import Data.Maybe (fromMaybe)
+-- import Data.List (intercalate)
 
 ------------------------------------------------------------
 --  Qualified name
 --
 --  cf. http://www.w3.org/TR/REC-xml-names/
 
-data QName = QName { qnNsuri, qnLocal :: String }
+{-| 
+
+A qualified name, consisting of a namespace URI
+and the local part of the identifier.
+
+-}
+
+{-
+For now I have added in storing the actual URI
+as well as the namespace component. This may or
+may not be a good idea (space vs time saving).
+-}
+
+data QName = QName
+             { qnURI :: URI       -- ^ URI
+             , qnNsuri :: URI     -- ^ namespace 
+             , qnLocal :: String  -- ^ local component
+             }
 
 instance IsString QName where
-  fromString = qnameFromURI
+  -- fromString = qnameFromURI . fromJust . parseURI -- ^ This is not total since it will fail if the input string is not a valid URI
+  fromString s =   -- ^ This is not total since it will fail if the input string is not a valid URI
+    maybe (error ("Unable to convert " ++ s ++ " into a QName"))
+          qnameFromURI (parseURIReference s)
 
 instance Eq QName where
     (==) = qnEq
 
+-- ugly, use show instance
+    
 instance Ord QName where
+  {-
     (QName u1 l1) <= (QName u2 l2) =
         if up1 /= up2 then up1 <= up2 else (ur1++l1) <= (ur2++l2)
         where
             n   = min (length u1) (length u2)
             (up1,ur1) = splitAt n u1
             (up2,ur2) = splitAt n u2
+  -}
+  
+  -- could say (QName u1 _ _) <= QName u2 _ _) = show u1 <= show u2
+  (QName _ uri1 l1) <= (QName _ uri2 l2) =
+    if up1 /= up2 then up1 <= up2 else (ur1++l1) <= (ur2++l2)
+      where
+        u1 = show uri1
+        u2 = show uri2
+        
+        n   = min (length u1) (length u2)
+        (up1,ur1) = splitAt n u1
+        (up2,ur2) = splitAt n u2
+  
+  
+instance Show QName where
+    show (QName u _ _) = "<" ++ show u ++ ">"
 
-instance Show QName where
-    show (QName ns ln) = "<" ++ ns ++ ln ++ ">"
+{-
+Should this be clever and ensure that local doesn't
+contain /, say?
 
-newQName :: String -> String -> QName
-newQName = QName
+We could also me more clever, and safer, when constructing
+the overall uri.
+-}
+newQName :: URI -> String -> QName
+newQName ns local = 
+  let uristr = show ns ++ local
+      uri = fromMaybe (error ("Unable to parse URI from: '" ++ show ns ++ "' + '" ++ local ++ "'")) (parseURIReference uristr)
+  in QName uri ns local
 
-qnameFromPair :: (String,String) -> QName
-qnameFromPair = uncurry QName
+{-
 
-qnameFromURI :: String -> QName
-qnameFromURI = qnameFromPair . splitURI
+old behavior
 
-getNamespace :: QName -> String
+ splitQname "http://example.org/aaa#bbb" = ("http://example.org/aaa#","bbb")
+ splitQname "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb")
+ splitQname "http://example.org/aaa/"    = ("http://example.org/aaa/","")
+
+Should "urn:foo:bar" have a local name of "" or "foo:bar"? For now go
+with the first option.
+
+-}
+
+qnameFromURI :: URI -> QName
+qnameFromURI uri =
+  let uf = uriFragment uri
+      up = uriPath uri
+      q0 = QName uri uri ""
+  in case uf of
+    "#"    -> q0
+    '#':xs -> QName uri (uri { uriFragment = "#" }) xs
+    ""     -> case break (=='/') (reverse up) of
+      ("",_) -> q0 -- path ends in / or is empty
+      (_,"") -> q0 -- path contains no /
+      (rlname,rpath) -> QName uri (uri {uriPath = reverse rpath}) (reverse rlname) 
+      
+    e -> error $ "Unexpected: uri=" ++ show uri ++ " has fragment='" ++ show e ++ "'" 
+
+getNamespace :: QName -> URI
 getNamespace = qnNsuri
 
 getLocalName :: QName -> String
 getLocalName = qnLocal
 
-getQNameURI :: QName -> String
-getQNameURI (QName ns ln) = ns++ln
+getQNameURI :: QName -> URI
+getQNameURI = qnURI
 
---  Original used comparison of concatenated strings,
---  but that was very inefficient.  This version does the
---  comparison without constructing new values
+{-
+Original used comparison of concatenated strings,
+but that was very inefficient.  The longer version below
+does the comparison without constructing new values but is
+no longer valid with the namespace being stored as a URI,
+so for now just compare the overall URIs and we can
+optimize this at a later date if needed.
+-}
 qnEq :: QName -> QName -> Bool
-qnEq (QName n1 l1) (QName n2 l2) = qnEq1 n1 n2 l1 l2
+qnEq (QName u1 _ _) (QName u2 _ _) = u1 == u2
+{-
+qnEq (QName _ n1 l1) (QName _ n2 l2) = qnEq1 n1 n2 l1 l2
   where
     qnEq1 (c1:ns1) (c2:ns2)  ln1 ln2   = c1==c2 && qnEq1 ns1 ns2 ln1 ln2
     qnEq1 []  ns2  ln1@(_:_) ln2       = qnEq1 ln1 ns2 []  ln2
     qnEq1 ns1 []   ln1       ln2@(_:_) = qnEq1 ns1 ln2 ln1 []
     qnEq1 []  []   []        []        = True
     qnEq1 _   _    _         _         = False
-
-{-
---  Define equality of (Maybe QName)
-maybeQnEq :: (Maybe QName) -> (Maybe QName) -> Bool
-maybeQnEq Nothing   Nothing   = True
-maybeQnEq (Just q1) (Just q2) = q1 == q2
-maybeQnEq _         _         = False
 -}
 
--- Separate URI string into namespace URI and local name
-splitURI :: String -> ( String, String )
-  -- splitQname "http://example.org/aaa#bbb" = ("http://example.org/aaa#","bbb")
-  -- splitQname "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb")
-  -- splitQname "http://example.org/aaa/"    = ("http://example.org/aaa/","")
-splitURI qn = splitAt (scanURI qn (-1) 0) qn
-
--- helper function for splitQName
--- Takes 3 arguments:
---   QName to scan
---   index of last name-start char, or (-1)
---   number of characters scanned so far
--- Returns index of start of name, or length of list
---
-scanURI :: String -> Int -> Int -> Int
-scanURI (nextch:more) (-1) nc
-    | isNameStartChar nextch  = scanURI more nc   (nc+1)
-    | otherwise               = scanURI more (-1) (nc+1)
-scanURI (nextch:more) ns nc
-    | not (isNameChar nextch) = scanURI more (-1) (nc+1)
-    | otherwise               = scanURI more ns   (nc+1)
-scanURI "" (-1) nc = nc
-scanURI "" ns   _  = ns
-
-
-
 -- Definitions here per XML namespaces, NCName production,
 -- restricted to characters used in URIs.
 -- cf. http://www.w3.org/TR/REC-xml-names/
 
+{-
 isNameStartChar :: Char -> Bool
 isNameStartChar c = isAlpha c || c == '_'
 
 isNameChar :: Char -> Bool
 isNameChar      c = isAlphaNum c || c `elem` ".-_"
+-}
 
 {-|
 Convert a filepath to a file: URI stored in a QName. If the
 to convert it into an absolute path.
 
 If the input represents a directory then it *must* end in 
-the directory separator - e.g. @\"\/foo\/bar\/\"@ rather than 
-@\"\/foo\/bar\"@
-for Posix systems.
+the directory separator - so for Posix systems use 
+@\"\/foo\/bar\/\"@ rather than 
+@\"\/foo\/bar\"@.
 
 This has not been tested on Windows.
 -}
+
+{-
+NOTE: not sure what I say directories should end in the path
+seperator since
+
+ghci> System.Directory.canonicalizePath "/Users/dburke/haskell/swish-text"
+"/Users/dburke/haskell/swish-text"
+ghci> System.Directory.canonicalizePath "/Users/dburke/haskell/swish-text/"
+"/Users/dburke/haskell/swish-text"
+
+-}
+
+-- since we build up the URI manually we could
+-- create the QName directly, but leave that 
+-- for now.
+
 qnameFromFilePath :: FilePath -> IO QName
 qnameFromFilePath = fmap qnameFromURI . filePathToURI
   
-filePathToURI :: FilePath -> IO String
+emptyAuth :: Maybe URIAuth
+emptyAuth = Just $ URIAuth "" "" ""
+
+filePathToURI :: FilePath -> IO URI
 filePathToURI fname = do
   ipath <- canonicalizePath fname
+  
+  {-
   let paths = splitDirectories ipath
       txt = intercalate "/" $ case paths of
         "/":rs -> rs
         _      -> paths
+  -}
   
-  return $ "file:///" ++ txt
+  -- Is manually creating the URI sensible?
+  -- return $ fromJust $ parseURI $ "file:///" ++ txt
+  -- return $ URI "file:" emptyAuth txt "" ""
+  return $ URI "file:" emptyAuth ipath "" ""
 
 --------------------------------------------------------------------------------
 --
       RDFDatatypeXsdString
     to convert to/from Text rather than String
 
-  - N3FormatterTest to use Text rather than String
+  - N3FormatterTest to use Text rather than String
+
+Issues in the conversion to URI for Namespace/QName/...
+
+* parse issues
+
+  @prefix : <file:///home/swish/photos/>.
+  @prefix me: <http://example.com/ns#>.
+  :me.jpg me:photoOf me:me .
+
+* base URI
+
+cwm rejects base URIs ending in # (need to try with a fragment as this 
+observation may be incorrect or fixed now).
+
+* Issues with the default prefix
+
+With the input file
+
+  @prefix : <file:///home/swish/photos/>.
+  @prefix my: <http://example.com/ns#>.
+  :mejpg my:photoOf my:me .
+
+old Swish will round-trip this to
+
+  @prefix : <file:///home/swish/photos/> .
+  @prefix my: <http://example.com/ns#> .
+  :mejpg my:photoOf my:me .
+
+but the current code creates
+
+  @prefix : <file:///home/swish/photos/> .
+  @prefix my: <http://example.com/ns#> .
+  <file:///home/swish/photos/mejpg> my:photoOf my:me .
+
+This happens when the default prefix is <http://foo.bar/baz/>, so
+it is unrelated to file.
+
+If we use a named prefix then things behave as expected: ie
+
+  @prefix p: <file:///home/swish/photos/>.
+  @prefix my: <http://example.com/ns#>.
+  p:mejpg my:photoOf my:me .
+
+is passed through unchnaged (except for an additional @prefix statement
+getting added).
+
+Need to add a test of this. Of course, the issue is what should the default
+namespace be on output; the one chosen from the input graph but then what
+if the input is from ntriples or there is another namespace with many more
+triples?
+
+*) default prefix
+
+Note, from the N3 submission it looks like the default prefix should be
+equivalent to 
+  @prefix : <#>.
+ie do not explicitly include the document identifier.
+
+*) @keywords in N3
+
+If @keywords is given then any bare name (not in the keywords list) is taken
+to be a local name in the default namespace => (ie treat foo as :foo).
       base >=3 && < 5,
       text == 0.11.*,
       -- text-format == 0.2.*,
+      -- split == 0.1.*,
       binary == 0.5.*,
       bytestring == 0.9.*,
       containers == 0.3.*,

File tests/N3FormatterTest.hs

 toNS :: String -> String -> Namespace
 toNS p = Namespace (Just p) . toURI
 
-base1, base2, base3, base4 :: Namespace
+toRes :: Namespace -> String -> RDFLabel
+toRes ns = Res . ScopedName ns
+
+base1, base2, base3, base4, basef, baseu, basem :: Namespace
 base1 = toNS "base1" "http://id.ninebynine.org/wip/2003/test/graph1/node#"
 base2 = toNS "base2" "http://id.ninebynine.org/wip/2003/test/graph2/node/"
 base3 = toNS "base3" "http://id.ninebynine.org/wip/2003/test/graph3/node"
 base4 = toNS "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
+basef = toNS "fbase" "file:///home/swish/photos/"
+baseu = toNS "ubase" "urn:one:two:3.14"
+basem = toNS "me"    "http://example.com/ns#"
+  
+s1, s2, s3, sf, su :: RDFLabel
+s1 = toRes base1 "s1"
+s2 = toRes base2 "s2"
+s3 = toRes base3 "s3"
 
-s1, s2, s3 :: RDFLabel
-s1 = Res $ ScopedName base1 "s1"
-s2 = Res $ ScopedName base2 "s2"
-s3 = Res $ ScopedName base3 "s3"
+sf = toRes basef "me.png"
+su = toRes baseu ""
+
+meDepicts, meMe, meHasURN :: RDFLabel
+meDepicts = toRes basem "depicts"
+meMe      = toRes basem "me"
+meHasURN  = toRes basem "hasURN"
 
 b1, b2, b3, b4, b5, b6, b7, b8 :: RDFLabel
 b1 = Blank "b1"
         f02 = arc s1 p1 b3
         formb3g1f2 = LookupMap [Formula b3 g1f2]
 
+g1fu1 :: RDFGraph
+g1fu1 =
+  mempty
+  { namespaces = makeLookupMap [basem, Namespace Nothing (toURI "file:///home/swish/photos/")]
+  , statements = [arc sf meDepicts meMe, arc sf meHasURN su]
+  }
+  
 ----
 
 g2, g3, g4, g5, g6, g7 :: RDFGraph
   , " }  .\n"
   ]
 
+-- try out URIs that do not use the http scheme
+simpleN3Graph_g1_fu1 :: B.Builder
+simpleN3Graph_g1_fu1 =
+  mconcat
+  [ "@prefix me: <http://example.com/ns#> .\n"
+  , "@prefix : <file:///home/swish/photos/> .\n"
+  -- , ":me.png me:depicts me:me ;\n"
+  , "<file:///home/swish/photos/me.png> me:depicts me:me ;\n"
+  , "     me:hasURN <urn:one:two:3.14> .\n"
+  ]
+
 {-
 Simple troublesome case
 -}
  , formatTest "trivialTest09" g1b3 simpleN3Graph_g1_09
  , formatTest "trivialTest10" g1f3 simpleN3Graph_g1_10
  , formatTest "trivialTest13a" x13a simpleN3Graph_x13a
+ , formatTest "trivialTestfu1" g1fu1 simpleN3Graph_g1_fu1
 
  , formatTest "trivialTestc1" graph_c1 simpleN3Graph_c1
  , formatTest "trivialTestc2" graph_c2 simpleN3Graph_c2
   , fullRoundTripTest "16rt" simpleN3Graph_g1_06_rt
     -- roundTripTest17 = fullRoundTripTest "17" simpleN3Graph_g1_07 -- TODO: :- with named node for formula
   , fullRoundTripTest "18" simpleN3Graph_g1_08
+  , fullRoundTripTest "fu1" simpleN3Graph_g1_fu1
   
   , fullRoundTripTest "l1"    simpleN3Graph_l1
   , fullRoundTripTest "l2"    simpleN3Graph_l2

File tests/N3ParserTest.hs

   , ScopedName(..)
   , makeScopedName
   , nullScopedName
-  , makeUriScopedName
+  -- , makeUriScopedName
   , namespaceToBuilder
   )
 
     , xsdDouble 
     )
 
+import Swish.RDF.GraphClass (Arc, arc) 
+
 import Swish.Utils.QName (QName, qnameFromURI)
 import Swish.Utils.LookupMap (LookupMap(..))
 
-import Swish.RDF.GraphClass (Arc, arc) 
-
 import Test.HUnit (Test(TestCase,TestList), assertEqual, runTestTT)
 
 import Network.URI (URI, nullURI, parseURI)
 
 import Data.Monoid (Monoid(..))
-import Data.Maybe (fromJust)
+import Data.Maybe (fromMaybe)
 
 import qualified Data.Text.Lazy as L
 import qualified Data.Text.Lazy.Builder as B
 
 toURI :: String -> URI
-toURI = fromJust . parseURI
+toURI s = fromMaybe (error ("Internal error: invalid uri=" ++ s)) (parseURI s)
 
 ------------------------------------------------------------
 --  Generic item parsing test wrapper
 --  Test absolute URIref parsing
 ------------------------------------------------------------
 
-parseAbsUriRefTest :: String -> L.Text -> String -> String -> Test
-parseAbsUriRefTest = parseItemTest parseAbsURIrefFromText ""
+parseAbsUriRefTest :: String -> L.Text -> URI -> String -> Test
+parseAbsUriRefTest = parseItemTest parseAbsURIrefFromText nullURI
 
-parseLexUriRefTest :: String -> L.Text -> String -> String -> Test
-parseLexUriRefTest = parseItemTest parseLexURIrefFromText ""
+parseLexUriRefTest :: String -> L.Text -> URI -> String -> Test
+parseLexUriRefTest = parseItemTest parseLexURIrefFromText nullURI
 
 absUriRefInp01, absUriRefInp01s, absUriRefInp02, absUriRefInp02s :: L.Text
 
 absUriRefInp02  = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1>"
 absUriRefInp02s = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> "
 
-absUriRef01, absUriRef02 :: String
+absUriRef01, absUriRef02 :: URI
 
-absUriRef01     = "http://www.w3.org/1999/02/22-rdf-syntax-ns#type"
-absUriRef02     = "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"
+absUriRef01     = toURI "http://www.w3.org/1999/02/22-rdf-syntax-ns#type"
+absUriRef02     = toURI "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"
 
 absUriRefTestSuite :: Test
 absUriRefTestSuite = TestList
 baseFile = "file:///dev/null"
 
 dqn :: QName
-dqn = qnameFromURI baseFile
+dqn = (qnameFromURI . toURI) baseFile
 
 toNS :: String -> String -> Namespace
 toNS p = Namespace (Just p) . toURI
 makeNewPrefixNamespace :: (String,Namespace) -> Namespace
 makeNewPrefixNamespace (pre,ns) = Namespace (Just pre) (nsURI ns)
 
-dg1 :: RDFGraph
+dg1, dg2, dg3 :: RDFGraph
 dg1 = toRDFGraph [arc ds1 dp1 do1]
-
-dg2 :: RDFGraph
 dg2 = toRDFGraph
       [ arc xa1 xb1 xc1
       , arc xa2 xb2 xc2
       ]
   where
     -- the document base is set to file:///dev/null to begin with
-    mU = Res . makeUriScopedName 
-    xa1 = mU "file:///dev/a1"
-    xb1 = mU "file:///dev/b1"
-    xc1 = mU "file:///dev/c1"
-    xa2 = mU "http://example.org/ns/a2"
-    xb2 = mU "http://example.org/ns/b2"
-    xc2 = mU "http://example.org/ns/c2"
-    xa3 = mU "http://example.org/ns/foo/a3"
-    xb3 = mU "http://example.org/ns/foo/b3"
-    xc3 = mU "http://example.org/ns/foo/c3"
+    xa1 = Res "file:///dev/a1"
+    xb1 = Res "file:///dev/b1"
+    xc1 = Res "file:///dev/c1"
+    xa2 = Res "http://example.org/ns/a2"
+    xb2 = Res "http://example.org/ns/b2"
+    xc2 = Res "http://example.org/ns/c2"
+    xa3 = Res "http://example.org/ns/foo/a3"
+    xb3 = Res "http://example.org/ns/foo/b3"
+    xc3 = Res "http://example.org/ns/foo/c3"
     
     ns4 = Namespace Nothing $ toURI "http://example.org/ns/foo/bar#"
     ns5 = Namespace Nothing $ toURI "http://example.org/ns2#"
     xb5 = mUN ns5 "b5"
     xc5 = mUN ns5 "c5"
 
+dg3 = -- TODO: add in prefixes ?
+  toRDFGraph [ arc (Res "file:///home/swish/photos/myphoto") (Res "http://example.com/ns#photoOf") (Res "http://example.com/ns#me")]
+  
 nslist, xnslist :: LookupMap Namespace
 nslist = LookupMap $ map makeNewPrefixNamespace
     [ ("base1",base1)
   , ":a5 :b5 :c5 .\n"
   ]
   
+-- try out file prefixes
+simpleN3Graph_dg_03 :: B.Builder  
+simpleN3Graph_dg_03 =  
+  mconcat
+  [ "@prefix : <file:///home/swish/photos/>.\n"
+  , "@prefix me: <http://example.com/ns#>.\n"
+  , ":myphoto me:photoOf me:me."
+  ]
+  
 commonPrefixes :: B.Builder
 commonPrefixes =
   mconcat $ map namespaceToBuilder [base1, base2, base3]
 simpleTestSuite = TestList
   [ parseTestB dqn "simpleTestd01" simpleN3Graph_dg_01 dg1  noError
   , parseTestB dqn "simpleTestd02" simpleN3Graph_dg_02 dg2  noError
+  , parseTestB dqn "simpleTestd03" simpleN3Graph_dg_03 dg3  noError
   , parseTest "simpleTest011" simpleN3Graph_g1_01 g1  noError
   , parseTest "simpleTest012" simpleN3Graph_g1_02 g1  noError
   , parseTest "simpleTest012a" simpleN3Graph_g1_02a g1a  noError

File tests/NTTest.hs

 {-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 --  See end of this file for licence information.
 --------------------------------------------------------------------------------
     , toRDFGraph
     )
 
-import Swish.Utils.Namespace (makeUriScopedName)
+-- import Swish.Utils.Namespace (makeURIScopedName)
 
 import Swish.RDF.Vocabulary (langName, rdfXMLLiteral)
 
 ------------------------------------------------------------
 
 s1, p1, p2, o1 :: RDFLabel
-s1 = Res $ makeUriScopedName "urn:b#s1"
-p1 = Res $ makeUriScopedName "urn:b#p1"
-p2 = Res $ makeUriScopedName "http://example.com/pred2"
-o1 = Res $ makeUriScopedName "urn:b#o1"
+s1 = Res $ "urn:b#s1" -- rely on IsString to convert to ScopedName
+p1 = Res $ "urn:b#p1"
+p2 = Res $ "http://example.com/pred2"
+o1 = Res $ "urn:b#o1"
+{-
+s1 = Res $ makeURIScopedName "urn:b#s1"
+p1 = Res $ makeURIScopedName "urn:b#p1"
+p2 = Res $ makeURIScopedName "http://example.com/pred2"
+o1 = Res $ makeURIScopedName "urn:b#o1"
+-}
 
 l0, l1, l2, l3, l4 :: RDFLabel
 l0 = Lit "" Nothing

File tests/QNameTest.hs

 --
 --  Maintainer  :  Douglas Burke
 --  Stability   :  experimental
---  Portability :  H98
+--  Portability :  OverloadedStrings
 --
---  This module defines test cases for QName data
+--  This module defines test cases for QName data. It also throws in a few
+--  tests for the Namespace module.
 --
 --------------------------------------------------------------------------------
 
 module Main where
 
 import Swish.Utils.QName
-    ( QName(..)
-    , newQName, qnameFromPair, qnameFromURI
-    , getNamespace, getLocalName, getQNameURI
-    , splitURI
+    ( QName
+    , newQName
+    , qnameFromURI
+    , getNamespace
+    , getLocalName
+    , getQNameURI
     )
 
-import Test.HUnit
-    ( Test(TestCase,TestList)
-    , assertEqual
-    , runTestTT
-    )
+import Swish.Utils.Namespace (makeQNameScopedName, getQName, getScopedNameURI)
+import Test.HUnit (Test(TestCase,TestList), assertEqual, runTestTT)
 
-
-
+import Network.URI (URI, parseURIReference)
+import Data.Maybe (fromJust)
 
 ------------------------------------------------------------
 --  Define some common values
 ------------------------------------------------------------
 
-base1, base2, base3, base4, base5 :: String
-base1  = "http://id.ninebynine.org/wip/2003/test/graph1/node#"
-base2  = "http://id.ninebynine.org/wip/2003/test/graph2/node/"
-base3  = "http://id.ninebynine.org/wip/2003/test/graph3/node"
-base4  = "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
-base5  = "http://id.ninebynine.org/wip/2003/test/graph5/"
+toURI :: String -> URI
+toURI = fromJust . parseURIReference
 
-qb1s1, qb2s2, qb3s3, qb3, qb3bm, qb4m :: QName
-qb1s1  = QName base1 "s1"
-qb2s2  = QName base2 "s2"
-qb3s3  = QName base3 "s3"
-qb3    = QName base3 ""
-qb3bm  = QName base3 "basemore"
-qb4m   = QName base4 "more"
-
-qb5, qb5s5 :: QName
-qb5    = QName base5 ""
-qb5s5  = QName base5 "s5"
+base1, base2, base3, base4, base5, base6, base7 :: URI
+base1  = toURI "http://id.ninebynine.org/wip/2003/test/graph1/node#"
+base2  = toURI "http://id.ninebynine.org/wip/2003/test/graph2/node/"
+base3  = toURI "http://id.ninebynine.org/wip/2003/test/graph3/node"
+base4  = toURI "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
+base5  = toURI "http://id.ninebynine.org/wip/2003/test/graph5/"
+base6  = toURI "file://home/swish/"
+base7  = toURI "urn:long:separator:path" -- should this really be "urn:"?
+  
+qb1s1, qb2s2, qb3s3, qb3, qb3bm, qb4m, qb5, qb5s5, qb6, qb7 :: QName
+qb1s1  = newQName base1 "s1"
+qb2s2  = newQName base2 "s2"
+qb3s3  = newQName base3 "s3"
+qb3    = newQName base3 ""
+qb3bm  = newQName base3 "basemore"
+qb4m   = newQName base4 "more"
+qb5    = newQName base5 ""
+qb5s5  = newQName base5 "s5"
+qb6    = newQName base6 "file.dat"
+qb7    = newQName base7 ""
 
 qb1st1, qb2st2, qb3st3 :: QName
-qb1st1 = QName base1 "st1"
-qb2st2 = QName base2 "st2"
-qb3st3 = QName base3 "st3"
+qb1st1 = newQName base1 "st1"
+qb2st2 = newQName base2 "st2"
+qb3st3 = newQName base3 "st3"
+
+testIsEq :: (Show a, Eq a) => String -> String -> a -> a -> Test
+testIsEq lbl1 lbl2 a b = TestCase (assertEqual (lbl1++":"++lbl2) a b)
 
 ------------------------------------------------------------
 --  QName equality tests
 ------------------------------------------------------------
 
 testQNameEq :: String -> Bool -> QName -> QName -> Test
-testQNameEq lab eq n1 n2 =
-    TestCase ( assertEqual ("testQNameEq:"++lab) eq (n1==n2) )
+testQNameEq lbl eq n1 n2 = testIsEq "QNameEq" lbl eq (n1==n2)
 
 qnlist :: [(String, QName)]
 qnlist =
 nq1 = newQName base1 "s1"
 nq2 = newQName base1 "s2"
 
-qp1, qp2 :: QName
-qp1 = qnameFromPair (base1,"s1")
-qp2 = qnameFromPair (base1,"s2")
-
-qu1, qu2, qu3, qu4, qu5 :: QName
-qu1 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"
-qu2 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph2/node/s2"
+qu1, qu2, qu3, qu4, qu5, qu6, qu7 :: QName
+qu1 = qnameFromURI (toURI "http://id.ninebynine.org/wip/2003/test/graph1/node#s1")
+qu2 = qnameFromURI (toURI "http://id.ninebynine.org/wip/2003/test/graph2/node/s2")
 qu3 = "http://id.ninebynine.org/wip/2003/test/graph3/node"
 qu4 = "http://id.ninebynine.org/wip/2003/test/graph5/"
 qu5 = "http://id.ninebynine.org/wip/2003/test/graph5/s5"
+qu6 = "file://home/swish/file.dat"
+qu7 = "urn:long:separator:path"
 
 testMakeQNameSuite :: Test
 testMakeQNameSuite = 
   TestList
   [ testQNameEq "testnq01" True  nq1 qb1s1
   , testQNameEq "testnq02" False nq2 qb1s1
-  , testQNameEq "testqp01" True  qp1 qb1s1
-  , testQNameEq "testqp02" False qp2 qb1s1
   , testQNameEq "testqu01" True qb1s1 qu1
   , testQNameEq "testqu02" True qb2s2 qu2
   , testQNameEq "testqu03" True qb3   qu3
   , testQNameEq "testqu04" True qb5   qu4
   , testQNameEq "testqu05" True qb5s5 qu5
+  , testQNameEq "testqu06" True qb6   qu6
+  , testQNameEq "testqu07" True qb7   qu7
   ]
 
 ------------------------------------------------------------
 ------------------------------------------------------------
 
 testStringEq :: String -> String -> String -> Test
-testStringEq lab s1 s2 =
-    TestCase ( assertEqual ("testStringEq:"++lab) s1 s2 )
+testStringEq = testIsEq "StringEq"
+
+testURIEq :: String -> String -> URI -> Test
+testURIEq lbl uri = testIsEq "URIEq" lbl (toURI uri)
 
 testPartQNameSuite :: Test
 testPartQNameSuite = 
   TestList
-  [ testStringEq "testGetNamespace01"
+  [ testURIEq "testGetNamespace01"
         "http://id.ninebynine.org/wip/2003/test/graph1/node#" 
         (getNamespace qb1s1)
-  , testStringEq "testGetNamespace02"
+  , testURIEq "testGetNamespace02"
         "http://id.ninebynine.org/wip/2003/test/graph2/node/"
         (getNamespace qb2s2)
-  , testStringEq "testGetNamespace03"
+  , testURIEq "testGetNamespace03"
         "http://id.ninebynine.org/wip/2003/test/graph3/node"
         (getNamespace qb3s3)
-  , testStringEq "testGetNamespace04"
+  , testURIEq "testGetNamespace04"
         "http://id.ninebynine.org/wip/2003/test/graph3/node"
         (getNamespace qb3)
   , testStringEq "testGetLocalName01"
       "s3" (getLocalName qb3s3)
   , testStringEq "testGetLocalName04"
       "" (getLocalName qb3)
-  , testStringEq "testGetQNameURI01"
+  , testURIEq "testGetQNameURI01"
       "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"
       (getQNameURI qb1s1)
-  , testStringEq "testGetQNameURI02"
+  , testURIEq "testGetQNameURI02"
       "http://id.ninebynine.org/wip/2003/test/graph2/node/s2"
       (getQNameURI qb2s2)
-  , testStringEq "testGetQNameURI03"
+  , testURIEq "testGetQNameURI03"
       "http://id.ninebynine.org/wip/2003/test/graph3/nodes3"
       (getQNameURI qb3s3)
-  , testStringEq "testGetQNameURI04"
+  , testURIEq "testGetQNameURI04"
       "http://id.ninebynine.org/wip/2003/test/graph3/node"
       (getQNameURI qb3)
   ]
 ------------------------------------------------------------
 
 testMaybeQNameEq :: String -> Bool -> Maybe QName -> Maybe QName -> Test
-testMaybeQNameEq lab eq n1 n2 =
-    TestCase ( assertEqual ("testMaybeQNameEq:"++lab) eq (n1==n2) )
+testMaybeQNameEq lbl eq n1 n2 = testIsEq "MaybeQName" lbl eq (n1==n2)
 
 testMaybeQNameEqSuite :: Test
 testMaybeQNameEqSuite = 
 ------------------------------------------------------------
 
 testQNameLe :: String -> Bool -> QName -> QName -> Test
-testQNameLe lab le n1 n2 =
-    TestCase ( assertEqual ("testQNameLe:"++lab) le (n1<=n2) )
+testQNameLe lbl le n1 n2 = testIsEq "QNameLE" lbl le (n1 <= n2)
 
 testQNameLeSuite :: Test
 testQNameLeSuite = 
   , testStringEq "testShowQName04"
     "<http://id.ninebynine.org/wip/2003/test/graph5/>"
     (show qb5)
+  , testStringEq "testShowQName06"
+    "<file://home/swish/file.dat>"
+    (show qb6)
+  , testStringEq "testShowQName07"
+    "<urn:long:separator:path>"
+    (show qb7)
   ]
 
 ------------------------------------------------------------
     -- splitURI "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb")
     -- splitURI "http://example.org/aaa/"    = ("http://example.org/aaa/","")
 
+{-
 testSplitURI :: String -> String -> ( String, String ) -> Test
 testSplitURI label input ans =
     TestCase ( assertEqual label ans ( splitURI input ) )
 
+as splitURI has now been moved into qnameFromURI we change the
+test somewhat and also include a check of the
+URI combination done by newQName (may be tested elsewhere).
+-}
+
+testSplitURI :: String -> String -> (String,String) -> Test
+testSplitURI lbl input (a,b) =
+  let qn = newQName (toURI a) b
+  in 
+   TestList
+   [ testIsEq lbl ":split" qn ((qnameFromURI . toURI) input)
+   , testIsEq lbl ":show"  input (show (getQNameURI qn))
+   ]
+
 testSplitURISuite :: Test
 testSplitURISuite = 
   TestList
   , testSplitURI "testSplitURI04"
      "http://example.org/aaa/"
      ( "http://example.org/aaa/", "" )
+     
+  {- REMOVE the relative URI tests since it is not clear they make sense
+        for QNames.
+
   , testSplitURI "testSplitURI05"
      "//example.org/aaa#bbb"
      ( "//example.org/aaa#", "bbb" )
   , testSplitURI "testSplitURI08"
       "mortal"
       ( "", "mortal" )
+  
+    -}
+  ]
+
+------------------------------------------------------------
+--  Scoped Name tests, via QName and URI
+--  In reality this is testing qnameFromURI (or at least
+--  that was the original motivation).
+------------------------------------------------------------
+
+-- simple round-trip tests
+testSQRoundTrip :: String -> String -> Test
+testSQRoundTrip lbl uri = 
+  let u = (fromJust . parseURIReference) uri
+      qn = qnameFromURI u
+      sn = makeQNameScopedName qn
+  in TestList
+     [ testIsEq "SQ:URI"   lbl u  (getScopedNameURI sn)
+     , testIsEq "SQ:Qname" lbl qn (getQName sn)
+     ]
+
+testSNameTTSuite :: Test
+testSNameTTSuite =
+  TestList
+  [ testSQRoundTrip "null" ""
+  , testSQRoundTrip "frag1"  "/" -- Should relative fragments be supported?
+  , testSQRoundTrip "frag2a"  "/foo"
+  , testSQRoundTrip "frag2b"  "/foo/"
+  , testSQRoundTrip "frag3"  "/foo/bar"
+  , testSQRoundTrip "frag4a"  "/foo/bar#"
+  , testSQRoundTrip "frag4b"  "/foo/bar#fragid"
+  , testSQRoundTrip "http1a" "http://example.com"
+  , testSQRoundTrip "http1b" "http://example.com/"
+  , testSQRoundTrip "http2" "http://example.com/foo/bar/"
+  , testSQRoundTrip "http3" "http://example.com/foo/bar/bar"
+  , testSQRoundTrip "http4a" "http://example.com/foo/bar/bar#"
+  , testSQRoundTrip "http4b" "http://example.com/foo/bar/bar#fragid"
+  , testSQRoundTrip "https1" "https://joeuser@example.com/foo/bar"
+  , testSQRoundTrip "file1"  "file:///dev/null"
+  , testSQRoundTrip "urn1"   "URN:foo:a123,456"
+  , testSQRoundTrip "urn2"   "urn:foo:a123%2C456"
   ]
 
 ------------------------------------------------------------
   , testQNameLeSuite
   , testShowQNameSuite
   , testSplitURISuite
+  , testSNameTTSuite
   ]
 
 main :: IO ()

File tests/RDFGraphTest.hs

 import Network.URI (URI, parseURI)
 import Data.Monoid (Monoid(..))
 import Data.List (elemIndex, intercalate)
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, fromMaybe)
 import Data.Ord (comparing)
 
 import System.Locale (defaultTimeLocale)
 base1Str = "http://id.ninebynine.org/wip/2003/test/graph1/node#"
 
 toURI :: String -> URI
-toURI = fromJust . parseURI
+toURI s = fromMaybe (error $ "Error: unable to parse URI " ++ s) (parseURI s)
 
 toNS :: String -> String -> Namespace
 toNS p = Namespace (Just p) . toURI
 base4 = toNS "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
 
 qn1s1 :: QName
-qn1s1 = qnameFromURI $ base1Str ++ "s1"
+qn1s1 = qnameFromURI $ toURI $ base1Str ++ "s1"
 
 qu1s1 :: URI
 qu1s1 = toURI $ base1Str ++ "s1"
 gt1f5M = Traversable.mapM translateM g1f5
 
 ft1M, ft2M :: FormulaMap RDFLabel
-ft1M = getFormulae $ fromJust gt1f1bM
-ft2M = getFormulae $ fromJust gt1f2bM
+ft1M = getFormulae $ fromMaybe (error "Unexpected: gt1f1bM") gt1f1bM
+ft2M = getFormulae $ fromMaybe (error "Unexpected: gt1f2bM") gt1f2bM
 
 testGraphTranslateSuite :: Test
 testGraphTranslateSuite = TestLabel "TestTranslate" $ TestList