{-------------------------------------------------------------------------------------
-
- No database connectivity
- Programmer: Leonidas Fegaras
- Email: fegaras@cse.uta.edu
- Web: http://lambda.uta.edu/
- Creation: 08/14/08, last update: 08/14/08
- 
- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.
- This material is provided as is, with absolutely no warranty expressed or implied.
- Any use is at your own risk. Permission is hereby granted to use or copy this program
- for any purpose, provided the above notices are retained on all copies.
-
--------------------------------------------------------------------------------------}


module Text.XML.HXQ.OptionalDB where

import Text.XML.HXQ.XTree
import Text.XML.HXQ.Parser


type Statement = String

class IConnection conn

data Connection = Connection String

instance IConnection Connection


noDBerror = error "This version of HXQ does not provide database connectivity"


publishXmlDoc :: FilePath -> String -> Ast
publishXmlDoc filepath name = noDBerror


executeSQL :: Statement -> XSeq -> IO XSeq
executeSQL stmt args = noDBerror


prepareSQL :: (IConnection conn) => conn -> String -> IO Statement
prepareSQL db sql = noDBerror


-- | Connect to the relational database in filepath
connect :: FilePath -> IO Connection
connect filepath = noDBerror


disconnect :: conn -> IO ()
disconnect db = noDBerror


-- | Print the relational schema of the XML document stored in the database under the given name
printSchema :: (IConnection conn) => conn -> String -> IO ()
printSchema db name = noDBerror


-- | Store an XML document into the database under the given name.
shred :: (IConnection conn) => conn -> String -> String -> IO ()
shred db file name = noDBerror


-- | Create a secondary index on tagname for the shredded document under the given name..
createIndex :: (IConnection conn) => conn -> String -> String -> IO ()
createIndex db name tagname = noDBerror