--------------------------------------------------------------------------------
--  $Id: RepParser.hs,v 1.2 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      :  RepParser
--  Copyright   :  (c) 2003, Graham Klyne
--  License     :  GPL V2
--
--  Maintainer  :  Graham Klyne
--  Stability   :  provisional
--  Portability :  H98
--
--  This module implements a parset for report description files,
--  returning an RDF Graph containing the encoded report genearator.
--
--------------------------------------------------------------------------------

module RepParser
    ( parseRepFromString
    )
where

import RepMonad
    ( RepStateIO, RepState(..)
    , setFormat, setGraph
    , setInfo, resetInfo, setError, resetError, setExitcode
    , emptyState
    , RepFormat(..)
    , repError
    , reportLines, reportLine
    )

import RDFGraph
    ( RDFGraph, RDFLabel(..)
    , Label(..)
    , emptyRDFGraph
    , NamespaceMap
    , setNamespaces
    , merge, add
    )

import N3Parser
    ( parseAnyfromString
    , N3Parser(..), N3State(..)
    , whiteSpace, symbol, lexeme, eof, identLetter
    , defaultPrefix, namedPrefix, setPrefix
    , document, subgraph, uriNode, strNode, litNode, uriRef2, varid
    , lexUriRef
    , newBlankNode, operatorLabel, addStatement
    , number
    )

import Namespace
    ( Namespace(..), ScopedName(..) )

import Vocabulary
    ( namespaceRDF
    , namespaceRDFS
    , rdf_type
    , rdf_first, rdf_rest, rdf_nil
    )

import ErrorM
    ( ErrorM(..) )

import Parsec
    ( (<?>), (<|>)
    , many, many1, manyTill, option, choice, sepBy, between
    , try, notFollowedBy
    , string, char, anyChar
    , getState, updateState
    )

------------------------------------------------------------
--  Namespace for report description
------------------------------------------------------------

namespaceRepUri = "http://id.ninebynine.org/wip/2002/ReportGen/"
namespaceRep    = Namespace "rep" namespaceRepUri

rep_member  = ScopedName namespaceRep "member"
rep_element = ScopedName namespaceRep "element"

------------------------------------------------------------
--  Parser for report definition processor
------------------------------------------------------------
--
--  The parser is based on the Notation3 parser, and uses many
--  of the same syntax productions, but the top-level productions used
--  are quite different.

parseRepFromString :: Maybe String -> String -> ErrorM RDFGraph
parseRepFromString base inp =
    case parseAnyfromString report base inp of
        Left  err -> Error  err
        Right scs -> Result scs

----------------------------------------------------------------------
--  Syntax productions
----------------------------------------------------------------------

report :: N3Parser RDFGraph
report =
        do  { whiteSpace
            ; updateState $ setPrefix "rep" namespaceRepUri
            ; many declaration
            ; eof
            ; s <- getState
            ; return $ setNamespaces (prefixUris s) (graphState s)
            }

declaration :: N3Parser ()
declaration =
        do  { try $ symbol "@prefix"
            ; ( defaultPrefix <|> namedPrefix )
            ; return ()
            }
    <|> reportItem
    <|> queryItem
    <|> textItem
    <?>
        "Report item declaration: @prefix, @report, @query or @text"

--  Parse report generation commands

reportItem :: N3Parser ()

reportItem =
        do { try $ symbol "@report"
           ; rnode <- uriNode
           ; addStatement rnode (Res rdf_type) (makeRepRes "Report")
           ; commands (Just rnode)
           ; trysymbol "END"
           }
    <?> "@report command, or 'END'"

commands :: Maybe RDFLabel -> N3Parser RDFLabel
commands chead =
        do  { listOf chead command
            }

command :: N3Parser RDFLabel
command =
        do  { trysymbol "OPEN" ; chan <- strNode ; file <- textValue
            ; makeAnon
                [ ("cmd",      makeRes (namespaceRep,"open"))
                , ("chan",     makeLit chan)
                , ("file",     return file)
                ]
            }
    <|>
        do  { trysymbol "CLOSE" ; chan <- strNode
            ; makeAnon
                [ ("cmd",      makeRes (namespaceRep,"close"))
                , ("chan",     makeLit chan)
                ]
            }
    <|>
        do  { trysymbol "WRITE" ; chan <- strNode ; strval <- textValue
            ; makeAnon
                [ ("cmd",      makeRes (namespaceRep,"write"))
                , ("chan",     makeLit chan)
                , ("data",     return strval)
                ]
            }
    <|>
        do  { trysymbol "DEBUG" ; strval <- textValue
            ; makeAnon
                [ ("cmd",      makeRes (namespaceRep,"debug"))
                , ("data",     return strval)
                ]
            }
    <|>
        do  { trysymbol "IFDEF" ; vars <- many1 varid
            ; ifhead <- makeAnon $
                ( ("cmd",      makeRes (namespaceRep,"if"))
                : map (\v->("defined", makeVarLit v )) vars
                )
            ; ifbody ifhead
            }
    <|>
        do  { trysymbol "IFANY" ; vars <- many1 varid
            ; ifhead <- makeAnon $
                ( ("cmd",      makeRes (namespaceRep,"ifany"))
                : map (\v->("defined", makeVarLit v )) vars
                )
            ; ifbody ifhead
            }
    <|>
        do  { trysymbol "IFMATCH" ; pnode <- uriNode
            ; ifhead <- makeAnon $
                [ ("cmd",      makeRes (namespaceRep,"if") )
                , ("pattern",  return pnode                )
                ]
            ; ifbody ifhead
            }
    <|>
        do  { trysymbol "FOREACH" ; pnode <- uriNode
            ; forhead <- makeAnon $
                [ ("cmd",      makeRes (namespaceRep,"for") )
                , ("pattern",  return pnode                 )
                ]
            ; forbody forhead
            }
    <|>
        do  { trysymbol "DO" ; rnode <- uriNode
            ; makeAnon [ ("do", return rnode) ]
            }

ifbody :: RDFLabel -> N3Parser RDFLabel
ifbody ifhead =
        do  { makeArc ifhead ("do",commandSeq)
            ; option () $
                do  { trysymbol "ELSE"
                    ; makeArc ifhead ("else",commandSeq)
                    }
            ; trysymbol "END"
            ; return ifhead
            }
    <?> "IF body commands, 'ELSE' clause or 'END'"

forbody :: RDFLabel -> N3Parser RDFLabel
forbody forhead =
        do  { makeArc forhead ("do",commandSeq)
            ; option () $
                do  { trysymbol "FIRST"
                    ; makeArc forhead ("first",commandSeq)
                    }
            ; option () $
                do  { trysymbol "SEPARATOR"
                    ; makeArc forhead ("sep",commandSeq)
                    }
            ; option () $
                do  { trysymbol "LAST"
                    ; makeArc forhead ("last",commandSeq)
                    }
            ; option () $
                do  { trysymbol "ELSE"
                    ; makeArc forhead ("else",commandSeq)
                    }
            ; trysymbol "END"
            ; return forhead
            }
    <?> "FOR body commands, 'FIRST', 'SEPARATOR', 'LAST', 'ELSE' or 'END'"

commandSeq :: N3Parser RDFLabel
commandSeq =
        do  { trysymbol "DO" ; {- rnode <- -} uriNode
            -- ; makeAnon [ ("do", return rnode) ]
            }
    <|>
        do  { commands Nothing
            }


--  Parse report generation query patterns

queryItem :: N3Parser ()
queryItem =
        do { trysymbol "@query"
           ; qnode <- uriNode
           ; querySeq (Just qnode)
           ; return ()
           }

--  Parse a query sequence enclosed in brackets
querySeq :: Maybe RDFLabel -> N3Parser RDFLabel
querySeq qhead = between (symbol "(") (symbol ")") (querySeq1 qhead)

--  Parse a query sequence without enclosing brackets
querySeq1 :: Maybe RDFLabel -> N3Parser RDFLabel
querySeq1 qhead = (listThenTail qhead queryTerm queryTail)

--  Parse the end of a query seqence: this must occur at the end
--  of a query pattern sequence, inside any enclosing syntax.
queryTail :: N3Parser RDFLabel
queryTail =
        do  { symbol "@"
            ; uriNode
            }
    <|>
        operatorLabel rdf_nil

queryTerm :: N3Parser RDFLabel
queryTerm =
        do  { vn <- varid
            ; makeAnon [("var",makeVarLit vn)]
            }
    <|>
        do  { un <- uriNode
            ; case un of
                Res u | u == rep_member  -> return un
                Res u | u == rep_element -> return un
                otherwise                -> makeAnon [("uri",return un)]
            }
    <|>
        do  { ln <- litNode
            ; makeAnon [("lit",return ln)]
            }
    <|>
        do  { symbol "["
            ; qs <- choice
                [ do { symbol "@" ; uriNode }
                {- , listOf Nothing queryTerm -}
                , querySeq1 Nothing
                ]
            -- ; qs <- (listOf Nothing queryTerm)
            ; symbol "]"
            ; makeAnon [("opt",return qs)]
            }
    <|>
        do  { symbol "("
            -- ; q1 <- (listOf Nothing queryTerm)
            ; q1 <- querySeq1 Nothing
            ; qs <- many $
                do  { symbol "&"
                    ; querySeq1 Nothing
                    -- ; listOf Nothing queryTerm
                    }
            ; qa <- option [] $
                do  { symbol "|"
                    -- ; a <- listOf Nothing queryTerm
                    ; a <- querySeq1 Nothing
                    ; return [a]
                    }
            ; symbol ")"
            ; makeAnon $
                map (\v->("and",return v)) (q1:qs) ++
                map (\v->("alt",return v)) qa
            }
    <?> "query term: variable, uri, literal, [...] or (...&...|...)"


--  Parse text fomatting templates

textItem :: N3Parser ()
textItem =
        do { trysymbol "@text"
           ; tnode <- uriNode
           ; textSeq (Just tnode)
           ; return ()
           }

textValue :: N3Parser RDFLabel
textValue = uriNode <|> textNode <|> textSeq Nothing

textNode :: N3Parser RDFLabel
textNode =
        do  { s <- strNode
            ; makeLit s
            }

textSeq :: Maybe RDFLabel -> N3Parser RDFLabel
textSeq thead = between (symbol "(") (symbol ")") (listOf thead textTerm)

textTerm :: N3Parser RDFLabel
textTerm =
        do  { symbol "@"
            ; uriNode
            }
    <|>
        do  { vn <- varid
            ; makeAnon [("var",makeVarLit vn)]
            }
    <|>
        do  { try $ do { symbol "(" ; symbol "LOCAL" }
            ; vn <- varid
            ; symbol ")"
            ; makeAnon [("local",makeVarLit vn)]
            }
    <|>
        do  { textNode
            }
    <|>
        do  { symbol "NL"
            ; return (makeRepRes "nl")
            }
    <|>
        do  { symbol "TRIMWS"
            ; return (makeRepRes "trimws")
            }
    <|>
        do  { pname <- try $ do
                { symbol "("
                ; choice
                    [ do { trysymbol "TABSP"  ; return "tabsp"  }
                    , do { trysymbol "TABNL"  ; return "tabnl"  }
                    , do { trysymbol "TAB"    ; return "tab"    }
                    , do { trysymbol "LEFT"   ; return "left"   }
                    , do { trysymbol "WRAP"   ; return "wrap"   }
                    , do { trysymbol "INDENT" ; return "indent" }
                    ]
                }
            ; n <- number
            ; symbol ")"
            ; makeAnon [(pname,makeLit (show n))]
            }
    <|>
        do  { pname <- try $ do
                { symbol "("
                ; choice
                    [ do { trysymbol "DEFER" ; return "defer" }
                    , do { trysymbol "FLUSH" ; return "flush" }
                    ]
                }
            ; symbol ":"
            ; tv <- listOrOne textTerm
            ; symbol ")"
            ; makeAnon [(pname,return tv)]
            }
    <|>
        do  { pname <- try $ do
                { symbol "("
                ; choice
                    [ do { trysymbol "IFDEF" ; return "if"    }
                    , do { trysymbol "IFANY" ; return "ifany" }
                    ]
                }
            ; vs <- many1 varid
            ; symbol ":"
            ; td <- listOrOne textTerm
            ; te <- option [] $
                do  { symbol "|"
                    ; e <- listOrOne textTerm
                    ; return [e]
                    }
            ; symbol ")"
            ; dv <- makeAnon ( map (\v->("defined",makeVarLit v)) vs )
            ; makeAnon $
                ( (pname,return dv)
                : ("do", return td)
                : map (\e->("else", return e)) te
                )
            }
    <?> "text term: @name, ?var, string, NL, etc."

trysymbol :: String -> N3Parser ()
trysymbol s =
        do  { try ( symbol s )
            ; return ()
            }

unimplemented = error "unimplemented"

--  Construct a list of some item, and return the head of the list
--
--  subj        is the node from which the list is linked, or Nothing
--  item        is a parser for the item from which the list is constituted.
--
--  Returns the supplied head of list or Nil if the list is empty.
--
--  Link first element of link to list head, scan rest of list,
--  and return the list head;  otherwise return a node rdf_null.
--
--  This slightly convoluted pattern is to deal with two different
--  occurrences of a list node:
--    <node> = ( l1, l2, ... )
--      Here, <node> (the supplied subj) is the listhead.
--    <node> prop ( l1, l2, ... )
--      Here, the a new blank is supplied as subj to be the listhead.
--  In either case, if the list is non-empty, the supplied or allocated
--  subj is returned.  But if the list is empty, a rdf_null node is returned.
--  In the second case, the invoking production must use the returned
--  value.
--

listOf :: Maybe RDFLabel -> N3Parser RDFLabel -> N3Parser RDFLabel
listOf subj item = listThenTail subj item (operatorLabel rdf_nil)
{-
        do  { ls <- many item
            ; makeList subj ls
            }
-}

--  This is like 'listOf', except that it returns a singleton value as
--  itself rather than as a list.
listOrOne :: N3Parser RDFLabel -> N3Parser RDFLabel
listOrOne item =
        do  { ls <- many item
            ; lt <- operatorLabel rdf_nil
            ; makeListOrOne ls lt
            }

--  Parse a sequence (maybe empty) of items followed by exactly one
--  instance of the tail term, which returns a value that is used as the
--  rest of the list following the sequence parsed.
listThenTail ::
    Maybe RDFLabel -> N3Parser RDFLabel -> N3Parser RDFLabel -> N3Parser RDFLabel
listThenTail subj item final =
        do  { ls <- many item
            ; lt <- final
            ; makeList subj ls lt
            }

----------------------------------------------------------------------
--  Graph compilation helpers
----------------------------------------------------------------------

--  Make statements about new blank node
makeAnon ::
    [(String,N3Parser RDFLabel)]
    -> N3Parser RDFLabel
makeAnon = makeNode Nothing

--  Construct report description statements with a supplied node as
--  subject, or a new blank node if Nothing is supplied, and the
--  supplied list of statement descriptors, where each element
--
makeNode ::
    Maybe (Namespace,String) -> [(String,N3Parser RDFLabel)]
    -> N3Parser RDFLabel
makeNode Nothing  properties = makeNode1 makeBlank   properties
makeNode (Just u) properties = makeNode1 (makeRes u) properties

--  Make statements about a node returned by supplied parser
makeNode1 ::
    N3Parser RDFLabel -> [(String,N3Parser RDFLabel)]
    -> N3Parser RDFLabel
makeNode1 label properties =
    do  { lab <- label
        ; makeArcs lab properties
        ; return lab
        }

--  Make statements about specified node
makeArcs ::
    RDFLabel -> [(String,N3Parser RDFLabel)]
    -> N3Parser ()
makeArcs lab properties =
    do  { sequence_ $ map (makeArc lab) properties
        }

--  Make statement about specified node
--
--  The statement is specified as a property local name which
--  is taken to be in the rep: namespace, and the object node
--  is provided by a supplied parser.
--
makeArc :: RDFLabel -> (String,N3Parser RDFLabel) -> N3Parser ()
makeArc subj (pname,getobj) =
    do  { obj <- getobj
        ; addStatement subj (makeRepRes pname) obj
        }

--  Make graph label for given local name in rep: namespace
makeRepRes :: String -> RDFLabel
makeRepRes locnam = Res (ScopedName namespaceRep locnam)

--  Make a resource node from the supplied namespace and local name
makeRes :: (Namespace,String) -> N3Parser RDFLabel
makeRes (ns,ln) = return $ Res (ScopedName ns ln)

--  Make a literal node from the supplied string
makeLit :: String -> N3Parser RDFLabel
makeLit str = return $ Lit str Nothing

--  Make a literal node from the name of a variable node
makeVarLit :: RDFLabel -> N3Parser RDFLabel
makeVarLit (Var nam) = makeLit nam
makeVarLit label     = error ("Unexpected variable: "++show label)

--  Make a new blank node
makeBlank :: N3Parser RDFLabel
makeBlank = newBlankNode

--  Return a singleton value, or make a list from the supplied values
makeListOrOne :: [RDFLabel] -> RDFLabel -> N3Parser RDFLabel
makeListOrOne [n1] _  = return n1
makeListOrOne ns   lt = makeList Nothing ns lt

--  Make a list of the supplied values
makeList :: Maybe RDFLabel -> [RDFLabel] -> RDFLabel -> N3Parser RDFLabel
makeList _    []      lt = return lt
makeList subj (n1:ns) lt =
    do  { sb <- case subj of
            Nothing -> makeBlank
            Just s  -> return s
        ; first <- operatorLabel rdf_first
        ; addStatement sb first n1
        ; makeList1 sb ns lt
        ; return sb
        }

makeList1 :: RDFLabel -> [RDFLabel] -> RDFLabel -> N3Parser ()
makeList1 prev [] lt =
    do  { rest  <- operatorLabel rdf_rest
        ; addStatement prev rest lt
        }
makeList1 prev (n1:ns) lt =
    do  { lnk   <- newBlankNode
        ; first <- operatorLabel rdf_first
        ; rest  <- operatorLabel rdf_rest
        ; addStatement lnk  first n1
        ; addStatement prev rest  lnk
        ; makeList1 lnk ns lt
        }

--------------------------------------------------------------------------------
--
--  Copyright (c) 2004, G. KLYNE.  All rights reserved.
--
--  This 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.
--
--  This software 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 RepToRDF; if not, write to:
--    The Free Software Foundation, Inc.,
--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
--  or view the web page at:
--    http://www.gnu.org/copyleft/gpl.html
--
--------------------------------------------------------------------------------
-- $Source: /file/cvsdev/CompileRDF/RepParser.hs,v $
-- $Author: graham $
-- $Revision: 1.2 $
-- $Log: RepParser.hs,v $
-- Revision 1.2  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.1  2004/03/26 12:18:05  graham
-- Created report description compiler
--