\begin{code}

module Main  where

import Brianweb.Text.Html
import Brianweb.Text.Html.Parser
import Brianweb.Misc
import Brianweb.Data.Tree
import Brianweb.Data.List
import Brianweb.Net.WebBrowser
import Brianweb.IO (readFileStrict)
import qualified Brianweb.Data.BalancedTree as BT

import Data.IORef
import Text.Html
import Maybe (listToMaybe,catMaybes,fromMaybe)
import Monad (guard,when)
import Char (isSpace,isDigit)
import System (getArgs)
import System.IO.Unsafe (unsafePerformIO)

searchUrl :: String
searchUrl = "http://www.rochester.lib.ny.us:2080/cgi-bin/cw_cgi?5000"

doCache :: Bool
doCache = True

data BranchInfo = BranchInfo {
    branchName :: String,
    branchLocation :: String,
    branchDate :: String,
    branchCallNumber :: String,
    branchStatus :: String
    } deriving (Read,Show)

data MarcTag = MarcTag {
    tagNumber :: String,
    tagDescription :: String,
    tagValue :: String
    } deriving (Read,Show)

data DBEnt = DBEnt {
    entName :: String,
    isbnNumber :: String,
    rating :: Integer
    } deriving (Eq,Read,Show)

shortEntName :: DBEnt -> String
shortEntName = takeWhile (not . (`elem`"[/")) . entName

extractMarcUrl :: Html -> Maybe String
extractMarcUrl = lookup "Display MARC" . extractTextLinks

extractBranchInfo :: Html -> Maybe [BranchInfo]
extractBranchInfo 
    = fmap (catMaybes . map (f . map (trim isSpace . textOnlyHtml)))
    . findTable (==["*Branch*","*Location*","*Date*","*Call Number*","*Status*"]) 
    where
        f [n,l,d,c,s] = Just $ BranchInfo n l d c s
        f _ = Nothing

extractMarcTags :: Html -> Maybe [MarcTag]
extractMarcTags 
    = fmap (catMaybes . map (f . map (trim isSpace . textOnlyHtml)))
    . findTable (==["_Description_","_Tag_","_Ind._","[Image]_*Tag Content*_"])
    where
        f xs = case map fixMercEscapes xs of
            [d,n,_,_,v] -> Just $ MarcTag n d v
            _ -> Nothing
        fixMercEscapes ('^':c:xs)
            | c `elem` "hcb" = ' ':fixMercEscapes xs
            | otherwise = fixMercEscapes xs
        fixMercEscapes (x:xs) = x : fixMercEscapes xs
        fixMercEscapes [] = []

lookupMarcTag :: String -> [MarcTag] -> Maybe String
lookupMarcTag k xs = listToMaybe [v | MarcTag _ d v <- xs, d == k]

loadDatabase :: IO [DBEnt]
loadDatabase = readFile "db.txt" >>= readIO

saveDatabase :: [DBEnt] -> IO ()
saveDatabase = writeFile "db.txt" . show

addEntry :: WebBrowser -> String -> IO ()
addEntry wb url = do
    db <- loadDatabase
    mainPage <- loadHtmlPage wb url Nothing
    marcUrl <- maybe (fail "no marc url") return $ extractMarcUrl mainPage
    marcPage <- loadHtmlPage wb marcUrl Nothing
    marcTags <- maybe (fail "no marc tags") return $ extractMarcTags marcPage
    isbn <-  maybe (fail "no isbn") (return . takeWhile isDigit) $ "ISBN" `lookupMarcTag` marcTags
    entName <- maybe (fail "no title") return $ "Title" `lookupMarcTag` marcTags
    let entry = DBEnt entName isbn 0
    when (isbn `elem` (map isbnNumber db)) $ fail "You already have that"
    putStrLn $ "Adding entry: " ++ show entry
    saveDatabase (db ++ [entry])

dumpDB :: IO ()
dumpDB = loadDatabase >>= putStrLn.unlines.map show

cacheFile :: FilePath
cacheFile = "cache.txt"

{-# NOINLINE cache #-}
cache :: IORef [(String,[BranchInfo])]
cache = unsafePerformIO $ ((readFileStrict cacheFile >>= readIO) `catch` \_ -> return []) >>= newIORef

loadCached :: String -> IO [BranchInfo]
loadCached isbn
    | doCache = readIORef cache >>= maybe (fail "no entry in cache") return . lookup isbn
    | otherwise = fail "cache disabled"

updateCache :: String -> [BranchInfo] -> IO ()
updateCache isbn bi
    | doCache = do
        oldCache <- readIORef cache
        let newCache = (isbn,bi):oldCache
        writeIORef cache newCache
        writeFile cacheFile (show newCache)
    | otherwise = return ()


loadBranchInfo :: WebBrowser -> DBEnt -> IO [BranchInfo]
loadBranchInfo wb (DBEnt _ isbn _) = loadCached isbn `catch` \_ -> do
    searchPage <- loadHtmlPage wb searchUrl Nothing
    form <- maybe (fail "can't find form") return $ extractFromPage extractForm searchPage
    let form' = updateFormValue "searchtype" "ISBN/ISSN Search"
              $ updateFormValue "terms" isbn form
    mainPage <- submitForm wb form'
    branchInfo <- maybe (fail "can't find branch info") return $ extractBranchInfo mainPage
    updateCache isbn branchInfo
    return branchInfo

entryStatus :: WebBrowser -> String -> IO ()
entryStatus wb search = do
    db <- loadDatabase
    let res = filter ((==search).take (length search).entName) db
    ent <- maybe (fail $ search ++ " not found") return $ listToMaybe res
    showEntry wb ent

putHeader :: String -> IO ()
putHeader s = do
    putStrLn s'
    putStrLn ['='|_<-[1..min (length s') 16]]
    where s' = take 78 s 

showEntry :: WebBrowser -> DBEnt -> IO ()
showEntry wb ent = do
    branchInfo <- loadBranchInfo wb ent
    putHeader (entName ent)
    putStrLn $ unlines $ map (\bi -> 
        branchName bi ++ " - " ++ branchStatus bi ++ " - " ++ branchDate bi
        ) branchInfo

showAvail :: WebBrowser -> IO ()
showAvail wb = do
    db <- loadDatabase
    sequence_ (map processEnt db)
    where
        processEnt ent = do
            branchInfo <- fmap (filter ((=="Not Checked Out").branchStatus))
                        $ loadBranchInfo wb ent
            when (not (null branchInfo)) $ do
                putHeader (entName ent)
                putStrLn $ unlines $ map branchName branchInfo

showBranches :: WebBrowser -> IO ()
showBranches wb = do
    db <- loadDatabase
    tree <- fmap (foldr (BT.unionAccum (++)) (BT.empty)) $ sequence (map processEnt db)
    let list = sortByField (negate.length.snd) (BT.assoc tree)
    mapM_ (\(name,items) -> putHeader name >> putStrLn (unlines $ map (take 78) items)) list
    where
        processEnt ent = do
            branchInfo <- fmap (filter ((=="Not Checked Out").branchStatus))
                        $ loadBranchInfo wb ent
            return $ foldr (\bi bt -> BT.insert bt (branchName bi) [shortEntName ent]) BT.empty branchInfo

removeEntry :: String -> IO ()
removeEntry x = loadDatabase >>= return . filter ((/=x).isbnNumber) >>= saveDatabase

showNotAvail :: WebBrowser -> IO ()
showNotAvail wb = do
    db <- loadDatabase
    sequence_ (map processEnt db)
    where
        processEnt ent = do
            branchInfo <- fmap (filter ((=="Not Checked Out").branchStatus))
                        $ loadBranchInfo wb ent
            when (null branchInfo) $ putStrLn $ take 78 $ entName ent

main :: IO ()
main = do
    args <- getArgs
    wb <- newWebBrowser
    case args of 
        ["add",url] -> addEntry wb url
        ["dump"] -> dumpDB
        ["entstatus",n] -> entryStatus wb n
        ["allents"] -> loadDatabase >>= sequence_ . map (showEntry wb)
        ["avail"] -> showAvail wb
        ["notavail"] -> showNotAvail wb
        ["branches"] -> showBranches wb
        ["remove",isbn] -> removeEntry isbn
        _ -> fail "Bad arguments"

\end{code}