From 9d89965b0661d1968151d9b646148b6a71209705 Mon Sep 17 00:00:00 2001 From: Jan Sucan Date: Sun, 14 Sep 2025 17:10:23 +0200 Subject: 23_a_2: Add solution --- ch23/23_a_1/23_a_1.txt | 60 ++++++++++++++++++++++++++++++++++++++++++++- ch23/23_a_1/PodLocalMain.hs | 7 ------ ch23/23_a_1/PodMain.hs | 37 ++++++++++++++++++++++++++++ ch23/23_a_1/PodMainCLI.hs | 31 +++++++++++++++++++++++ ch23/23_a_1/PodMainGUI.hs | 38 ++++------------------------ 5 files changed, 132 insertions(+), 41 deletions(-) delete mode 100644 ch23/23_a_1/PodLocalMain.hs create mode 100644 ch23/23_a_1/PodMain.hs create mode 100644 ch23/23_a_1/PodMainCLI.hs (limited to 'ch23') diff --git a/ch23/23_a_1/23_a_1.txt b/ch23/23_a_1/23_a_1.txt index 7b594a0..7de697d 100644 --- a/ch23/23_a_1/23_a_1.txt +++ b/ch23/23_a_1/23_a_1.txt @@ -1 +1,59 @@ -Present a helpful GUI error message if the call to xmlNew returns Nothing. +1. Present a helpful GUI error message if the call to xmlNew returns Nothing. + +2. Modify the podcatcher to be able to run with either the GUI or the + command-line interface from a single code base. Hint: move common code out of + PodMainGUI.hs, then have two different Main modules, one for the GUI, and one + for the command line. + + + + +Testing 1.: + Steps: + - Compile PodMainGUI + - Remove podresources.glade file + - Run PodMainGUI + Result: + - Error dialog window informing that podresources.glade file has not been + found is displayed + + +Testing 2.: + Steps: + - Compile PodMainGUI + - Run PodMainGUI + - Add a podcast + - Click Update + - Click Download + Result: + - The mp3 files have been downloaded + + Steps: + - Exit PodMainGUI + - Remove pod.db file + - Remove the mp3 files + - Run PodMainGUI + - Add a podcast + - Click Fetch + Result: + - The mp3 files have been downloaded + + Steps: + - Exit PodMainGUI + - Compile PodMainCLI + - Run PodMainCLI + - Add a podcast + - Run Update + - Run Download + Result: + - The mp3 files have been downloaded + + Steps: + - Exit PodMainCLI + - Remove pod.db file + - Remove the mp3 files + - Run PodMainCLI + - Add a podcast + - Run Fetch + Result: + - The mp3 files have been downloaded diff --git a/ch23/23_a_1/PodLocalMain.hs b/ch23/23_a_1/PodLocalMain.hs deleted file mode 100644 index 94bd963..0000000 --- a/ch23/23_a_1/PodLocalMain.hs +++ /dev/null @@ -1,7 +0,0 @@ -{-- snippet all --} -module Main where - -import qualified PodMainGUI - -main = PodMainGUI.main "podresources.glade" -{-- /snippet all --} diff --git a/ch23/23_a_1/PodMain.hs b/ch23/23_a_1/PodMain.hs new file mode 100644 index 0000000..5e58ec4 --- /dev/null +++ b/ch23/23_a_1/PodMain.hs @@ -0,0 +1,37 @@ +{-- snippet imports --} +module PodMain where + +import PodDownload +import PodDB +import PodTypes +import Database.HDBC + +{-- snippet workerFuncs --} +addUrl dbh url = + do addPodcast dbh pc + commit dbh + where pc = Podcast {castId = 0, castURL = url} + +update :: IConnection conn => conn -> (String -> IO ()) -> IO () +update dbh logf = + do pclist <- getPodcasts dbh + mapM_ procPodcast pclist + logf "Update complete." + where procPodcast pc = + do logf $ "Updating from " ++ (castURL pc) + updatePodcastFromFeed dbh pc + +download dbh logf = + do pclist <- getPodcasts dbh + mapM_ procPodcast pclist + logf "Download complete." + where procPodcast pc = + do logf $ "Considering " ++ (castURL pc) + episodelist <- getPodcastEpisodes dbh pc + let dleps = filter (\ep -> epDone ep == False) + episodelist + mapM_ procEpisode dleps + procEpisode ep = + do logf $ "Downloading " ++ (epURL ep) + getEpisode dbh ep +{-- /snippet workerFuncs --} diff --git a/ch23/23_a_1/PodMainCLI.hs b/ch23/23_a_1/PodMainCLI.hs new file mode 100644 index 0000000..ed26430 --- /dev/null +++ b/ch23/23_a_1/PodMainCLI.hs @@ -0,0 +1,31 @@ +{-- From examples/examples/ch22/PodMain.hs and modified --} +module Main where + +import PodMain +import PodDownload +import PodDB +import PodTypes +import System.Environment +import Database.HDBC +import Network.Socket(withSocketsDo) + +main = withSocketsDo $ handleSqlError $ + do args <- getArgs + dbh <- connect "pod.db" + case args of + ["add", url] -> addUrl dbh url + ["update"] -> update dbh putStrLn + ["download"] -> download dbh putStrLn + ["fetch"] -> do update dbh putStrLn + download dbh putStrLn + _ -> syntaxError + disconnect dbh + +syntaxError = putStrLn + "Usage: pod command [args]\n\ + \\n\ + \pod add url Adds a new podcast with the given URL\n\ + \pod download Downloads all pending episodes\n\ + \pod fetch Updates, then downloads\n\ + \pod update Downloads podcast feeds, looks for new episodes\n" +{-- End of code from examples --} diff --git a/ch23/23_a_1/PodMainGUI.hs b/ch23/23_a_1/PodMainGUI.hs index 6c7190d..b9badf3 100644 --- a/ch23/23_a_1/PodMainGUI.hs +++ b/ch23/23_a_1/PodMainGUI.hs @@ -1,6 +1,7 @@ {-- snippet imports --} -module PodMainGUI where +module Main where +import PodMain import PodDownload import PodDB import PodTypes @@ -39,8 +40,9 @@ data GUI = GUI { {-- /snippet type --} {-- snippet main --} -main :: FilePath -> IO () -main gladepath = withSocketsDo $ handleSqlError $ +gladepath = "podresources.glade" + +main = withSocketsDo $ handleSqlError $ do initGUI -- Initialize GTK+ engine -- Every so often, we try to run other threads. @@ -193,33 +195,3 @@ guiFetch gui dbh = statusWindow gui dbh "Pod: Fetch" (\logf -> update dbh logf >> download dbh logf) {-- /snippet statusWindowFuncs --} - -{-- snippet workerFuncs --} -addUrl dbh url = - do addPodcast dbh pc - commit dbh - where pc = Podcast {castId = 0, castURL = url} - -update :: IConnection conn => conn -> (String -> IO ()) -> IO () -update dbh logf = - do pclist <- getPodcasts dbh - mapM_ procPodcast pclist - logf "Update complete." - where procPodcast pc = - do logf $ "Updating from " ++ (castURL pc) - updatePodcastFromFeed dbh pc - -download dbh logf = - do pclist <- getPodcasts dbh - mapM_ procPodcast pclist - logf "Download complete." - where procPodcast pc = - do logf $ "Considering " ++ (castURL pc) - episodelist <- getPodcastEpisodes dbh pc - let dleps = filter (\ep -> epDone ep == False) - episodelist - mapM_ procEpisode dleps - procEpisode ep = - do logf $ "Downloading " ++ (epURL ep) - getEpisode dbh ep -{-- /snippet workerFuncs --} -- cgit v1.2.3