module ReadBookmarks where
--import Prelude hiding (IOError)
import System.IO.Error(tryIOError)
--import DialogueIO
--import ContinuationIO(stdout)
import Control.Monad(mzero,(<=<),msum)
import Data.Maybe(listToMaybe)

--import Fudgets
import HtmlParser2
import Html
import HtmlTags
import TagAttrs
import HtmlFuns

data Bookmarks
  = Bookmark Title Url
  | Menu Title [Bookmarks]
  | Sep
  deriving (Eq)

type Title = String
type Url = String
{-
readBookmarksF filename cont =
  hIOerrF
    (ReadFile filename)
    errF
    (either errF (maybe errF' (succ . toBookmarks) . getmenu).parseHtml.(\(Str s)->s))
  where
    succ = cont . Just

    errF' = errF "Didn't find any menu in the bookmarks file"

    errF x = pr x (cont Nothing)
      where
	prs s = hIOSuccF (AppendChan stdout s)
	pr = prs.show
-}
readBookmarksIO filename =
    either errIO okIO =<< tryIOError (readFile filename)
  where
    okIO = either errIO (maybe errIO' (succ.toBookmarks) . getmenu).parseHtml

    errIO x = err (show x)
    errIO' = err "Didn't find any menu in the bookmarks file"

    succ = return . Just
    err msg = putStr msg >> return Nothing


toBookmarks = bm "Bookmarks"
  where
    bm title html =
      case html of
	HtmlContext (A,TA (("HREF",url):_)) html1:html ->
	  Bookmark (htmlchars html1) url:bm title html
	HtmlCommand (HR,_):html -> Sep:bm title html
	HtmlContext (DL,_) html1:html ->
	  Menu title (bm "??" html1):bm title html
	HtmlContext (DD,_) _:html -> bm title html
	HtmlContext (H3,_) html1:html -> bm (htmlchars html1) html
	HtmlContext (tag,_) html1:html -> bm title (html1++html)
	_:html -> bm title html
	_ -> []

findBookmark t = msum . map find
  where
    find b =
      case b of
        Menu title bms -> if title==t
                          then return bms
			  else findBookmark t bms
        _ -> mzero

---


getmenu = find DL <=< find BODY
--getmenu = find DL . find BODY
  where
    find tag = listToMaybe . find' tag

    find' tag = concatMap contents . extractElements tag

    contents (HtmlContext _ html) = [html]
    contents (HtmlCommand _) = []