(*
 * Dynamic web page generation with Standard ML
 * Copyright (C) 2003  Adam Chlipala
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version.
 *
 * This library 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
 * Lesser General Public License for more details.
 * 
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)

(* Common convenience stuff to open in several places *)

structure Common =
struct
    exception Skip
    exception Format of string

    fun error (pos, msg) = (ErrorMsg.error pos msg;
			    raise Skip)

    fun error' (pos, msg) = ErrorMsg.error pos msg

    type 'a map = 'a StringMap.map

    val insert = StringMap.insert
    fun contains x = isSome (StringMap.find x)

    fun lookup (D, v, pos) =
	(case StringMap.find (D, v) of
	     NONE => error (pos, "Unbound tycon " ^ v)
	   | SOME r => r)

    type 'a nmap = 'a IntBinaryMap.map

    val ninsert = IntBinaryMap.insert
    fun ncontains x = isSome (IntBinaryMap.find x)

    fun nlookup (D, v, pos) =
	(case IntBinaryMap.find (D, v) of
	     NONE => error (pos, "BAD: Unbound tyname or tvname " ^ Int.toString v)
	   | SOME r => r)

    type ident = string

    fun indexAfter (str, i, ch) =
	let
	    val sz = size str
	    fun search i =
		if i >= sz then
		    NONE
		else if String.sub(str, i) = ch then
		    SOME i
		else
		    search (i+1)
	in
	    search i
	end

    fun indexDoubleAfter (str, i, ch) =
	let
	    val sz = size str-1
	    fun search i =
		if i >= sz then
		    NONE
		else if String.sub(str, i) = ch andalso String.sub(str, i+1) = ch then
		    SOME i
		else
		    search (i+1)
	in
	    search i
	end

    fun index (str, ch) = indexAfter (str, 0, ch)
	   
    fun strLower str = String.implode (map Char.toLower (String.explode str))

    fun trim str =
	let
	    fun killFront L =
		(case L of
		     ch::rest =>
			 if Char.isSpace ch then
			     killFront rest
			 else
			     L
		   | [] => [])
	in
	    String.implode (rev (killFront (rev (killFront (String.explode str)))))
	end

    fun copyFile (src, dst) =
	if src = dst then
	    ()
	else
	    let
		val inf = TextIO.openIn src
		val outf = TextIO.openOut dst

		fun copy () =
		    (case TextIO.inputLine inf of
			 NONE => ()
		       | SOME line => (TextIO.output (outf, line);
				  copy ()))
	    in
		copy ();
		TextIO.closeIn inf;
		TextIO.closeOut outf
	    end

    fun writeToFile (fname, txt) =
	let
	    val outf = TextIO.openOut fname
	in
	    TextIO.output (outf, txt);
	    TextIO.closeOut outf
	end

    fun readFromFile fname =
	let
	    val inf = TextIO.openIn fname
	    fun read acc =
		(case TextIO.inputLine inf of
		     NONE => String.concat (rev acc)
		   | SOME line => read (line::acc))
	in
	    read []
	    before TextIO.closeIn inf
	end


    fun listToString (f, F, L) [] = ""
      | listToString (f, F, L) [id] = F ^ f id ^ L
      | listToString (f, F, L) (h::t) = foldl (fn (id, s) => s ^ ", " ^ f id) (F ^  f h) t ^ L

    fun idListToString (F, L) list = listToString (fn x => x, F, L) list

    val stringListToString = idListToString ("[", "]")

    fun urlDecode s =
	let
	    fun decode (L, acc) =
		(case L of
		     [] => String.implode (rev acc)
		   | #"+"::L => decode (L, #" "::acc)
		   | #"%"::MS::LS::L =>
			 (case StringCvt.scanString (Int.scan StringCvt.HEX) (str MS ^ str LS) of
			      NONE => decode (L, LS::MS:: #"%"::acc)
			    | SOME n => decode (L, chr n :: acc))
		   | ch::L => decode (L, ch::acc))
	in
	    decode (String.explode s, [])
	end

    fun pad (s, n) =
	if size s < n then
	    pad ("0" ^ s, n)
	else
	    s

    fun urlEncode s =
	let
	    fun xch ch =
		if Char.isAlphaNum ch orelse ch = #"_" orelse ch = #"." orelse ch = #"-" then
		    str ch
		else if ch = #" " then
		    "+"
		else
		    "%" ^ pad (Int.fmt StringCvt.HEX (ord ch), 2)
	in
	    String.concat (map xch (String.explode s))
	end

    fun stoiOpt s = Int.fromString s
    fun stoi s =
	(case Int.fromString s of
	     NONE => raise Format s
	   | SOME i => i)
    fun itos n =
	if n < 0 then
	    "-" ^ Int.toString (~n)
	else
	    Int.toString n

    fun storOpt s = Real.fromString s
    fun stor s =
	(case Real.fromString s of
	     NONE => raise Format s
	   | SOME r => r)
    fun rtos r =
	if r < 0.0 then
	    "-" ^ Real.toString (~r)
	else
	    Real.toString r

    fun html s =
	let
	    fun xch #"<" = "&lt;"
	      | xch #">" = "&gt;"
	      | xch #"&" = "&amp;"
	      | xch #"\"" = "&quot;"
	      | xch ch = str ch
	in
	    foldr op^ "" (map xch (String.explode s))
	end

    fun htmlNl s =
	let
	    fun xch #"<" = "&lt;"
	      | xch #">" = "&gt;"
	      | xch #"&" = "&amp;"
	      | xch #"\"" = "&quot;"
	      | xch #"\n" = "<br />"
	      | xch ch = str ch
	in
	    foldr op^ "" (map xch (String.explode s))
	end

    fun killLf s = String.implode (List.filter (fn ch => ch <> #"\r") (String.explode s))
end