--------------------------------------------------------------------------------
--  $Id: RDFXMLParserTest.hs,v 1.3 2004/07/13 17:33:51 graham Exp $
--
--  Copyright (c) 2004, G. KLYNE.  All rights reserved.
--  See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
--  Module      :  RDF.Harp.RDFXMLParserTestTest
--  Copyright   :  (c) 2004, Graham Klyne
--  License     :  GPL V2
--
--  Maintainer  :  Graham Klyne
--  Stability   :  provisional
--  Portability :  H98
--
--  This module contains test cases for the Harp RDF/XML parser.
--  The code in this module works with a specific collection of data from
--  directory "test/" relative to the test program's working directory.
--
--------------------------------------------------------------------------------

module RDF.Harp.RDFXMLParserTest where

import RDF.Harp.RDFXMLParser
    ( parseRDFFromXML
    , parseRDFNodeFromXML
    , parseRDFEmbeddedFromXML
    )

import RDF.Graph.N3Parser
    ( ParseResult
    , parseN3fromString
    )

import RDF.Graph.RDFGraph
    ( RDFTriple, RDFGraph, RDFLabel(..)
    -- , NamespaceMap
    -- , LookupFormula(..), Formula, FormulaMap
    , setArcs, getArcs, addArc, add, delete, extract, labels
    -- , setFormula
    -- , setNamespaces
    -- , emptyRDFGraph, toRDFGraph
    )

import RDF.Label.RDFLabel
    ( RDFLabel(..)
    -- , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral
    -- , isDatatyped, isMemberProp, isUri, isBlank, isQueryVar
    -- , getLiteralText, getScopedName, makeBlank
    , RDFTriple
    )

{-
import Namespace
    ( ScopedName(..)
    -- , getScopePrefix, getScopeURI
    -- , getScopedNameURI
    -- , matchName
    -- , makeScopedName, makeUriScopedName
    -- , nullScopedName
    )
-}

import TestHelpers
    ( ListTest(..)
    , test, testEq, testNe, testLe, testGe, testElem
    , testJust, testNothing
    , testEqv, testNotEqv, testEqv2, testHasEqv, testMaybeEqv
    )

{-
import ListHelpers
    ( equiv )
-}

import Text.XML.HaXml.Types
    ( DocumentI(..), ElementI(..), ContentI(..)
    )

import Text.XML.HaXml.Parse
    ( xmlParse, xmlParse', xmlParseStandAlone'
    -- , dtdParse, dtdParse'
    -- , parseEntity
    -- , parseAttContent
    )

import Text.XML.HaXml.SubstituteGEFilter
    ( subIntGenEntities
    , subExtGenEntities
    )

import Text.XML.HaXml.Namespace
    ( processNamespaces
    )

import Text.XML.HaXml.XmlBase
    ( processXmlBase
    )

import Text.XML.HaXml.XmlLang
    ( processXmlLang
    )

import HUnit
    ( Test(TestCase,TestList,TestLabel)
    , Assertion
    , assertBool, assertEqual, assertString, assertFailure
    , runTestTT, runTestText, putTextToHandle
    )

-- Get definition of (Either String) as an instance of Monad:
import Control.Monad()
import Control.Monad.Error()

import IO
    ( Handle, IOMode(WriteMode)
    , openFile, hClose, hPutStr, hPutStrLn
    )

import Monad
    ( liftM )

import List
    ( nub, (\\) )

{-
import Maybe
    ( isJust, fromJust, fromMaybe )
-}


------------------------------------------------------------
--  Local helpers
------------------------------------------------------------

--  Get triples from RDF/XML file
--  (Note that '>>=' and 'liftM' apply to the (Either String) monad
--  *inside* the IO monad.)
getRDFXMLTriples :: String -> IO (Either String [RDFTriple])
getRDFXMLTriples name = do
    { instr <- readFile name
    ; let inrdf = xmlParse' name instr >>=
                  replaceContent >>=
                  parseRDFNodeFromXML
    ; return $ liftM snd inrdf
    }
    where
        replaceContent (Document p s e) = case subExtGenEntities s (CElem e) of
            [CElem e] -> Right $ processXml (Document p s e)
            []        -> Left  $ name++" produced no output"
            _         -> Left  $ name++" produced more than one output"
        processXml = processXmlLang . processXmlBase . processNamespaces

--  Get triples from N3/N-Triples file
--  Get triples from RDF/XML file
getN3Triples :: String -> IO (Either String [RDFTriple])
getN3Triples name = do
    { instr <- readFile name
    ; let ingr = parseN3fromString instr
    ; return $ liftM getArcs ingr
    }

showNDigits :: Int -> Int -> String
showNDigits places val = pad places (show val)
    where
        pad places str = replicate (places-length str) '0' ++ str

------------------------------------------------------------
--  Test constructors
------------------------------------------------------------

--  Test valid RDF matches specified triples
testValidRDF :: String -> String -> String -> Test
testValidRDF lab exfile infile = TestCase $ do
    { expect <- getN3Triples     $ "test/"++exfile
    ; actual <- getRDFXMLTriples $ "test/"++infile
    ; case (expect,actual) of
        (Left er,_)       -> assertFailure $ lab++": "++er++" (file "++exfile++")"
        (_,Left er)       -> assertFailure $ lab++": "++er++" (file "++infile++")"
{-
        (Right e,Right i) -> assertEqual lab (ListTest e) (ListTest i)
-}
        (Right e,Right i) -> assertEqual (lab++"(expect,found)")
                             (ListTest [],ListTest [])
                             (ListTest (nub e\\i),ListTest (nub i\\e))
    }

--  Test for invalid RDF
testBadRDF :: String -> String -> Test
testBadRDF lab infile = TestCase $ do
    { actual <- getRDFXMLTriples $ "test/"++infile
    ; case actual of
        Right _ -> assertFailure $ lab++": expected parse failure (file "++infile++")"
        Left er -> assertEqual lab er er -- Later, may test actual diagnostic msg
    }

--  Test for warning condition
testWarnRDF :: String -> String -> String -> Test
testWarnRDF lab warn infile = TestCase $ do
    { actual <- getRDFXMLTriples $ "test/"++infile
    ; case actual of
        Right _ -> assertFailure $ lab++": expected parse failure (file "++infile++")"
        Left er -> assertEqual lab warn er
    }

------------------------------------------------------------
--  Test suite for valid RDF input
------------------------------------------------------------

testMiscRDFSuite  = TestList $
    [ testValidRDF "testValidMisc01" "simple1.out"          "simple1.rdf"
    , testValidRDF "testValidMisc02" "simple2.out"          "simple2.rdf"
    , testValidRDF "testValidMisc03" "simple3.out"          "simple3.rdf"
    , testValidRDF "testValidMisc10" "22-rdf-syntax-ns.out" "22-rdf-syntax-ns.rdf"
    , testValidRDF "testValidMisc11" "rdf-schema.out"       "rdf-schema.rdf"
    , testValidRDF "testValidMisc12" "rdfs-namespace.out"   "rdfs-namespace.rdf"
    , testValidRDF "testValidMisc13" "owl-schema.out"       "owl-schema.rdf"
    --  This one's *SLOW*:
    -- , testValidRDF "testValidMisc14" "wine.out"             "wine.rdf"
    , testValidRDF "testValidMisc15" "daml-oil.out"         "daml-oil.rdf"
    ]

testValidRDFSuite = TestList $
    [ testValidRDF ("testValidRDF"++nn) ("ex-"++nn++".out") ("ex-"++nn++".rdf")
    | n <- ([0..49]\\ex_exclude), let nn = showNDigits 2 n
    ]
    ++
    [ testValidRDF "testValidRDF51" "ex-51.out" "ex-51.rdf"
    -- , testValidRDF "testValidRDF52" "ex-52.out" "ex-52.svg"
    , testValidRDF "testValidRDF53" "ex-53.out"          "ex-53.rdf"
    ]

--  Raptor-derived test cases not handled
ex_exclude :: [Int]
ex_exclude =
    [ 3         -- uses rdf:bagID
    , 42        -- uses rdf:bagID
    , 43        -- uses rdf:bagID
    , 44        -- uses rdf:bagID
    , 45        -- uses rdf:bagID
    ]


------------------------------------------------------------
--  Test suite for invalid RDF input
------------------------------------------------------------

testBadRDFSuite = TestList
    [ testBadRDF ("testBadRDF"++nn) ("bad-"++nn++".rdf")
    | n <- ([0..9]++[11..21])\\bad_exclude, let nn = showNDigits 2 n
    ]

--  Invalid RDF not curently detected
bad_exclude :: [Int]
bad_exclude =
    [ 2         -- multiple rdf:ID
    , 11        -- blank namespace URI
    , 12        -- bad namespace (clash with rdf namespace)
    , 15        -- bad NFC in attribute value
    , 16        -- property element with illegal NFC
    , 17        -- property element parseType="Literal" with illegal NFC
    , 18        -- non-namespaced element
    , 19        -- property element without a namespace
    , 20        -- non-namespaced element
    ]


------------------------------------------------------------
--  Test suite for deprecated or otherwise suspect RDF input
------------------------------------------------------------

testWarnRDFSuite = TestList
    [
    ]


------------------------------------------------------------
--  All tests
------------------------------------------------------------

allTests = TestList
    [ testMiscRDFSuite
    , testValidRDFSuite
    , testBadRDFSuite
    , testWarnRDFSuite
    ]

main = runTestTT allTests

runTestFile t = do
    h <- openFile "a.tmp" WriteMode
    runTestText (putTextToHandle h False) t
    hClose h
tf = runTestFile
tt = runTestTT

t1  = tt $ testValidRDF "testValidMisc01" "simple1.out" "simple1.rdf"
t2  = tt $ testValidRDF "testValidMisc02" "simple2.out" "simple2.rdf"
t3  = tt $ testValidRDF "testValidMisc03" "simple3.out" "simple3.rdf"
t3f = tf $ testValidRDF "testValidMisc03" "simple3.out" "simple3.rdf"

t10  = tt $ testValidRDF "testValidMisc10" "22-rdf-syntax-ns.out" "22-rdf-syntax-ns.rdf"
t11  = tt $ testValidRDF "testValidMisc11" "rdf-schema.out" "rdf-schema.rdf"
t11f = tf $ testValidRDF "testValidMisc11" "rdf-schema.out" "rdf-schema.rdf"
t12  = tt $ testValidRDF "testValidMisc12" "rdfs-namespace.out" "rdfs-namespace.rdf"
t13  = tt $ testValidRDF "testValidMisc13" "owl-schema.out"     "owl-schema.rdf"
t13f = tf $ testValidRDF "testValidMisc13" "owl-schema.out"     "owl-schema.rdf"
--  Use graph-equivalence test for this:
t14  = tt $ testValidRDF "testValidMisc14" "wine.out"           "wine.rdf"
t15  = tt $ testValidRDF "testValidMisc15" "daml-oil.out"       "daml-oil.rdf"
t15f = tf $ testValidRDF "testValidMisc15" "daml-oil.out"       "daml-oil.rdf"

tmis = tt $ testMiscRDFSuite
tval = tt $ testValidRDFSuite
tbad = tt $ testBadRDFSuite

--------------------------------------------------------------------------------
--
--  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/Harp/RDFXMLParserTest.hs,v $
-- $Author: graham $
-- $Revision: 1.3 $
-- $Log: RDFXMLParserTest.hs,v $
-- Revision 1.3  2004/07/13 17:33:51  graham
-- RDF/XML parser passes all test cases.
--
-- Revision 1.2  2004/07/12 22:18:32  graham
-- Initial cut of RDF parser code complete.  It even parses some limited
-- RDF correctly!
-- Working on test cases.
--
-- Revision 1.1  2004/07/06 21:47:44  graham
-- Add early cut of Harp and Harp test harness to CVS.
--