23_a_2: Add solution

6 files changed, 133 insertions, 42 deletions

diff --git a/README.md b/README.md
index db95f95..2253d19 100644
--- a/README.md
+++ b/README.md
@@ -185,7 +185,7 @@ are prefixed with 'Module_'.
 | 19_b_2         | yes    |      | |
 | 19_b_3         | yes, in 19_b_2  |      | |
 | **_23_a_1_**   | yes    | 529  | 23. GUI programming with gtk2hs|
-| 23_a_2         |        |      | |
+| 23_a_2         | yes, in 23_a_1  |      | |
 | 23_a_3         |        |      | |
 | **_24_a_1_**   |        | 542  | 24. Concurrent and multicore programming |
 | 24_a_2         |        |      | |
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 --}