From 36fc1e924d6920629d764d934e8939a48ac1ff0f Mon Sep 17 00:00:00 2001
From: Jan Sucan <jan@jansucan.com>
Date: Fri, 12 Sep 2025 09:33:50 +0200
Subject: 23_a_1: Patch the code for compiling with GHC from support of this
 chapter

---
 ch23/23_a_1/PodMainGUI.hs |  4 ++--
 ch23/23_a_1/PodParser.hs  | 35 ++++++++++++++++++++---------------
 2 files changed, 22 insertions(+), 17 deletions(-)

(limited to 'ch23/23_a_1')

diff --git a/ch23/23_a_1/PodMainGUI.hs b/ch23/23_a_1/PodMainGUI.hs
index 943be01..e557d8b 100644
--- a/ch23/23_a_1/PodMainGUI.hs
+++ b/ch23/23_a_1/PodMainGUI.hs
@@ -119,7 +119,7 @@ guiAdd gui dbh =
     where procOK =
               do url <- entryGetText (awEntry gui)
                  widgetHide (addWin gui) -- Remove the dialog
-                 add dbh url             -- Add to the DB
+                 addUrl dbh url             -- Add to the DB
 {-- /snippet guiAdd --}
 
 {-- snippet statusWindow --}
@@ -184,7 +184,7 @@ guiFetch gui dbh =
 {-- /snippet statusWindowFuncs --}
 
 {-- snippet workerFuncs --}
-add dbh url = 
+addUrl dbh url = 
     do addPodcast dbh pc
        commit dbh
     where pc = Podcast {castId = 0, castURL = url}
diff --git a/ch23/23_a_1/PodParser.hs b/ch23/23_a_1/PodParser.hs
index 2ec1a17..cc0ac3b 100644
--- a/ch23/23_a_1/PodParser.hs
+++ b/ch23/23_a_1/PodParser.hs
@@ -5,6 +5,8 @@ import PodTypes
 import Text.XML.HaXml
 import Text.XML.HaXml.Parse
 import Text.XML.HaXml.Html.Generate(showattr)
+import Text.XML.HaXml.Posn
+import Text.XML.HaXml.Util
 import Data.Char
 import Data.List
 
@@ -35,8 +37,8 @@ parse content name =
     where parseResult = xmlParse name (stripUnicodeBOM content)
           doc = getContent parseResult
 
-          getContent :: Document -> Content
-          getContent (Document _ _ e _) = CElem e
+          getContent :: Document Posn -> Content Posn
+          getContent d = docContent (posInNewCxt name Nothing) d
           
           {- | Some Unicode documents begin with a binary sequence;
              strip it off before processing. -}
@@ -50,36 +52,36 @@ Note that HaXml defines CFilter as:
 
 > type CFilter = Content -> [Content]
 -}
-channel :: CFilter
+channel :: CFilter Posn
 channel = tag "rss" /> tag "channel"
 
-getTitle :: Content -> String
+getTitle :: Content Posn -> String
 getTitle doc =
     contentToStringDefault "Untitled Podcast" 
         (channel /> tag "title" /> txt $ doc)
 
-getEnclosures :: Content -> [Item]
+getEnclosures :: Content Posn -> [Item]
 getEnclosures doc =
     concatMap procItem $ getItems doc
-    where procItem :: Content -> [Item]
+    where procItem :: Content Posn -> [Item]
           procItem item = concatMap (procEnclosure title) enclosure
               where title = contentToStringDefault "Untitled Episode"
                                (keep /> tag "title" /> txt $ item)
                     enclosure = (keep /> tag "enclosure") item
 
-          getItems :: CFilter
+          getItems :: CFilter Posn
           getItems = channel /> tag "item"
 
-          procEnclosure :: String -> Content -> [Item]
+          procEnclosure :: String -> Content Posn -> [Item]
           procEnclosure title enclosure =
               map makeItem (showattr "url" enclosure)
-              where makeItem :: Content -> Item
+              where makeItem :: Content Posn -> Item
                     makeItem x = Item {itemtitle = title,
                                        enclosureurl = contentToString [x]}
 
 {- | Convert [Content] to a printable String, with a default if the 
 passed-in [Content] is [], signifying a lack of a match. -}
-contentToStringDefault :: String -> [Content] -> String
+contentToStringDefault :: String -> [Content Posn] -> String
 contentToStringDefault msg [] = msg
 contentToStringDefault _ x = contentToString x
 
@@ -92,15 +94,18 @@ An implementation without unescaping would simply be:
 Because HaXml's unescaping only works on Elements, we must make sure that
 whatever Content we have is wrapped in an Element, then use txt to
 pull the insides back out. -}
-contentToString :: [Content] -> String
+contentToString :: [Content Posn] -> String
 contentToString = 
     concatMap procContent
     where procContent x = 
-              verbatim $ keep /> txt $ CElem (unesc (fakeElem x))
+              verbatim $ keep /> txt $ CElem (unesc (fakeElem x)) fakePosn
 
-          fakeElem :: Content -> Element
-          fakeElem x = Elem "fake" [] [x]
+          fakeElem :: Content Posn -> Element Posn
+          fakeElem x = Elem (N "fake") [] [x]
 
-          unesc :: Element -> Element
+          fakePosn :: Posn
+          fakePosn = (posInNewCxt "fakeName" Nothing)
+
+          unesc :: Element Posn -> Element Posn
           unesc = xmlUnEscape stdXmlEscaper
 {-- /snippet all --}
-- 
cgit v1.2.3