reset error state before generating basis library

[hcoop/domtool2.git] / src / main-dbtool.sml

(* HCoop Domtool (http://hcoop.sourceforge.net/)
 * Copyright (c) 2006, Adam Chlipala
 *
 * This program 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 program 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 this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 *)

(* Driver for dbtool *)

fun badArgs () =
    print "Invalid command-line arguments.  See documentation at:\n\thttp://wiki.hcoop.net/MemberManual/Databases\n"

val _ =
    case CommandLine.arguments () of
	[] => badArgs ()
      | dbtype :: rest =>
	case Dbms.lookup dbtype of
	    NONE => print ("Unknown database type " ^ dbtype ^ ".\n")
	  | SOME {getpass, ...} =>
	    case rest of
		["adduser"] =>
		let
		    val pass = case getpass of
				   NONE => SOME NONE
				 | SOME f =>
				   case f () of
				       Client.Passwd pass => SOME (SOME pass)
				     | Client.Aborted => SOME NONE
				     | Client.Error => NONE
		in
		    case pass of
			NONE => ()
		      | SOME pass => Main.requestDbUser {dbtype = dbtype, passwd = pass}
		end
	      | ["passwd"] =>
		let
		    val pass = case getpass of
				   NONE => NONE
				 | SOME f =>
				   case f () of
				       Client.Passwd pass => SOME pass
				     | _ => NONE
		in
		    case pass of
			NONE => ()
		      | SOME pass => Main.requestDbPasswd {dbtype = dbtype, passwd = pass}
		end
	      | ["createdb", dbname] =>
		if Dbms.validDbname dbname then
		    Main.requestDbTable {dbtype = dbtype, dbname = dbname, encoding = NONE}
		else
		    print ("Invalid database name " ^ dbname ^ ".\n")
	      | ["createdb", dbname, encoding] =>
		if not (Dbms.validDbname dbname) then
		    print ("Invalid database name " ^ dbname ^ ".\n")
		else if not (Dbms.validEncoding (SOME encoding)) then
		    print ("Invalid encoding name " ^ encoding ^ ".\n")
		else
		    Main.requestDbTable {dbtype = dbtype, dbname = dbname, encoding = SOME encoding}
	      | ["dropdb", dbname] =>
		if Dbms.validDbname dbname then
		    Main.requestDbDrop {dbtype = dbtype, dbname = dbname}
		else
		    print ("Invalid database name " ^ dbname ^ ".\n")
	      | ["grant", dbname] =>
		if Dbms.validDbname dbname then
		    Main.requestDbGrant {dbtype = dbtype, dbname = dbname}
		else
		    print ("Invalid database name " ^ dbname ^ ".\n")
	      | _ => badArgs ()