-------------------------------------------------------------------------------- -- $Id: ReportCompileToRDF.hs,v 1.5 2004/03/26 21:20:07 graham Exp $ -- -- Copyright (c) 2003, G. KLYNE. All rights reserved. -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : ReportCompileToRDF -- Copyright : (c) 2003, Graham Klyne -- License : GPL V2 -- -- Maintainer : Graham Klyne -- Stability : provisional -- Portability : H98 -- -- This module compiles a 'Report' value to an RDF graph of the form -- used by the report generator module N3Report.py. -- -------------------------------------------------------------------------------- module ReportCompileToRDF ( reportCompileToRDF, patternCompileToRDF, stringCompileToRDF , namespaceHdr, namespaceRep, namespaceHrep ) where import ReportType ( Report, RepSequence, RepCommand(..) , RepPattern, RepMatch(..) , RepString, RepItem(..) , RepChan, RepFile, RepVar, RepUri ) import RDFGraph ( RDFLabel(..), Arc(..), RDFGraph, emptyRDFGraph, setNamespaces, addArc , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil ) import Namespace ( Namespace(..), ScopedName(..) ) import LookupMap ( LookupMap(..), makeLookupMap ) import Control.Monad.State ( MonadState(..), State(..), execState, gets, modify ) import Monad ( when ) import Maybe ( isJust, fromJust ) ------------------------------------------------------------ -- Report generator state ------------------------------------------------------------ -- -- The state consists of a graph under sonstruction, an -- integer that is used in the generation of new blank nodes, -- and a list of named collections for which code has already -- been generated data RepSt = RepSt { repGraph :: RDFGraph , repCollGen :: [RDFLabel] , repNodeGen :: Int } type ReportState a = State RepSt a makeBlank :: ReportState RDFLabel makeBlank = do { s <- get ; let n = repNodeGen s ; put s { repNodeGen = (n+1) } ; return $ Blank ("r_"++show n) } applyToGr :: (RDFGraph->RDFGraph) -> RepSt -> RepSt applyToGr f st = st { repGraph = f (repGraph st) } newNode :: RDFLabel -> ReportState Bool newNode lab = do { st <- get ; let collseen = repCollGen st ; if lab `elem` collseen then return False else do { put $ st { repCollGen=(lab:collseen) } ; return True } } ------------------------------------------------------------ -- reportCompileToRDF ------------------------------------------------------------ namespaceRdf = Namespace "rdf" "http://www.w3.org/1999/02/22-rdf-syntax-ns#" namespaceRdfs = Namespace "rdfs" "http://www.w3.org/2000/01/rdf-schema#" namespaceFoaf = Namespace "foaf" "http://xmlns.com/foaf/0.1/" namespaceHdr = Namespace "hdr" "http://id.ninebynine.org/wip/2002/IETF/MsgHdr/" namespaceRep = Namespace "rep" "http://id.ninebynine.org/wip/2002/ReportGen/" namespaceHrep = Namespace "hrep" "http://id.ninebynine.org/wip/2002/IETF/MsgHdr/Report/" nss = [ namespaceRdf , namespaceRdfs , namespaceFoaf , namespaceHdr , namespaceRep , namespaceHrep ] reportCompileToRDF :: Report -> RDFGraph reportCompileToRDF report = repGraph resultSt where initGr = setNamespaces (makeLookupMap nss) emptyRDFGraph resultSt = execState doReport (RepSt initGr [] 1) -- doReport = processRepSequence report doReport = processMainReport report patternCompileToRDF :: RepPattern -> RDFGraph patternCompileToRDF pattern = repGraph resultSt where initGr = setNamespaces (makeLookupMap nss) emptyRDFGraph resultSt = execState doReport (RepSt initGr [] 1) doReport = processRepPattern pattern stringCompileToRDF :: RepString -> RDFGraph stringCompileToRDF string = repGraph resultSt where initGr = setNamespaces (makeLookupMap nss) emptyRDFGraph resultSt = execState doReport (RepSt initGr [] 1) doReport = processRepString string processMainReport :: Report -> ReportState RDFLabel processMainReport report = do { rnode <- processRepSequence report ; rdftyp <- makeRes (namespaceRdf,"type") ; reptyp <- makeRes (namespaceRep,"Report") ; modify $ applyToGr (addArc (Arc rnode rdftyp reptyp)) ; return rnode } processRepSequence :: Report -> ReportState RDFLabel processRepSequence (mstart,[rep@(CMD _)]) = processRepCommand rep processRepSequence (mstart,rep) = makeCollection mstart (map processRepCommand rep) processAnonCommands :: [RepCommand] -> ReportState RDFLabel processAnonCommands rep = processRepSequence (Nothing,rep) processAnonSequence :: [RepCommand] -> ReportState RDFLabel processAnonSequence rep = makeCollection Nothing (map processRepCommand rep) processRepCommand :: RepCommand -> ReportState RDFLabel processRepCommand cmd = case cmd of OPEN chan file -> makeAnon [ ("cmd", makeRes (namespaceRep,"open")) , ("chan", makeLit chan) , ("file", processRepString file) ] CLOSE chan -> makeAnon [ ("cmd", makeRes (namespaceRep,"close")) , ("chan", makeLit chan) ] WRITE chan strval -> makeAnon [ ("cmd", makeRes (namespaceRep,"write")) , ("chan", makeLit chan) , ("data", processRepString strval) ] DEBUG strval -> makeAnon [ ("cmd", makeRes (namespaceRep,"debug")) , ("data", processRepString strval) ] IF mvar mpat dobody malt -> makeNodeOpts Nothing [ (True, ("cmd", makeRes (namespaceRep,"if") ) ) , (ij mvar, ("defined", makeLit (fj mvar) ) ) , (ij mpat, ("pattern", processRepPattern (fj mpat) ) ) , (True, ("do", processAnonCommands dobody ) ) , (ij malt, ("else", processAnonCommands (fj malt) ) ) ] IFANY vars mpat dobody malt -> makeNodeOpts Nothing $ (True, ("cmd", makeRes (namespaceRep,"ifany"))) : map (\v->(True, ("defined", makeLit v))) vars ++ [ (ij mpat, ("pattern", processRepPattern (fj mpat) ) ) , (True, ("do", processAnonCommands dobody ) ) , (ij malt, ("else", processAnonCommands (fj malt) ) ) ] FOR pattern dobody mfst msep mlst malt -> makeNodeOpts Nothing [ (True, ("cmd", makeRes (namespaceRep,"for") ) ) , (True, ("pattern", processRepPattern pattern ) ) , (True, ("do", processAnonCommands dobody ) ) , (ij mfst, ("first", processAnonCommands (fj mfst) ) ) , (ij msep, ("sep", processAnonCommands (fj msep) ) ) , (ij mlst, ("last", processAnonCommands (fj mlst) ) ) , (ij malt, ("else", processAnonCommands (fj malt) ) ) ] DO dobody -> makeAnon [ ("do", processRepSequence dobody) ] CMD cmdbody -> processRepSequence cmdbody where ij = isJust fj = fromJust processRepPattern :: RepPattern -> ReportState RDFLabel processRepPattern (mname,pat) = makeCollection mname (map processRepMatch pat) processRepMatch :: RepMatch -> ReportState RDFLabel processRepMatch match = case match of MEMBER -> makeRes (namespaceRep,"member") ELEMENT -> makeRes (namespaceRep,"element") URI uri -> makeAnon [ ("uri", makeRes uri) ] LIT str -> makeAnon [ ("lit", makeLit str) ] VAR var -> makeAnon [ ("var", makeLit var) ] ALL pats -> makeAnon $ map (\p->("and", processRepPattern p)) pats ALT pats altp -> makeAnon $ map (\p->("and", processRepPattern p)) pats ++ [ ("alt", processRepPattern altp) ] OPT pats -> makeAnon $ map (\p->("opt", processRepPattern p)) pats processRepString :: RepString -> ReportState RDFLabel processRepString (Nothing,[repstr]) = processRepItem repstr processRepString (mname,repstr) = makeCollection mname (map processRepItem repstr) processRepItem :: RepItem -> ReportState RDFLabel processRepItem item = case item of TEXT str -> makeLit str NL -> makeRes (namespaceRep,"nl") TRIM -> makeRes (namespaceRep,"trimws") VALUE var -> makeAnon [ ("var", makeLit var) ] LOCAL var -> makeAnon [ ("local", makeLit var) ] TAB pos -> makeAnon [ ("tab", makeLit (show pos)) ] TABSP pos -> makeAnon [ ("tabsp", makeLit (show pos)) ] TABNL pos -> makeAnon [ ("tabnl", makeLit (show pos)) ] LEFT pos -> makeAnon [ ("left", makeLit (show pos)) ] WRAP pos -> makeAnon [ ("wrap", makeLit (show pos)) ] INDENT pos -> makeAnon [ ("indent", makeLit (show pos)) ] ALLDEF vars repstr altstr -> makeNodeOpts Nothing $ map (\v -> (True, ("if", makeAnon [ ("defined",makeLit v) ]))) vars ++ [ (True, ("do", processRepString repstr ) ) , (ij altstr, ("else", processRepString (fj altstr) ) ) ] ANYDEF vars repstr altstr -> makeNodeOpts Nothing $ map (\v -> (True, ("ifany", makeAnon [ ("defined",makeLit v) ]))) vars ++ [ (True, ("do", processRepString repstr ) ) , (ij altstr, ("else", processRepString (fj altstr) ) ) ] DEFER repstr -> makeAnon [ ("defer", processRepString repstr) ] FLUSH repstr -> makeAnon [ ("flush", processRepString repstr) ] SEQ repstr -> processRepString repstr PUTURI uri -> makeRes uri where ij = isJust fj = fromJust makeCollection :: Maybe ScopedName -> [ReportState RDFLabel] -> ReportState RDFLabel makeCollection _ [] = return res_rdf_nil makeCollection Nothing members = do { hd <- makeBlank ; makeCollection1 hd members ; return hd } makeCollection (Just sn) members = do { let hd = Res sn ; new <- newNode hd ; when new $ makeCollection1 hd members ; return hd } makeCollection1 :: RDFLabel -> [ReportState RDFLabel] -> ReportState () makeCollection1 hd [getelem] = makeCollection2 hd getelem res_rdf_nil makeCollection1 hd (getelem:more) = do { next <- makeBlank ; makeCollection2 hd getelem next ; makeCollection1 next more } makeCollection2 :: RDFLabel -> ReportState RDFLabel -> RDFLabel -> ReportState () makeCollection2 hd getelem next = do { elem <- getelem ; let addarcs = addArc (Arc hd res_rdf_first elem) . addArc (Arc hd res_rdf_rest next) ; modify $ applyToGr addarcs } makeNodeOpts :: Maybe RepUri -> [(Bool,(String,ReportState RDFLabel))] -> ReportState RDFLabel makeNodeOpts mnodeuri optproperties = makeNode mnodeuri (map snd . filter fst $ optproperties) makeAnon :: [(String,ReportState RDFLabel)] -> ReportState RDFLabel makeAnon = makeNode Nothing makeNode :: Maybe RepUri -> [(String,ReportState RDFLabel)] -> ReportState RDFLabel makeNode Nothing properties = makeNode1 makeBlank properties makeNode (Just u) properties = makeNode1 (makeRes u) properties makeNode1 :: ReportState RDFLabel -> [(String,ReportState RDFLabel)] -> ReportState RDFLabel makeNode1 label properties = do { lab <- label ; sequence $ map (makeArc lab) properties ; return lab } makeArc :: RDFLabel -> (String,ReportState RDFLabel) -> ReportState () makeArc subj (pname,getobj) = do { let prop = Res (ScopedName namespaceRep pname) ; obj <- getobj ; modify $ applyToGr (addArc (Arc subj prop obj)) } makeRes :: RepUri -> ReportState RDFLabel makeRes (ns,ln) = return $ Res (ScopedName ns ln) makeLit :: String -> ReportState RDFLabel makeLit str = return $ Lit str Nothing -------------------------------------------------------------------------------- -- -- 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/CompileRDF/ReportCompileToRDF.hs,v $ -- $Author: graham $ -- $Revision: 1.5 $ -- $Log: ReportCompileToRDF.hs,v $ -- Revision 1.5 2004/03/26 21:20:07 graham -- Bug-fixes to support report generation. -- (The old Python code is a bit flakey in places.) -- -- Revision 1.4 2004/03/26 12:18:40 graham -- Tweak graph generation to be compatible with RepToRDF. -- -- Revision 1.3 2004/02/10 20:57:32 graham -- Report compiler passes all tests. -- -- Revision 1.2 2004/02/09 22:24:09 graham -- Part tested report compiler logic. -- One test case still fails, can't see why yet until function to -- highlight graph differences is available. -- -- Revision 1.1 2004/01/14 21:34:08 graham -- Work-in-progress on RDF report compiler