--------------------------------------------------------------------------------
--  $Id: RDFLabel.hs,v 1.2 2004/07/13 17:33:51 graham Exp $
--
--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  RDFLabel
--  Copyright   :  (c) 2003, Graham Klyne
--  License     :  GPL V2
--
--  Maintainer  :  Graham Klyne
--  Stability   :  provisional
--  Portability :  H98
--
--  This module defines a datatype for RDF graph labels, which is an instance
--  of the graph Label class.
--
--------------------------------------------------------------------------------

------------------------------------------------------------
-- Simple labelled directed graph value
------------------------------------------------------------

module RDF.Label.RDFLabel
    ( RDFLabel(..)
    , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral
    , isDatatyped, isMemberProp, isUri, isBlank, isQueryVar
    , getLiteralText, getScopedName, makeBlank
    , RDFTriple
    , newNode, newNodes
    )
where

import RDF.Label.LabelClass
    ( Label(..)
    , Arc(..), arc, arcSubj, arcPred, arcObj
    )

import RDF.Label.Vocabulary
    ( namespaceRDF
    , langTag, isLang
    , rdf_XMLLiteral
    )

import Namespace
    ( Namespace(..)
    , getScopedNameURI
    , ScopedName(..)
    , makeScopedName
    , nullScopedName
    )

import MiscHelpers
    ( hash, quote )

import Char
    ( isDigit )

import List
    ( findIndices )

-----------------------------------------------------------
--  RDF graph label (node) values
------------------------------------------------------------
--
--  cf. http://www.w3.org/TR/rdf-concepts/#section-Graph-syntax
--
--  This is extended from the RDF abstract graph syntax in the
--  following ways:
--  (a) a "variable" node option is distinguished from a
--      blank node.
--      I have found this useful for encoding and handling
--      queries, even though query variables can be expressed
--      as blank nodes.
--  (b) a "NoNode" option is defined.
--      This might otherwise be handled by Maybe (RDFLabel g)

data RDFLabel =
      Res ScopedName                    -- resource
    | Lit String (Maybe ScopedName)     -- literal [type/language]
    | Blank String                      -- blank node
    | Var String                        -- variable (not used in ordinary graphs)
    | NoNode                            -- no node  (not used in ordinary graphs)

instance Eq RDFLabel where
    (==) = labelEq

instance Show RDFLabel where
    show (Res sn)           = show sn
    show (Lit st Nothing)   = quote st
    show (Lit st (Just nam))
        | isLang nam = quote st ++ "@"  ++ (langTag nam)
        | otherwise  = quote st ++ "^^" ++ (show nam)
    show (Blank ln)         = "_:"++ln
    show (Var ln)           = "?"++ln
    show NoNode             = "<NoNode>"

instance Ord RDFLabel where
    -- Optimize some common cases..
    compare (Res sn1)      (Res sn2)      = compare sn1 sn2
    compare (Blank ln1)    (Blank ln2)    = compare ln1 ln2
    compare (Res _)        (Blank _)      = LT
    compare (Blank _)      (Res _)        = GT
    -- .. else use show string comparison
    compare l1 l2 = compare (show l1) (show l2)
{-
    -- Similarly for <=
    (Res qn1)   <= (Res qn2)      = qn1 <= qn2
    (Blank ln1) <= (Blank ln2)    = ln1 <= ln2
    (Res _)     <= (Blank _)      = True
    (Blank _)   <= (Res _)        = False
    l1 <= l2                      = (show l1) <= (show l2)
-}


-- Define equality of nodes.
--
-- The version of equality defined here is not strictly RDF abstract syntax
-- equality, but my interpretation of equivalence for the purposes of
-- entailment, in the absence of any specific datatype knowledge other
-- than XML literals.
--
labelEq :: RDFLabel -> RDFLabel -> Bool
labelEq (Res q1)            (Res q2)        = (q1 == q2)
labelEq (Blank s1)          (Blank s2)      = (s1 == s2)
labelEq (Var v1)            (Var v2)        = (v1 == v2)
labelEq (Lit s1 t1)         (Lit s2 t2)     = (s1 == s2) && (t1 == t2)
labelEq _                   _               = False

---------------------------------------------------------
--  RDFLabel is instance of graph label
---------------------------------------------------------

instance Label RDFLabel where
    labelIsVar (Blank _)    = True
    labelIsVar (Var _)      = True
    labelIsVar _            = False
    getLocal   (Blank loc)  = loc
    getLocal   (Var   loc)  = '?':loc
    getLocal   (Res   sn)   = "Res_"++snLocal sn
    getLocal   (NoNode)     = "None"
    getLocal   _            = "Lit_"
    makeLabel  ('?':loc)    = Var loc
    makeLabel  loc          = Blank loc
    labelHash seed lb       = hash seed (showCanon lb)

--  Get canonical string for RDF label.
--  Used for hashing, so that equivalent labels always return
--  the same hash value.
showCanon :: RDFLabel -> String
showCanon (Res sn)           = "<"++getScopedNameURI sn++">"
showCanon (Lit st (Just nam))
        | isLang nam = quote st ++ "@"  ++ (langTag nam)
        | otherwise  = quote st ++ "^^" ++ (getScopedNameURI nam)
showCanon lb                 = show lb

---------------------------------------------------------
--  Additional functions on RDFLabel values
---------------------------------------------------------

-- |Test if supplied labal is a URI resource node
isUri :: RDFLabel -> Bool
isUri (Res _) = True
isUri  _      = False

-- |Test if supplied labal is a literal node
isLiteral :: RDFLabel -> Bool
isLiteral (Lit _ _) = True
isLiteral  _        = False

-- |Test if supplied labal is an untyped literal node
isUntypedLiteral :: RDFLabel -> Bool
isUntypedLiteral (Lit _ Nothing  ) = True
isUntypedLiteral (Lit _ (Just tn)) = isLang tn
isUntypedLiteral  _                = False

-- |Test if supplied labal is an untyped literal node
isTypedLiteral :: RDFLabel -> Bool
isTypedLiteral (Lit _ (Just tn)) = not (isLang tn)
isTypedLiteral  _                = False

-- |Test if supplied labal is an XML literal node
isXMLLiteral :: RDFLabel -> Bool
isXMLLiteral = isDatatyped rdf_XMLLiteral

-- |Test if supplied label is an typed literal node of a given datatype
isDatatyped :: ScopedName -> RDFLabel -> Bool
isDatatyped d  (Lit _ (Just n)) = (n == d)
isDatatyped _  _                = False

-- |Test if supplied label is a container membership property
--
--  Check for namespace is RDF namespace and
--  first character of local name is '_' and
--  remaining characters of local name are all digits
isMemberProp :: RDFLabel -> Bool
isMemberProp (Res sn) = ( snScope sn == namespaceRDF  ) &&
                        ( head loc   == '_'   ) &&
                        ( and . map isDigit . tail $ loc )
                        where
                            loc = snLocal sn
isMemberProp _        = False

-- |Test if supplied labal is a blank node
isBlank :: RDFLabel -> Bool
isBlank (Blank _) = True
isBlank  _        = False

-- |Test if supplied labal is a query variable
isQueryVar :: RDFLabel -> Bool
isQueryVar (Var _) = True
isQueryVar  _      = False

-- |Extract text value from a literal node
getLiteralText :: RDFLabel -> String
getLiteralText (Lit s _) = s
getLiteralText  _        = ""

-- |Extract ScopedName value from a resource node
getScopedName :: RDFLabel -> ScopedName
getScopedName (Res sn) = sn
getScopedName  _       = nullScopedName

-- |Make a blank node from a supplied query variable,
--  or return the supplied label unchanged.
--  (Use this in when substituting an existential for an
--  unsubstituted query variable.)
makeBlank :: RDFLabel -> RDFLabel
makeBlank  (Var loc)    = Blank loc
makeBlank  lb           = lb

---------------------------------------------------------
--  RDF Triple (statement)
---------------------------------------------------------

type RDFTriple = Arc RDFLabel


---------------------------------------------------------
--  Node generator
---------------------------------------------------------

-- |Given a node and a list of existing nodes, find a new node to
--  replace the supplied node that does not clash with any existing node.
--  (Generates an non-terminating list of possible replacements, and
--  picks the first one that isn't already in use.)
newNode :: (Label lb) => lb -> [lb] -> lb
newNode dn existnodes =
    head $ newNodes dn existnodes

-- |Given a node and a list of existing nodes, generate a list of new
--  nodes for the supplied node that do not clash with any existing node.
newNodes :: (Label lb) => lb -> [lb] -> [lb]
newNodes dn existnodes =
    filter (not . (`elem` existnodes)) $ trynodes (noderootindex dn)

noderootindex :: (Label lb) => lb -> (String,Int)
noderootindex dn = (nh,nx) where
    (nh,nt) = splitnodeid $ getLocal dn
    nx      = if null nt then 0 else read nt

splitnodeid :: String -> (String,String)
splitnodeid dn = splitAt (tx+1) dn where
    tx = last $ (-1):findIndices (not . isDigit) dn

trynodes :: (Label lb) => (String,Int) -> [lb]
trynodes (nr,nx) = [ makeLabel (nr++(show n)) | n <- iterate (+1) nx ]

--------------------------------------------------------------------------------
--
--  Copyright (c) 2004, 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/HaskellRDF/RDF/Label/RDFLabel.hs,v $
-- $Author: graham $
-- $Revision: 1.2 $
-- $Log: RDFLabel.hs,v $
-- Revision 1.2  2004/07/13 17:33:51  graham
-- RDF/XML parser passes all test cases.
--
-- Revision 1.1  2004/07/01 15:25:36  graham
-- Moved Lavel and Vocabulary modules to separate directory
--
-- Revision 1.1  2004/07/01 11:10:11  graham
-- Separate RDFLabel from RDFGraph, and LabelClass from GraphClass,
-- in preparation for implementing an RDF/XML parser that operates
-- independently of the graph structure.
--