swish-0.2.1: Swish/HaskellUtils/QName.hs
--------------------------------------------------------------------------------
-- $Id: QName.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
--
-- Copyright (c) 2003, G. KLYNE. All rights reserved.
-- See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
-- Module : QName
-- Copyright : (c) 2003, Graham Klyne
-- License : GPL V2
--
-- Maintainer : Graham Klyne
-- Stability : provisional
-- Portability : H98
--
-- This module defines an algebraic datatype for qualified names (QNames).
--
--------------------------------------------------------------------------------
module Swish.HaskellUtils.QName
( QName(..) -- , maybeQnEq
, newQName, qnameFromPair, qnameFromURI
, getNamespace, getLocalName, getQNameURI
, splitURI
)
where
import Data.Char
( isAlpha, isAlphaNum )
------------------------------------------------------------
-- Qualified name
------------------------------------------------------------
--
-- cf. http://www.w3.org/TR/REC-xml-names/
data QName = QName { qnNsuri, qnLocal :: String }
newQName :: String -> String -> QName
newQName ns ln = QName ns ln
qnameFromPair :: (String,String) -> QName
qnameFromPair (ns,ln) = QName ns ln
qnameFromURI :: String -> QName
qnameFromURI = qnameFromPair . splitURI
getNamespace :: QName -> String
getNamespace qn = qnNsuri qn
getLocalName :: QName -> String
getLocalName qn = qnLocal qn
getQNameURI :: QName -> String
getQNameURI (QName ns ln) = ns++ln
instance Eq QName where
(==) = qnEq
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
instance Show QName where
show (QName ns ln) = "<" ++ ns ++ ln ++ ">"
-- Original used comparison of concatenated strings,
-- but that was very inefficient. This version does the
-- comparison without constructing new values
qnEq :: QName -> QName -> Bool
qnEq (QName ns1 ln1) (QName ns2 ln2) = qnEq1 ns1 ns2 ln1 ln2
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 ) || ( any (==c) ".-_" )
--------------------------------------------------------------------------------
--
-- Copyright (c) 2003, G. KLYNE. All rights reserved.
--
-- This file is part of Swish.
--
-- Swish is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.
--
-- Swish is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with Swish; if not, write to:
-- The Free Software Foundation, Inc.,
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
--
--------------------------------------------------------------------------------
-- $Source: /file/cvsdev/HaskellUtils/QName.hs,v $
-- $Author: graham $
-- $Revision: 1.1 $
-- $Log: QName.hs,v $
-- Revision 1.1 2004/01/13 12:31:24 graham
-- Move modules from HaskellRDF to HaskellUtils project
--
-- Revision 1.5 2004/01/07 19:49:13 graham
-- Reorganized RDFLabel details to eliminate separate language field,
-- and to use ScopedName rather than QName.
-- Removed some duplicated functions from module Namespace.
--
-- Revision 1.4 2003/10/24 21:05:09 graham
-- Working on datatype inference. Most of the variable binding logic
-- is done, but the rule structure still needs to be worked out to support
-- forward and backward chaining through the same rule.
--
-- Revision 1.3 2003/09/30 20:02:40 graham
-- Proof mechanisms now use scoped names and rulesets.
-- Move some functionality between modules so that RDFProofCheck
-- contains less generic code.
--
-- Revision 1.2 2003/09/24 18:50:52 graham
-- Revised module format to be Haddock compatible.
--
-- Revision 1.1 2003/09/24 12:51:00 graham
-- Add separate QName module and test suite
--