[Item parsing (untested) Manuel M T Chakravarty **20060426033923] { hunk ./LambdaFeed.hs 66 --- URLs. +-- URLs, same for email addresses. hunk ./LambdaFeed.hs 85 - fromJust) + isNothing, fromJust) hunk ./LambdaFeed.hs 130 - debugCfg :: Bool, + debugCfg :: Int, hunk ./LambdaFeed.hs 139 - debugCfg = False, + debugCfg = 0, hunk ./LambdaFeed.hs 159 - "produces extra diagnostic output" + "produces extra diagnostic output; repeat for more" hunk ./LambdaFeed.hs 215 - return $ config {debugCfg = True} + return $ config {debugCfg = debugCfg config + 1} hunk ./LambdaFeed.hs 489 - isPermaLink :: Bool, - guidGUID :: String + guidGUID :: String, + isPermaLinkGUID :: Maybe Bool hunk ./LambdaFeed.hs 497 - urlSource :: URL, - sourceSource :: String + sourceSource :: String, + urlSource :: URL hunk ./LambdaFeed.hs 591 +-- Enclosure value with default components.. +-- +defaultEnclosure :: Enclosure +defaultEnclosure = Enclosure { + urlEnclosure = error "enclosure missing url", + lengthEnclosure = error "enclosure missing length", + typeEnclosure = error "enclosure missing type" + } + +-- GUID value with default components.. +-- +defaultGUID :: GUID +defaultGUID = GUID { + guidGUID = error "guid missing guid", + isPermaLinkGUID = Nothing + } + +-- GUID value with default components.. +-- +defaultSource :: Source +defaultSource = Source { + sourceSource = error "source missing source", + urlSource = error "source missing url" + } + + hunk ./LambdaFeed.hs 641 - sayD config $ show chanDescs + sayD config 1 $ show chanDescs hunk ./LambdaFeed.hs 648 +-- * We interpret the `itemsChan' file path relative to path from which we +-- read the channel description (unless it is already absolute). +-- hunk ./LambdaFeed.hs 655 - currTime <- getClockTime hunk ./LambdaFeed.hs 657 - return $ chan {lastBuildDateChan = Just $ Date currTime} + currTime <- getClockTime + return $ chan { + lastBuildDateChan = Just $ Date currTime, + itemsChan = dirname fname itemsChan chan + -- adjust path to item files + } hunk ./LambdaFeed.hs 681 + -- + sayD config 2 $ show items + -- hunk ./LambdaFeed.hs 689 -readItem = undefined +readItem config fname = + do + text <- readStanzas fname + let (chan, errs) = parseItem fname text + mapM (say config) errs + return chan hunk ./LambdaFeed.hs 715 --- (without any items) and the name of the directory containing the channels +-- in the flavour that the name of the directory containing the channel's hunk ./LambdaFeed.hs 860 +-- Parse an item, returning our internal item representation. +-- +-- * The first argument is to identify the source in error messages. +-- +-- * It's a fatal error if there is neither a title nor a description. +-- Otherwise, errors are not fatal (parsing will still have produced a valid +-- channel descriptor, although may be not exactly what the user intended). +-- +parseItem :: String -> [Stanza] -> (Item, [String]) +parseItem sname stanzas = + case parseStanzas itemProc sname stanzas defaultItem of + (Nothing , errs) -> error "parseItem: Impossible" -- no required items + (Just item, errs) + | isNothing (titleItem item) && isNothing (descriptionItem item) -> + abortWith [sname ++ ": an item must have a title or description"] + | otherwise -> (item, errs) + where + itemProc = + -- optional elements + [ ("title", Proc False $ Simple $ + cantFail $ \v c -> c {titleItem = Just v} + ) + , ("link", Proc False $ Simple $ + cantFail $ \v c -> c {linkItem = Just v} + ) + , ("description", Proc True $ Simple $ + cantFail $ \v c -> c {descriptionItem = Just v} + ) + , ("author", Proc False $ Simple $ + cantFail $ \v c -> c {authorItem = Just v} + ) + , ("category", Proc False $ Compound $ + cantFailStanza parseCategory $ + \v c -> c {categoryItem = categoryItem c ++ [v]} + ) + , ("comments", Proc False $ Simple $ + cantFail $ \v c -> c {commentsItem = Just v} + ) + , ("enclosure", Proc False $ Compound $ + mayFailStanza parseEnclosure $ \v c -> c {enclosureItem = v} + ) + , ("guid", Proc False $ Compound $ + mayFailStanza parseGUID $ \v c -> c {guidItem = v} + ) + , ("pubdate", Proc False $ Simple $ + mayFail parseDate "bad date format (see RSS 2.0 spec)" $ + \v c -> c {pubDateItem = Just v} + ) + , ("source", Proc False $ Compound $ + mayFailStanza parseSource $ \v c -> c {sourceItem = v} + ) + ] + -- + mayFail = mayFailS sname + mayFailStanza = mayFailStanzaS sname + +-- Parse an enclosure element. +-- +parseEnclosure :: String -> Stanza -> (Maybe Enclosure, [String]) +parseEnclosure sname stanza@((_, (start, end), _):_) = + parseStanzas enclosureProc extendedSName [stanza] defaultEnclosure + where + enclosureProc = + -- required elements + [ ("enclosure", Proc True $ Simple $ + mayFail parseNull "enclosure tag can have no value" $ + \v i -> i -- enclosure tag itself has no data + ) + , ("url", Proc True $ Simple $ + cantFail $ \v i -> i {urlEnclosure = v} + ) + , ("length", Proc True $ Simple $ + mayFail parseNat "positive integer expected" $ + \v i -> i {lengthEnclosure = v} + ) + , ("type", Proc True $ Simple $ + cantFail $ \v i -> i {typeEnclosure = v} + ) + ] + -- + mayFail = mayFailS sname + -- + extendedSName = sname ++ ":" ++ show start ++ "-" ++ show end ++ + ": enclosure" + +-- Parse a guid element. +-- +parseGUID :: String -> Stanza -> (Maybe GUID, [String]) +parseGUID sname stanza@((_, (start, end), _):_) = + parseStanzas guidProc extendedSName [stanza] defaultGUID + where + guidProc = + -- required elements + [ ("guid", Proc True $ Simple $ + cantFail $ \v i -> i {guidGUID = v} + ) + -- optional elements + , ("ispermalink", Proc False $ Simple $ + mayFail parseBool "true or false expected" $ + \v i -> i {isPermaLinkGUID = Just v} + ) + ] + -- + mayFail = mayFailS sname + -- + extendedSName = sname ++ ":" ++ show start ++ "-" ++ show end ++ + ": guid" + +-- Parse a source element. +-- +parseSource :: String -> Stanza -> (Maybe Source, [String]) +parseSource sname stanza@((_, (start, end), _):_) = + parseStanzas sourceProc extendedSName [stanza] defaultSource + where + sourceProc = + -- required elements + [ ("source", Proc True $ Simple $ + cantFail $ \v i -> i {sourceSource = v} + ) + , ("url", Proc True $ Simple $ + cantFail $ \v i -> i {urlSource = v} + ) + ] + -- + extendedSName = sname ++ ":" ++ show start ++ "-" ++ show end ++ + ": source" + hunk ./LambdaFeed.hs 993 +-- Parse a Boolean. +-- +parseBool :: String -> Maybe Bool +parseBool str | strLower == "true" = Just True + | strLower == "false" = Just False + | otherwise = Nothing + where strLower = map toLower str + hunk ./LambdaFeed.hs 1242 --- Filename operations +-- Filename operations (this stuff won't work on win32) hunk ./LambdaFeed.hs 1245 --- Split the suffix of a filename. +-- Project the suffix from a filename. hunk ./LambdaFeed.hs 1250 --- Join a directory and file path. +-- Drop the file name of a path. +-- +dirname :: FilePath -> String +dirname = reverse . dropWhile (/= '/') . reverse + +-- Join a directory and file path. If the file path is already absolute, +-- ignore the directory argument. hunk ./LambdaFeed.hs 1259 -dir fname | null dir = fname - | last dir == '/' = dir ++ fname - | otherwise = dir ++ "/" ++ fname +"" fname = fname +dir "" = dir +dir fname | head fname == '/' = fname + | last dir == '/' = dir ++ fname + | otherwise = dir ++ "/" ++ fname hunk ./LambdaFeed.hs 1283 -sayD :: Config -> String -> IO () -sayD config str | debugCfg config = putStrLn str - | otherwise = return () +sayD :: Config -> Int -> String -> IO () +sayD config lvl str | debugCfg config >= lvl = putStrLn str + | otherwise = return () }