content: {- hpodder component
  Copyright (C) 2006-2008 John Goerzen <jgoerzen@complete.org>
  
  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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  -}
  
  {- |
     Module     : DB
     Copyright  : Copyright (C) 2006-2008 John Goerzen
     License    : GNU GPL, version 2 or above
  
     Maintainer : John Goerzen <jgoerzen@complete.org>
     Stability  : provisional
     Portability: portable
  
  Written by John Goerzen, jgoerzen\@complete.org
  
  -}
  module DB where
  import Config
  import Types
  
  import Database.HDBC
  import Database.HDBC.Sqlite3
  import System.Log.Logger
  import Control.Monad
  import Control.Exception
  import Utils
  import Data.List.Utils
  dbdebug = debugM "DB"
  
  connect :: IO Connection
  connect = handleSqlError $
      do fp <- getDBName
         dbh <- connectSqlite3 fp
         setBusyTimeout dbh 5000
         prepDB dbh
         dbdebug $ "DB preparation complete"
         return dbh
  
  prepDB dbh =
      do tables <- getTables dbh
         evaluate (length tables)
         schemaver <- prepSchema dbh tables
         upgradeSchema dbh schemaver tables
  
  prepSchema :: Connection -> [String] -> IO Int
  prepSchema dbh tables =
      if "schemaver" `elem` tables
         then do r <- quickQuery dbh "SELECT version FROM schemaver" []
                 case r of
                   [[x]] -> return (fromSql x)
                   x -> fail $ "Unexpected result in prepSchema: " ++ show x
         else do dbdebug "Initializing schemaver to 0"
                 run dbh "CREATE TABLE schemaver (version INTEGER)" []
                 run dbh "INSERT INTO schemaver VALUES (0)" []
                 commit dbh
                 return 0
  
  upgradeSchema dbh 5 _ = return ()
  
  upgradeSchema dbh 4 tables =
      do dbdebug "Upgrading schema 4 -> 5"
         dbdebug "Recreating episodes table to add epguid column and UNIQUE constaint"
         -- Silly sqlite can't add a UNIQUE constaint to an existing table, so we
         -- have to recreate it.
         run dbh "CREATE TABLE episodes5 (\
                 \castid INTEGER NOT NULL,\
                 \episodeid INTEGER NOT NULL,\
                 \title TEXT NOT NULL,\
                 \epurl TEXT NOT NULL,\
                 \enctype TEXT NOT NULL,\
                 \status TEXT NOT NULL,\
                 \eplength INTEGER NOT NULL DEFAULT 0,\
                 \epfirstattempt INTEGER,\
                 \eplastattempt INTEGER,\
                 \epfailedattempts INTEGER NOT NULL DEFAULT 0,\
                 \epguid TEXT,\
                 \UNIQUE(castid, epurl),\
                 \UNIQUE(castid, episodeid),\
                 \UNIQUE(castid, epguid))" []
         dbdebug "Copying data from old episodes table"
         run dbh "INSERT INTO episodes5 SELECT *, NULL FROM episodes" []
         dbdebug "Dropping old episodes table"
         run dbh "DROP TABLE episodes" []
         dbdebug "Renaming new episodes table"
         run dbh "ALTER TABLE episodes5 RENAME TO episodes" []
  
         setSchemaVer dbh 5
         commit dbh
         upgradeSchema dbh 5 tables
  
  upgradeSchema dbh 3 tables =
      do dbdebug "Upgrading schema 3 -> 4"
         dbdebug "Adding lastattempt column"
         run dbh "ALTER TABLE podcasts ADD lastattempt INTEGER" []
         dbdebug "Adding failedattempts column"
         run dbh "ALTER TABLE podcasts ADD failedattempts INTEGER NOT NULL DEFAULT 0" []
  
         dbdebug "Adding epfirstattempt column"
         run dbh "ALTER TABLE episodes ADD epfirstattempt INTEGER" []
         dbdebug "Adding eplastattempt column"
         run dbh "ALTER TABLE episodes ADD eplastattempt INTEGER" []
         dbdebug "Adding epfailedattempts column"
         run dbh "ALTER TABLE episodes ADD epfailedattempts INTEGER NOT NULL DEFAULT 0" []
  
         setSchemaVer dbh 4
         commit dbh
         upgradeSchema dbh 4 tables
  
  upgradeSchema dbh 2 tables =
      do dbdebug "Upgrading schema 2 -> 3"
         dbdebug "Adding eplength column"
         run dbh "ALTER TABLE episodes ADD eplength INTEGER NOT NULL DEFAULT 0" []
         setSchemaVer dbh 3
         commit dbh
         
         -- Empty the enclosure storage since our naming changed when this
         -- version arrived
         edir <- getEnclTmp
         emptyDir edir
         upgradeSchema dbh 3 tables
  
  upgradeSchema dbh 1 tables = 
      do dbdebug "Upgrading schema 1 -> 2"
         dbdebug "Adding pcenabled column"
         run dbh "ALTER TABLE podcasts ADD pcenabled INTEGER NOT NULL DEFAULT 1" []
         dbdebug "Adding lastupdate column"
         run dbh "ALTER TABLE podcasts ADD lastupdate INTEGER" []
         setSchemaVer dbh 2
         commit dbh
         -- dbdebug "Vacuuming"
         -- run dbh "VACUUM" []
         upgradeSchema dbh 2 tables
         
  upgradeSchema dbh 0 tables =
      do dbdebug "Upgrading schema 0 -> 1"
         unless ("podcasts" `elem` tables)
                (run dbh "CREATE TABLE podcasts(\
                         \castid INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,\
                         \castname TEXT NOT NULL,\
                         \feedurl TEXT NOT NULL UNIQUE)" [] >> return ())
         unless ("episodes" `elem` tables)
                (run dbh "CREATE TABLE episodes (\
                         \castid INTEGER NOT NULL, \
                         \episodeid INTEGER NOT NULL, \
                         \title TEXT NOT NULL, \
                         \epurl TEXT NOT NULL, \
                         \enctype TEXT NOT NULL,\
                         \status TEXT NOT NULL,\
                         \UNIQUE(castid, epurl),\
                         \UNIQUE(castid, episodeid))" [] >> return ())
         setSchemaVer dbh 1
         commit dbh
         upgradeSchema dbh 1 tables
  
  upgradeSchema dbh sv _ = 
      fail $ "Unrecognized DB schema version " ++ (show sv) ++ 
           "; you probably need a newer hpodder to read this database."
  
  setSchemaVer :: Connection -> Integer -> IO ()
  setSchemaVer dbh sv =
      do dbdebug $ "Setting schema version to " ++ show sv
         run dbh "DELETE FROM schemaver" []
         run dbh "INSERT INTO schemaver VALUES(?)" [toSql sv]
         return ()
  
  {- | Adds a new podcast to the database.  Ignores the castid on the incoming
  podcast, and returns a new object with the castid populated.
  
  A duplicate add is an error. -}
  addPodcast :: Connection -> Podcast -> IO Podcast
  addPodcast dbh podcast =
      do handleSql 
          (\e -> fail $ "Error adding podcast; perhaps this URL already exists\n"
                 ++ show e) $
                 run dbh "INSERT INTO podcasts (castname, feedurl, pcenabled, lastupdate, lastattempt, failedattempts) VALUES (?, ?, ?, ?, ?, ?)"
                           [toSql (castname podcast), toSql (feedurl podcast),
                            toSql (fromEnum (pcenabled podcast)),
                            toSql (lastupdate podcast),
                            toSql (lastattempt podcast),
                            toSql (failedattempts podcast)]
         r <- quickQuery dbh "SELECT castid FROM podcasts WHERE feedurl = ?"
              [toSql (feedurl podcast)]
         case r of
           [[x]] -> return $ podcast {castid = fromSql x}
           y -> fail $ "Unexpected result: " ++ show y
  
  updatePodcast :: Connection -> Podcast -> IO ()
  updatePodcast dbh podcast = 
      run dbh "UPDATE podcasts SET castname = ?, feedurl = ?, pcenabled = ?, \
              \lastupdate = ?, lastattempt = ?, failedattempts = ? \
              \WHERE castid = ?"
          [toSql (castname podcast), toSql (feedurl podcast),
           toSql (fromEnum (pcenabled podcast)),
           toSql (lastupdate podcast),
           toSql (lastattempt podcast),
           toSql (failedattempts podcast), toSql (castid podcast)] >> return ()
  
  {- | Remove a podcast. -}
  removePodcast :: Connection -> Podcast -> IO ()
  removePodcast dbh podcast =
      do run dbh "DELETE FROM episodes WHERE castid = ?" [toSql (castid podcast)]
         run dbh "DELETE FROM podcasts WHERE castid = ?" [toSql (castid podcast)]
         return ()
  
  getPodcasts :: Connection -> IO [Podcast]
  getPodcasts dbh =
      do res <- quickQuery dbh "SELECT castid, castname, feedurl, pcenabled,\
                \lastupdate, lastattempt, failedattempts \
                \FROM podcasts ORDER BY castid" []
         return $ map podcast_convrow res
  
  getPodcast :: Connection -> Integer -> IO [Podcast]
  getPodcast dbh wantedid =
      do res <- quickQuery dbh "SELECT castid, castname, feedurl, pcenabled,\
                \lastupdate, lastattempt, failedattempts \
                \FROM podcasts WHERE castid = ? ORDER BY castid" [toSql wantedid]
         return $ map podcast_convrow res
  
  getEpisodes :: Connection -> Podcast -> IO [Episode]
  getEpisodes dbh pc =
      do r <- quickQuery dbh "SELECT episodeid, title, epurl, enctype,\
                              \status, eplength, epfirstattempt, eplastattempt, \
                              \epfailedattempts, epguid FROM episodes \
                              \WHERE castid = ? ORDER BY \
                              \episodeid" [toSql (castid pc)]
         return $ map toItem r
      where toItem [sepid, stitle, sepurl, senctype, sstatus, slength,
                    slu, sla, sfa, sepguid] =
                Episode {podcast = pc, epid = fromSql sepid,
                         eptitle = fromSql stitle,
                         epurl = fromSql sepurl, eptype = fromSql senctype,
                         epstatus = read (fromSql sstatus),
                         eplength = fromSql slength,
                         epfirstattempt = fromSql slu,
                         eplastattempt = fromSql sla,
                         epfailedattempts = fromSql sfa,
                         epguid = fromSql sepguid}
            toItem x = error $ "Unexpected result in getEpisodes: " ++ show x
  
  podcast_convrow [svid, svname, svurl, isenabled, lupdate, lattempt,
                   fattempts] =
      Podcast {castid = fromSql svid, castname = fromSql svname,
               feedurl = fromSql svurl, pcenabled = toEnum . fromSql $ isenabled,
               lastupdate = fromSql lupdate, lastattempt = fromSql lattempt,
               failedattempts = fromSql fattempts}
  
  {- | Add a new episode. If the episode already exists, based solely on
  looking at the GUID (if present), update the URL and title fields while 
  preserving other fields as they are. Returns the number of inserted rows. -}
  addEpisode :: Connection -> Episode -> IO Integer
  addEpisode dbh ep = 
      do 
         -- We have to be careful of cases where a feed may have two
         -- different episodes with different GUIDs but identical URLs.
         -- So if we have a GUID match here, we must have a conflict on URL,
         -- so we ignore the request to change it.
         when (epguid ep /= Nothing) $
            do run dbh "UPDATE OR IGNORE episodes SET epurl = ?, epguid = ?, title = ? \
                    \WHERE castid = ? AND epguid = ?"
                   [toSql (epurl ep), toSql (epguid ep), toSql (eptitle ep),
                    toSql (castid (podcast ep)), toSql (epguid ep)]
               return ()
         -- if the UPDATE was successful, that means that something with the same
         -- URL or GUID already exists, so the INSERT below will be ignored.
         dbdebug "update done"
         nextepid <- getepid
         dbdebug $ "addEpisode: epid: " ++ show nextepid
         dbdebug "addEpisode: running insertEpisode"
         insertEpisode "INSERT OR IGNORE" dbh ep nextepid
      where getepid = 
                do r <- quickQuery dbh "SELECT MAX(episodeid) FROM episodes WHERE castid = ?" [toSql (castid (podcast ep))]
                   case r of
                     [[SqlNull]] -> return 1
                     [[x]] -> return ((fromSql x) + (1::Int))
                     _ -> fail "Unexpected response in getepid"
  
  {- | Update an episode.  If it doesn't already exist, create it. -}
  updateEpisode :: Connection -> Episode -> IO Integer
  updateEpisode dbh ep = insertEpisode "INSERT OR REPLACE" dbh ep (epid ep)
  
  insertEpisode insertsql dbh episode newepid =
      run dbh (insertsql ++ " INTO episodes (castid, episodeid, title,\
             \epurl, enctype, status, eplength, epfirstattempt, eplastattempt,\
             \epfailedattempts, epguid) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)")
             [toSql (castid (podcast episode)), toSql newepid, 
              toSql (eptitle episode), toSql (epurl episode), 
              toSql (eptype episode), toSql (show (epstatus episode)),
              toSql (eplength episode), toSql (epfirstattempt episode),
              toSql (eplastattempt episode), toSql (epfailedattempts episode),
              toSql (epguid episode)]
  
  getSelectedPodcasts dbh [] = getSelectedPodcasts dbh ["all"]
  getSelectedPodcasts dbh ["all"] = getPodcasts dbh
  getSelectedPodcasts dbh podcastlist =
      do r <- mapM (getPodcast dbh) (map read podcastlist)
         return $ uniq $ concat r
  
  getSelectedEpisodes :: Connection -> Podcast -> [String] -> IO [Episode]
  getSelectedEpisodes _ _ [] = return []
  getSelectedEpisodes dbh pc ["all"] = getEpisodes dbh pc
  getSelectedEpisodes dbh pc episodelist =
      do eps <- getEpisodes dbh pc
         return $ uniq . filter (\e -> (epid e `elem` eplist)) $ eps
      where eplist = map read episodelist
  