feed 0.3.9.3 → 0.3.9.4
raw patch · 51 files changed
+5677/−5631 lines, 51 filesdep +HUnitdep +feeddep +test-frameworkdep ~basedep ~old-localedep ~old-timePVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependencies added: HUnit, feed, test-framework, test-framework-hunit
Dependency ranges changed: base, old-locale, old-time, time, utf8-string, xml
API changes (from Hackage documentation)
+ Paths_feed: getBinDir :: IO FilePath
+ Paths_feed: getDataDir :: IO FilePath
+ Paths_feed: getDataFileName :: FilePath -> IO FilePath
+ Paths_feed: getLibDir :: IO FilePath
+ Paths_feed: getLibexecDir :: IO FilePath
+ Paths_feed: getSysconfDir :: IO FilePath
+ Paths_feed: version :: Version
Files
- CHANGELOG.md +26/−0
- CHANGES +0/−21
- README.md +6/−0
- Text/Atom/Feed.hs +0/−264
- Text/Atom/Feed/Export.hs +0/−272
- Text/Atom/Feed/Import.hs +0/−263
- Text/Atom/Feed/Link.hs +0/−81
- Text/Atom/Feed/Validate.hs +0/−295
- Text/Atom/Pub.hs +0/−47
- Text/Atom/Pub/Export.hs +0/−88
- Text/DublinCore/Types.hs +0/−82
- Text/Feed/Constructor.hs +0/−726
- Text/Feed/Export.hs +0/−36
- Text/Feed/Import.hs +0/−94
- Text/Feed/Query.hs +0/−427
- Text/Feed/Translate.hs +0/−134
- Text/Feed/Types.hs +0/−49
- Text/Feed/Util.hs +0/−26
- Text/RSS/Export.hs +0/−173
- Text/RSS/Import.hs +0/−277
- Text/RSS/Syntax.hs +0/−293
- Text/RSS1/Export.hs +0/−194
- Text/RSS1/Import.hs +0/−247
- Text/RSS1/Syntax.hs +0/−219
- Text/RSS1/Utils.hs +0/−113
- feed.cabal +79/−49
- src/Text/Atom/Feed.hs +264/−0
- src/Text/Atom/Feed/Export.hs +272/−0
- src/Text/Atom/Feed/Import.hs +263/−0
- src/Text/Atom/Feed/Link.hs +81/−0
- src/Text/Atom/Feed/Validate.hs +295/−0
- src/Text/Atom/Pub.hs +47/−0
- src/Text/Atom/Pub/Export.hs +88/−0
- src/Text/DublinCore/Types.hs +82/−0
- src/Text/Feed/Constructor.hs +726/−0
- src/Text/Feed/Export.hs +36/−0
- src/Text/Feed/Import.hs +94/−0
- src/Text/Feed/Query.hs +427/−0
- src/Text/Feed/Translate.hs +134/−0
- src/Text/Feed/Types.hs +49/−0
- src/Text/Feed/Util.hs +26/−0
- src/Text/RSS/Export.hs +173/−0
- src/Text/RSS/Import.hs +277/−0
- src/Text/RSS/Syntax.hs +293/−0
- src/Text/RSS1/Export.hs +194/−0
- src/Text/RSS1/Import.hs +247/−0
- src/Text/RSS1/Syntax.hs +219/−0
- src/Text/RSS1/Utils.hs +113/−0
- tests/Main.hs +13/−8
- tests/files/rss20.xml +1153/−0
- tests/rss20.xml +0/−1153
+ CHANGELOG.md view
@@ -0,0 +1,26 @@+#### 0.3.9.4++* Update maintainer information+* Add test suite++#### 0.3.9.3++* Add support for utf8-string >= 1 && < 1.1 and time 1.5.*++#### 0.3.9.1++* add ref to github repo + .cabal tidying.++### 0.3.9++* tidy up compilation with ghc-7.6(.3), bumped version (but no+ functional changes.)++### 0.3.8++* cabal build fixes.++### 0.3.7++* <feed> parsing: made <title> be optional.+* <entry> parsing: try <published> if <updated> is missing.
− CHANGES
@@ -1,21 +0,0 @@-Version 0.3.9.3:--* Add support for utf8-string >= 1 && < 1.1 and time 1.5.*--Version 0.3.9.1:-- * add ref to github repo + .cabal tidying.--Version 0.3.9:-- * tidy up compilation with ghc-7.6(.3), bumped version- (but no functional changes.)--Version 0.3.8:-- * cabal build fixes.--Version 0.3.7:-- * <feed> parsing: made <title> be optional.- * <entry> parsing: try <published> if <updated> is missing.
+ README.md view
@@ -0,0 +1,6 @@+Interfacing with RSS (v 0.9x, 2.x, 1.0) + Atom feeds.++To help working with the multiple feed formats we've ended up with,+this set of modules provides parsers, pretty printers and some utility+code for querying and just generally working with a concrete+representation of feeds in Haskell.
− Text/Atom/Feed.hs
@@ -1,264 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.Atom.Feed--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability: portable--------------------------------------------------------------------------module Text.Atom.Feed where--import qualified Text.XML.Light as XML---- *Core types---- NOTE: In the future we may want to have more structured--- types for these.-type URI = String-type NCName = String-type Date = String-type MediaType = String--data Feed- = Feed- { feedId :: String- , feedTitle :: TextContent- , feedUpdated :: Date- , feedAuthors :: [Person]- , feedCategories :: [Category]- , feedContributors :: [Person]- , feedGenerator :: Maybe Generator- , feedIcon :: Maybe URI- , feedLinks :: [Link]- , feedLogo :: Maybe URI- , feedRights :: Maybe TextContent- , feedSubtitle :: Maybe TextContent- , feedEntries :: [Entry]- , feedAttrs :: [XML.Attr]- , feedOther :: [XML.Element]- }- deriving (Show)--data Entry- = Entry- { entryId :: String- , entryTitle :: TextContent- , entryUpdated :: Date- , entryAuthors :: [Person]- , entryCategories :: [Category]- , entryContent :: Maybe EntryContent- , entryContributor :: [Person]- , entryLinks :: [Link]- , entryPublished :: Maybe Date- , entryRights :: Maybe TextContent- , entrySource :: Maybe Source- , entrySummary :: Maybe TextContent- , entryInReplyTo :: Maybe InReplyTo- , entryInReplyTotal :: Maybe InReplyTotal- , entryAttrs :: [XML.Attr]- , entryOther :: [XML.Element]- }- deriving (Show)--data EntryContent- = TextContent String- | HTMLContent String- | XHTMLContent XML.Element- | MixedContent (Maybe String) [XML.Content]- | ExternalContent (Maybe MediaType) URI- deriving (Show)--data Category- = Category- { catTerm :: String -- ^ the tag\/term of the category.- , catScheme :: Maybe URI -- ^ optional URL for identifying the categorization scheme.- , catLabel :: Maybe String -- ^ human-readable label of the category- , catOther :: [XML.Element] -- ^ unknown elements, for extensibility.- }- deriving (Show)---data Generator- = Generator- { genURI :: Maybe URI- , genVersion :: Maybe String- , genText :: String- }- deriving (Eq, Show)--data Link- = Link- { linkHref :: URI- -- ToDo: make the switch over to using the Atom.Feed.Link relation type.- , linkRel :: Maybe (Either NCName URI)- , linkType :: Maybe MediaType- , linkHrefLang :: Maybe String- , linkTitle :: Maybe String- , linkLength :: Maybe String- , linkAttrs :: [XML.Attr]- , linkOther :: [XML.Element]- }- deriving (Show)--data TextContent- = TextString String- | HTMLString String- | XHTMLString XML.Element- deriving (Show)--txtToString :: TextContent -> String-txtToString (TextString s) = s-txtToString (HTMLString s) = s-txtToString (XHTMLString x) = show x--data Source- = Source- { sourceAuthors :: [Person]- , sourceCategories :: [Category]- , sourceGenerator :: Maybe Generator- , sourceIcon :: Maybe URI- , sourceId :: Maybe String- , sourceLinks :: [Link]- , sourceLogo :: Maybe URI- , sourceRights :: Maybe TextContent- , sourceSubtitle :: Maybe TextContent- , sourceTitle :: Maybe TextContent- , sourceUpdated :: Maybe Date- , sourceOther :: [XML.Element]- }- deriving (Show)---data Person- = Person- { personName :: String- , personURI :: Maybe URI- , personEmail :: Maybe String- , personOther :: [XML.Element]- }- deriving (Show)--data InReplyTo- = InReplyTo- { replyToRef :: URI- , replyToHRef :: Maybe URI- , replyToType :: Maybe MediaType- , replyToSource :: Maybe URI- , replyToOther :: [XML.Attr]- , replyToContent :: [XML.Content]- }- deriving (Show)--data InReplyTotal- = InReplyTotal- { replyToTotal :: Integer -- non-negative :)- , replyToTotalOther :: [XML.Attr]- }- deriving (Show)---- *Smart Constructors--newCategory :: String -- ^catTerm- -> Category-newCategory t = Category- { catTerm = t- , catScheme = Nothing- , catLabel = Just t- , catOther = []- }--nullFeed :: String -- ^feedId- -> TextContent -- ^feedTitle- -> Date -- ^feedUpdated- -> Feed-nullFeed i t u = Feed- { feedId = i- , feedTitle = t- , feedUpdated = u- , feedAuthors = []- , feedCategories = []- , feedContributors = []- , feedGenerator = Nothing- , feedIcon = Nothing- , feedLinks = []- , feedLogo = Nothing- , feedRights = Nothing- , feedSubtitle = Nothing- , feedEntries = []- , feedAttrs = []- , feedOther = []- }--nullEntry :: String -- ^entryId- -> TextContent -- ^entryTitle- -> Date -- ^entryUpdated- -> Entry-nullEntry i t u = Entry- { entryId = i- , entryTitle = t- , entryUpdated = u- , entryAuthors = []- , entryCategories = []- , entryContent = Nothing- , entryContributor = []- , entryLinks = []- , entryPublished = Nothing- , entryRights = Nothing- , entrySource = Nothing- , entrySummary = Nothing- , entryInReplyTo = Nothing- , entryInReplyTotal = Nothing- , entryAttrs = []- , entryOther = []- }---nullGenerator :: String -- ^genText- -> Generator-nullGenerator t = Generator- { genURI = Nothing- , genVersion = Nothing- , genText = t- }--nullLink :: URI -- ^linkHref- -> Link-nullLink uri = Link- { linkHref = uri- , linkRel = Nothing- , linkType = Nothing- , linkHrefLang = Nothing- , linkTitle = Nothing- , linkLength = Nothing- , linkAttrs = []- , linkOther = []- }--nullSource :: Source-nullSource = Source- { sourceAuthors = []- , sourceCategories = []- , sourceGenerator = Nothing- , sourceIcon = Nothing- , sourceId = Nothing- , sourceLinks = []- , sourceLogo = Nothing- , sourceRights = Nothing- , sourceSubtitle = Nothing- , sourceTitle = Nothing- , sourceUpdated = Nothing- , sourceOther = []- }--nullPerson :: Person-nullPerson = Person- { personName = ""- , personURI = Nothing- , personEmail = Nothing- , personOther = []- }
− Text/Atom/Feed/Export.hs
@@ -1,272 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.Atom.Feed.Export--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability:: portable--- Description: Convert from Atom to XML------ Convert from Atom to XML---------------------------------------------------------------------------module Text.Atom.Feed.Export where--import Text.XML.Light as XML-import Text.Atom.Feed--atom_prefix :: Maybe String-atom_prefix = Nothing -- Just "atom"--atom_thr_prefix :: Maybe String-atom_thr_prefix = Just "thr"--atomNS :: String-atomNS = "http://www.w3.org/2005/Atom"--atomThreadNS :: String-atomThreadNS = "http://purl.org/syndication/thread/1.0"--xmlns_atom :: Attr-xmlns_atom = Attr qn atomNS- where- qn = case atom_prefix of- Nothing -> QName { qName = "xmlns"- , qURI = Nothing- , qPrefix = Nothing- }- Just s -> QName { qName = s- , qURI = Nothing -- XXX: is this ok?- , qPrefix = Just "xmlns"- }--xmlns_atom_thread :: Attr-xmlns_atom_thread = Attr qn atomThreadNS- where- qn = case atom_prefix of- Nothing -> QName { qName = "xmlns"- , qURI = Nothing- , qPrefix = Nothing- }- Just s -> QName { qName = s- , qURI = Nothing -- XXX: is this ok?- , qPrefix = Just "xmlns"- }--atomName :: String -> QName-atomName nc = QName { qName = nc- , qURI = Just atomNS- , qPrefix = atom_prefix- }--atomAttr :: String -> String -> Attr-atomAttr x y = Attr (atomName x) y--atomNode :: String -> [XML.Content] -> XML.Element-atomNode x xs = blank_element { elName = atomName x, elContent = xs }--atomLeaf :: String -> String -> XML.Element-atomLeaf tag txt = blank_element- { elName = atomName tag- , elContent = [ Text blank_cdata { cdData = txt } ]- }--atomThreadName :: String -> QName-atomThreadName nc =- QName { qName = nc- , qURI = Just atomThreadNS- , qPrefix = atom_thr_prefix- }--atomThreadAttr :: String -> String -> Attr-atomThreadAttr x y = Attr (atomThreadName x) y--atomThreadNode :: String -> [XML.Content] -> XML.Element-atomThreadNode x xs =- blank_element { elName = atomThreadName x, elContent = xs }--atomThreadLeaf :: String -> String -> XML.Element-atomThreadLeaf tag txt =- blank_element { elName = atomThreadName tag- , elContent = [ Text blank_cdata { cdData = txt } ]- }------------------------------------------------------------------------------------xmlFeed :: Feed -> XML.Element-xmlFeed f = ( atomNode "feed"- $ map Elem- $ [ xmlTitle (feedTitle f) ]- ++ [ xmlId (feedId f) ]- ++ [ xmlUpdated (feedUpdated f) ]- ++ map xmlLink (feedLinks f)- ++ map xmlAuthor (feedAuthors f)- ++ map xmlCategory (feedCategories f)- ++ map xmlContributor (feedContributors f)- ++ mb xmlGenerator (feedGenerator f)- ++ mb xmlIcon (feedIcon f)- ++ mb xmlLogo (feedLogo f)- ++ mb xmlRights (feedRights f)- ++ mb xmlSubtitle (feedSubtitle f)- ++ map xmlEntry (feedEntries f)- ++ feedOther f )-- { elAttribs = [xmlns_atom] }---xmlEntry :: Entry -> XML.Element-xmlEntry e = ( atomNode "entry"- $ map Elem- $ [ xmlId (entryId e) ]- ++ [ xmlTitle (entryTitle e) ]- ++ [ xmlUpdated (entryUpdated e) ]- ++ map xmlAuthor (entryAuthors e)- ++ map xmlCategory (entryCategories e)- ++ mb xmlContent (entryContent e)- ++ map xmlContributor (entryContributor e)- ++ map xmlLink (entryLinks e)- ++ mb xmlPublished (entryPublished e)- ++ mb xmlRights (entryRights e)- ++ mb xmlSource (entrySource e)- ++ mb xmlSummary (entrySummary e)- ++ mb xmlInReplyTo (entryInReplyTo e)- ++ mb xmlInReplyTotal (entryInReplyTotal e)- ++ entryOther e )-- { elAttribs = entryAttrs e }--xmlContent :: EntryContent -> XML.Element-xmlContent cont = case cont of-- TextContent t -> (atomLeaf "content" t)- { elAttribs = [ atomAttr "type" "text" ] }-- HTMLContent t -> (atomLeaf "content" t)- { elAttribs = [ atomAttr "type" "html" ] }-- XHTMLContent x -> (atomNode "content" [ Elem x ])- { elAttribs = [ atomAttr "type" "xhtml" ] }-- MixedContent mbTy cs -> (atomNode "content" cs)- { elAttribs = mb (atomAttr "type") mbTy }-- ExternalContent mbTy src -> (atomNode "content" [])- { elAttribs = [ atomAttr "src" src ]- ++ mb (atomAttr "type") mbTy }---xmlCategory :: Category -> XML.Element-xmlCategory c = (atomNode "category" (map Elem (catOther c)))- { elAttribs = [ atomAttr "term" (catTerm c) ]- ++ mb (atomAttr "scheme") (catScheme c)- ++ mb (atomAttr "label") (catLabel c)- }--xmlLink :: Link -> XML.Element-xmlLink l = (atomNode "link" (map Elem (linkOther l)))- { elAttribs = [ atomAttr "href" (linkHref l) ]- ++ mb (atomAttr "rel" . either id id) (linkRel l)- ++ mb (atomAttr "type") (linkType l)- ++ mb (atomAttr "hreflang") (linkHrefLang l)- ++ mb (atomAttr "title") (linkTitle l)- ++ mb (atomAttr "length") (linkLength l)- ++ linkAttrs l- }--xmlSource :: Source -> Element-xmlSource s = atomNode "source"- $ map Elem- $ sourceOther s- ++ map xmlAuthor (sourceAuthors s)- ++ map xmlCategory (sourceCategories s)- ++ mb xmlGenerator (sourceGenerator s)- ++ mb xmlIcon (sourceIcon s)- ++ mb xmlId (sourceId s)- ++ map xmlLink (sourceLinks s)- ++ mb xmlLogo (sourceLogo s)- ++ mb xmlRights (sourceRights s)- ++ mb xmlSubtitle (sourceSubtitle s)- ++ mb xmlTitle (sourceTitle s)- ++ mb xmlUpdated (sourceUpdated s)---xmlGenerator :: Generator -> Element-xmlGenerator g = (atomLeaf "generator" (genText g))- { elAttribs = mb (atomAttr "uri") (genURI g)- ++ mb (atomAttr "version") (genVersion g)- }---xmlAuthor :: Person -> XML.Element-xmlAuthor p = atomNode "author" (xmlPerson p)--xmlContributor :: Person -> XML.Element-xmlContributor c = atomNode "contributor" (xmlPerson c)--xmlPerson :: Person -> [XML.Content]-xmlPerson p = map Elem $- [ atomLeaf "name" (personName p) ]- ++ mb (atomLeaf "uri") (personURI p)- ++ mb (atomLeaf "email") (personEmail p)- ++ personOther p--xmlInReplyTo :: InReplyTo -> XML.Element-xmlInReplyTo irt =- (atomThreadNode "in-reply-to" (replyToContent irt))- { elAttribs =- mb (atomThreadAttr "ref") (Just $ replyToRef irt)- ++ mb (atomThreadAttr "href") (replyToHRef irt)- ++ mb (atomThreadAttr "type") (replyToType irt)- ++ mb (atomThreadAttr "source") (replyToSource irt)- ++ replyToOther irt- }--xmlInReplyTotal :: InReplyTotal -> XML.Element-xmlInReplyTotal irt =- (atomThreadLeaf "total" (show $ replyToTotal irt))- { elAttribs = replyToTotalOther irt }--xmlId :: String -> XML.Element-xmlId i = atomLeaf "id" i--xmlIcon :: URI -> XML.Element-xmlIcon i = atomLeaf "icon" i--xmlLogo :: URI -> XML.Element-xmlLogo l = atomLeaf "logo" l--xmlUpdated :: Date -> XML.Element-xmlUpdated u = atomLeaf "updated" u--xmlPublished :: Date -> XML.Element-xmlPublished p = atomLeaf "published" p--xmlRights :: TextContent -> XML.Element-xmlRights r = xmlTextContent "rights" r--xmlTitle :: TextContent -> XML.Element-xmlTitle r = xmlTextContent "title" r--xmlSubtitle :: TextContent -> XML.Element-xmlSubtitle s = xmlTextContent "subtitle" s--xmlSummary :: TextContent -> XML.Element-xmlSummary s = xmlTextContent "summary" s--xmlTextContent :: String -> TextContent -> XML.Element-xmlTextContent tg t =- case t of- TextString s -> (atomLeaf tg s) { elAttribs = [atomAttr "type" "text"] }- HTMLString s -> (atomLeaf tg s) { elAttribs = [atomAttr "type" "html"] }- XHTMLString e -> (atomNode tg [XML.Elem e])- { elAttribs = [atomAttr "type" "xhtml"] }-----------------------------------------------------------------------------------mb :: (a -> b) -> Maybe a -> [b]-mb _ Nothing = []-mb f (Just x) = [f x]
− Text/Atom/Feed/Import.hs
@@ -1,263 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.Atom.Feed.Import--- Copyright : (c) Galois, Inc. 2007-2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability:: portable--- Description: Convert from XML to Atom------ Convert from XML to Atom--------------------------------------------------------------------------module Text.Atom.Feed.Import where--import Data.Maybe (listToMaybe, mapMaybe, isJust)-import Data.List (find)-import Control.Monad (guard,mplus)--import Text.Atom.Feed-import Text.Atom.Feed.Export (atomName, atomThreadName)-import Text.XML.Light as XML--pNodes :: String -> [XML.Element] -> [XML.Element]-pNodes x es = filter ((atomName x ==) . elName) es--pQNodes :: QName -> [XML.Element] -> [XML.Element]-pQNodes x es = filter ((x==) . elName) es--pNode :: String -> [XML.Element] -> Maybe XML.Element-pNode x es = listToMaybe (pNodes x es)--pQNode :: QName -> [XML.Element] -> Maybe XML.Element-pQNode x es = listToMaybe (pQNodes x es)--pLeaf :: String -> [XML.Element] -> Maybe String-pLeaf x es = strContent `fmap` pNode x es--pQLeaf :: QName -> [XML.Element] -> Maybe String-pQLeaf x es = strContent `fmap` pQNode x es--pAttr :: String -> XML.Element -> Maybe String-pAttr x e = fmap snd $ find sameAttr [ (k,v) | Attr k v <- elAttribs e ]- where- ax = atomName x- sameAttr (k,_) = k == ax || (not (isJust (qURI k)) && qName k == x)--pAttrs :: String -> XML.Element -> [String]-pAttrs x e = [ v | Attr k v <- elAttribs e, k == atomName x ]--pQAttr :: QName -> XML.Element -> Maybe String-pQAttr x e = lookup x [ (k,v) | Attr k v <- elAttribs e ]--pMany :: String -> (XML.Element -> Maybe a) -> [XML.Element] -> [a]-pMany p f es = mapMaybe f (pNodes p es)--children :: XML.Element -> [XML.Element]-children e = onlyElems (elContent e)--elementFeed :: XML.Element -> Maybe Feed-elementFeed e =- do guard (elName e == atomName "feed")- let es = children e- i <- pLeaf "id" es- t <- pTextContent "title" es `mplus` return (TextString "<no-title>")- u <- pLeaf "updated" es- return Feed- { feedId = i- , feedTitle = t- , feedSubtitle = pTextContent "subtitle" es- , feedUpdated = u- , feedAuthors = pMany "author" pPerson es- , feedContributors = pMany "contributor" pPerson es- , feedCategories = pMany "category" pCategory es- , feedGenerator = pGenerator `fmap` pNode "generator" es- , feedIcon = pLeaf "icon" es- , feedLogo = pLeaf "logo" es- , feedRights = pTextContent "rights" es- , feedLinks = pMany "link" pLink es- , feedEntries = pMany "entry" pEntry es- , feedOther = other_es es- , feedAttrs = other_as (elAttribs e)- }- where- other_es es = filter (\ el -> not (elName el `elem` known_elts))- es-- other_as as = filter (\ a -> not (attrKey a `elem` known_attrs))- as-- -- let's have them all (including xml:base and xml:lang + xmlns: stuff)- known_attrs = []- known_elts = map atomName- [ "author"- , "category"- , "contributor"- , "generator"- , "icon"- , "id"- , "link"- , "logo"- , "rights"- , "subtitle"- , "title"- , "updated"- , "entry"- ]--pTextContent :: String -> [XML.Element] -> Maybe TextContent-pTextContent tag es =- do e <- pNode tag es- case pAttr "type" e of- Nothing -> return (TextString (strContent e))- Just "text" -> return (TextString (strContent e))- Just "html" -> return (HTMLString (strContent e))- Just "xhtml" -> case children e of -- hmm...- [c] -> return (XHTMLString c)- _ -> Nothing -- Multiple XHTML children.- _ -> Nothing -- Unknown text content type.--pPerson :: XML.Element -> Maybe Person-pPerson e =- do let es = children e- name <- pLeaf "name" es -- or missing "name"- return Person- { personName = name- , personURI = pLeaf "uri" es- , personEmail = pLeaf "email" es- , personOther = [] -- XXX?- }--pCategory :: XML.Element -> Maybe Category-pCategory e =- do term <- pAttr "term" e -- or missing "term" attribute- return Category- { catTerm = term- , catScheme = pAttr "scheme" e- , catLabel = pAttr "label" e- , catOther = [] -- XXX?- }--pGenerator :: XML.Element -> Generator-pGenerator e = Generator- { genURI = pAttr "href" e- , genVersion = pAttr "version" e- , genText = strContent e- }--pSource :: XML.Element -> Source-pSource e =- let es = children e- in Source- { sourceAuthors = pMany "author" pPerson es- , sourceCategories = pMany "category" pCategory es- , sourceGenerator = pGenerator `fmap` pNode "generator" es- , sourceIcon = pLeaf "icon" es- , sourceId = pLeaf "id" es- , sourceLinks = pMany "link" pLink es- , sourceLogo = pLeaf "logo" es- , sourceRights = pTextContent "rights" es- , sourceSubtitle = pTextContent "subtitle" es- , sourceTitle = pTextContent "title" es- , sourceUpdated = pLeaf "updated" es- , sourceOther = [] -- XXX ?- }--pLink :: XML.Element -> Maybe Link-pLink e =- do uri <- pAttr "href" e- return Link- { linkHref = uri- , linkRel = Right `fmap` pAttr "rel" e- , linkType = pAttr "type" e- , linkHrefLang = pAttr "hreflang" e- , linkTitle = pAttr "title" e- , linkLength = pAttr "length" e- , linkAttrs = other_as (elAttribs e)- , linkOther = []- }- where- other_as as = filter (\ a -> not (attrKey a `elem` known_attrs))- as-- known_attrs = map atomName- [ "href", "rel", "type", "hreflang", "title", "length"]---pEntry :: XML.Element -> Maybe Entry-pEntry e =- do let es = children e- i <- pLeaf "id" es- t <- pTextContent "title" es- u <- pLeaf "updated" es `mplus` pLeaf "published" es- return Entry- { entryId = i- , entryTitle = t- , entryUpdated = u- , entryAuthors = pMany "author" pPerson es- , entryContributor = pMany "contributor" pPerson es- , entryCategories = pMany "category" pCategory es- , entryContent = pContent =<< pNode "content" es- , entryLinks = pMany "link" pLink es- , entryPublished = pLeaf "published" es- , entryRights = pTextContent "rights" es- , entrySource = pSource `fmap` pNode "source" es- , entrySummary = pTextContent "summary" es- , entryInReplyTo = pInReplyTo es- , entryInReplyTotal = pInReplyTotal es- , entryAttrs = other_as (elAttribs e)- , entryOther = [] -- ?- }- where- other_as as = filter (\ a -> not (attrKey a `elem` known_attrs))- as-- -- let's have them all (including xml:base and xml:lang + xmlns: stuff)- known_attrs = []--pContent :: XML.Element -> Maybe EntryContent-pContent e =- case pAttr "type" e of- Nothing -> return (TextContent (strContent e))- Just "text" -> return (TextContent (strContent e))- Just "html" -> return (HTMLContent (strContent e))- Just "xhtml" ->- case children e of- [] -> return (TextContent "")- [c] -> return (XHTMLContent c)- _ -> Nothing- Just ty ->- case pAttr "src" e of- Nothing -> return (MixedContent (Just ty) (elContent e))- Just uri -> return (ExternalContent (Just ty) uri)--pInReplyTotal :: [XML.Element] -> Maybe InReplyTotal-pInReplyTotal es = do- t <- pQLeaf (atomThreadName "total") es- case reads t of- ((x,_):_) -> do- n <- pQNode (atomThreadName "total") es- return InReplyTotal- { replyToTotal = x- , replyToTotalOther = elAttribs n- }- _ -> fail "no parse"--pInReplyTo :: [XML.Element] -> Maybe InReplyTo-pInReplyTo es = do- t <- pQNode (atomThreadName "reply-to") es- case pQAttr (atomThreadName "ref") t of- Just ref ->- return InReplyTo- { replyToRef = ref- , replyToHRef = pQAttr (atomThreadName "href") t- , replyToType = pQAttr (atomThreadName "type") t- , replyToSource = pQAttr (atomThreadName "source") t- , replyToOther = elAttribs t -- ToDo: snip out matched ones.- , replyToContent = elContent t- }- _ -> fail "no parse"
− Text/Atom/Feed/Link.hs
@@ -1,81 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.Atom.Feed.Link--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability: portable--------------------------------------------------------------------------module Text.Atom.Feed.Link- ( LinkRelation(..)- , showLinkRelation- , showLinkAttr- ) where---- | Atom feeds uses typed IRI links to represent--- information \/ metadata that is of interest to the--- consumers (software, in the main) of feeds. For instance,--- the edit link relation attached to an atom:entry element--- points to the IRI to use to update\/edit it.------ The Atom standard encourages that such typed links to--- be registered with IANA if they have wider applicability,--- and the 'LinkRelation' data type encodes the currently--- registered link types (derived from:--- http:\/\/www.iana.org\/assignments\/link-relations.html--- on 2007-10-28]----data LinkRelation -- relevant RFC:- = LinkAlternate -- http://www.rfc-editor.org/rfc/rfc4287.txt- | LinkCurrent -- http://www.rfc-editor.org/rfc/rfc5005.txt- | LinkEnclosure -- http://www.rfc-editor.org/rfc/rfc4287.txt- | LinkEdit -- http://www.rfc-editor.org/rfc/rfc5023.txt- | LinkEditMedia -- http://www.rfc-editor.org/rfc/rfc5023.txt- | LinkFirst -- http://www.iana.org/assignments/link-relations/first- | LinkLast -- http://www.iana.org/assignments/link-relations/last- | LinkLicense -- http://www.rfc-editor.org/rfc/rfc4946.txt- | LinkNext -- http://www.rfc-editor.org/rfc/rfc5005.txt- | LinkNextArchive -- http://www.rfc-editor.org/rfc/rfc5005.txt- | LinkPayment -- http://www.iana.org/assignments/link-relations/payment- | LinkPrevArchive -- http://www.rfc-editor.org/rfc/rfc5005.txt- | LinkPrevious -- http://www.rfc-editor.org/rfc/rfc5005.txt- | LinkRelated -- http://www.rfc-editor.org/rfc/rfc4287.txt- | LinkReplies -- http://www.rfc-editor.org/rfc/rfc4685.txt- | LinkSelf -- http://www.rfc-editor.org/rfc/rfc4287.txt- | LinkVia -- http://www.rfc-editor.org/rfc/rfc4287.txt- | LinkOther String- deriving (Eq, Show)--showLinkRelation :: LinkRelation -> String-showLinkRelation lr =- case lr of- LinkAlternate -> "alternate"- LinkCurrent -> "current"- LinkEnclosure -> "enclosure"- LinkEdit -> "edit"- LinkEditMedia -> "edit-media"- LinkFirst -> "first"- LinkLast -> "last"- LinkLicense -> "license"- LinkNext -> "next"- LinkNextArchive -> "next-archive"- LinkPayment -> "payment"- LinkPrevArchive -> "prev-archive"- LinkPrevious -> "previous"- LinkRelated -> "related"- LinkReplies -> "replies"- LinkSelf -> "self"- LinkVia -> "via"- LinkOther s -> s--showLinkAttr :: LinkRelation -> String{-URI-} -> String-showLinkAttr lr s = showLinkRelation lr ++ '=':'"':concatMap escQ s ++ "\""- where- escQ '"' = "&dquot;"- escQ x = [x]-
− Text/Atom/Feed/Validate.hs
@@ -1,295 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.Atom.Feed.Validate--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability: portable-------------------------------------------------------------------------module Text.Atom.Feed.Validate where--import Text.Atom.Feed.Import-import Text.XML.Light.Types-import Text.XML.Light.Proc---import Data.List-import Data.Maybe--data VTree a = VNode [a] [VTree a] | VLeaf [a]- deriving (Eq, Show)--type ValidatorResult = VTree (Bool,String)--advice :: String -> ValidatorResult-advice s = VLeaf [(False,s)]--demand :: String -> ValidatorResult-demand s = VLeaf [(True,s)]--valid :: ValidatorResult-valid = VLeaf []--mkTree :: [(Bool,String)] -> [ValidatorResult] -> ValidatorResult-mkTree as bs = VNode as bs--flattenT :: VTree a -> [a]-flattenT (VLeaf xs) = xs-flattenT (VNode as bs) = as ++ concatMap flattenT bs--validateEntry :: Element -> ValidatorResult-validateEntry e =- mkTree []- [ checkEntryAuthor e- , checkCats e- , checkContents e- , checkContributor e- , checkId e- , checkContentLink e- , checkLinks e- , checkPublished e- , checkRights e- , checkSource e- , checkSummary e- , checkTitle e- , checkUpdated e- ]---- Sec 4.1.2, check #1-checkEntryAuthor :: Element -> ValidatorResult-checkEntryAuthor e =- case pNodes "author" (elChildren e) of- [] -> -- required- case pNode "summary" (elChildren e) of- Nothing -> demand "Required 'author' element missing (no 'summary' either)"- Just e1 ->- case pNode "author" (elChildren e1) of- Just a -> checkAuthor a- _ -> demand "Required 'author' element missing"- xs -> mkTree [] $ map checkAuthor xs----- Sec 4.1.2, check #2-checkCats :: Element -> ValidatorResult-checkCats e = mkTree [] $ map checkCat (pNodes "category" (elChildren e))--checkContents :: Element -> ValidatorResult-checkContents e =- case pNodes "content" (elChildren e) of- [] -> valid- [c] -> mkTree [] $ [checkContent c]- cs -> mkTree (flattenT (demand ("at most one 'content' element expected inside 'entry', found: " ++ show (length cs))))- (map checkContent cs)---checkContributor :: Element -> ValidatorResult-checkContributor _e = valid--checkContentLink :: Element -> ValidatorResult-checkContentLink e =- case pNodes "content" (elChildren e) of- [] ->- case pNodes "link" (elChildren e) of- [] -> demand ("An 'entry' element with no 'content' element must have at least one 'link-rel' element")- xs ->- case filter (=="alternate") $ mapMaybe (pAttr "rel") xs of- [] -> demand ("An 'entry' element with no 'content' element must have at least one 'link-rel' element")- _ -> valid- _ -> valid--checkLinks :: Element -> ValidatorResult-checkLinks e =- case pNodes "link" (elChildren e) of- xs ->- case map fst $ filter (\ (_,n) -> n =="alternate") $- mapMaybe (\ ex -> fmap (\x -> (ex,x)) $ pAttr "rel" ex) xs of- xs1 ->- let- jmb (Just x) (Just y) = Just (x,y)- jmb _ _ = Nothing- in- case mapMaybe (\ ex -> pAttr "type" ex `jmb` pAttr "hreflang" ex) xs1 of- xs2 ->- case any (\ x -> length x > 1) (group xs2) of- True -> demand ("An 'entry' element cannot have duplicate 'link-rel-alternate-type-hreflang' elements")- _ -> valid--checkId :: Element -> ValidatorResult-checkId e =- case pNodes "id" (elChildren e) of- [] -> demand "required field 'id' missing from 'entry' element"- [_] -> valid- xs -> demand ("only one 'id' field expected in 'entry' element, found: " ++ show (length xs))--checkPublished :: Element -> ValidatorResult-checkPublished e =- case pNodes "published" (elChildren e) of- [] -> valid- [_] -> valid- xs -> demand ("expected at most one 'published' field in 'entry' element, found: " ++ show (length xs))--checkRights :: Element -> ValidatorResult-checkRights e =- case pNodes "rights" (elChildren e) of- [] -> valid- [_] -> valid- xs -> demand ("expected at most one 'rights' field in 'entry' element, found: " ++ show (length xs))--checkSource :: Element -> ValidatorResult-checkSource e =- case pNodes "source" (elChildren e) of- [] -> valid- [_] -> valid- xs -> demand ("expected at most one 'source' field in 'entry' element, found: " ++ show (length xs))--checkSummary :: Element -> ValidatorResult-checkSummary e =- case pNodes "summary" (elChildren e) of- [] -> valid- [_] -> valid- xs -> demand ("expected at most one 'summary' field in 'entry' element, found: " ++ show (length xs))--checkTitle :: Element -> ValidatorResult-checkTitle e =- case pNodes "title" (elChildren e) of- [] -> demand "required field 'title' missing from 'entry' element"- [_] -> valid- xs -> demand ("only one 'title' field expected in 'entry' element, found: " ++ show (length xs))--checkUpdated :: Element -> ValidatorResult-checkUpdated e =- case pNodes "updated" (elChildren e) of- [] -> demand "required field 'updated' missing from 'entry' element"- [_] -> valid- xs -> demand ("only one 'updated' field expected in 'entry' element, found: " ++ show (length xs))--checkCat :: Element -> ValidatorResult-checkCat e = mkTree []- [ checkTerm e- , checkScheme e- , checkLabel e- ]- where- checkScheme e' =- case pAttrs "scheme" e' of- [] -> valid- (_:xs)- | null xs -> valid- | otherwise -> demand ("Expected at most one 'scheme' attribute, found: " ++ show (1+length xs))-- checkLabel e' =- case pAttrs "label" e' of- [] -> valid- (_:xs)- | null xs -> valid- | otherwise -> demand ("Expected at most one 'label' attribute, found: " ++ show (1+length xs))--checkContent :: Element -> ValidatorResult-checkContent e = mkTree (flattenT (mkTree [] [type_valid, src_valid]))- [case ty of- "text" ->- case onlyElems (elContent e) of- [] -> valid- _ -> demand ("content with type 'text' cannot have child elements, text only.")- "html" ->- case onlyElems (elContent e) of- [] -> valid- _ -> demand ("content with type 'html' cannot have child elements, text only.")-- "xhtml" ->- case onlyElems (elContent e) of- [] -> valid- [_] -> valid -- ToDo: check that it is a 'div'.- _ds -> demand ("content with type 'xhtml' should only contain one 'div' child.")- _ -> valid]-{-- case parseMIMEType ty of- Nothing -> valid- Just mt- | isXmlType mt -> valid- | otherwise ->- case onlyElems (elContent e) of- [] -> valid -- check- _ -> demand ("content with MIME type '" ++ ty ++ "' must only contain base64 data")]--}- where- types = pAttrs "type" e- (ty, type_valid) =- case types of- [] -> ("text", valid)- [t] -> checkTypeA t- (t:ts) -> (t, demand ("Expected at most one 'type' attribute, found: " ++ show (1+length ts)))-- src_valid =- case pAttrs "src" e of- [] -> valid- [_] ->- case types of- [] -> advice "It is advisable to provide a 'type' along with a 'src' attribute"- (_:_) -> valid-{-- case parseMIMEType t of- Just{} -> valid- _ -> demand "The 'type' attribute must be a valid MIME type"--}- ss -> demand ("Expected at most one 'src' attribute, found: " ++ show (length ss))--- checkTypeA v- | v `elem` std_types = (v, valid)- | otherwise = (v,valid)-{-- case parseMIMEType v of- Nothing -> ("text", demand ("Invalid/unknown type value " ++ v))- Just mt ->- case mimeType mt of- Multipart{} -> ("text", demand "Multipart MIME types not a legal 'type'")- _ -> (v, valid)--}- where- std_types = [ "text", "xhtml", "html"]--checkTerm :: Element -> ValidatorResult-checkTerm e =- case pNodes "term" (elChildren e) of- [] -> demand "required field 'term' missing from 'category' element"- [_] -> valid- xs -> demand ("only one 'term' field expected in 'category' element, found: " ++ show (length xs))--checkAuthor :: Element -> ValidatorResult-checkAuthor e = checkPerson e--checkPerson :: Element -> ValidatorResult-checkPerson e =- mkTree (flattenT $ checkName e)- [ checkEmail e- , checkUri e- ]--checkName :: Element -> ValidatorResult-checkName e =- case pNodes "name" (elChildren e) of- [] -> demand "required field 'name' missing from 'author' element"- [_] -> valid- xs -> demand ("only one 'name' expected in 'author' element, found: " ++ show (length xs))--checkEmail :: Element -> ValidatorResult-checkEmail e =- case pNodes "email" (elChildren e) of- [] -> valid- (_:xs)- | null xs -> valid- | otherwise -> demand ("at most one 'email' expected in 'author' element, found: " ++ show (1+length xs))--checkUri :: Element -> ValidatorResult-checkUri e =- case pNodes "email" (elChildren e) of- [] -> valid- (_:xs)- | null xs -> valid- | otherwise -> demand ("at most one 'uri' expected in 'author' element, found: " ++ show (1+length xs))-
− Text/Atom/Pub.hs
@@ -1,47 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.Atom.Pub--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability: portable------ Types for the Atom Publishing Protocol (APP)-------------------------------------------------------------------------module Text.Atom.Pub where--import Text.XML.Light.Types as XML-import Text.Atom.Feed ( TextContent, Category, URI )--data Service- = Service- { serviceWorkspaces :: [Workspace]- , serviceOther :: [XML.Element]- }--data Workspace- = Workspace- { workspaceTitle :: TextContent- , workspaceCols :: [Collection]- , workspaceOther :: [XML.Element]- }--data Collection- = Collection- { collectionURI :: URI- , collectionTitle :: TextContent- , collectionAccept :: [Accept]- , collectionCats :: [Categories]- , collectionOther :: [XML.Element]- }--data Categories- = CategoriesExternal URI- | Categories (Maybe Bool) (Maybe URI) [Category]- deriving (Show)--newtype Accept = Accept { acceptType :: String }
− Text/Atom/Pub/Export.hs
@@ -1,88 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.Atom.Pub.Export--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability:: portable--- Description: Serializing APP types (as XML.)------ Serializing Atom Publishing Protocol types as XML.-------------------------------------------------------------------------module Text.Atom.Pub.Export where--import Text.XML.Light-import Text.Atom.Pub-import Text.Atom.Feed.Export- ( mb, xmlCategory, xmlTitle- , xmlns_atom- )--showServiceDoc :: Service -> String-showServiceDoc s = showElement (xmlService s)---- ToDo: old crud; inline away.-mkQName :: Maybe String -> String -> QName-mkQName a b = blank_name{qPrefix=a,qName=b}--mkElem :: QName -> [Attr] -> [Element] -> Element-mkElem a b c = node a ((b::[Attr]),(c::[Element]))--mkLeaf :: QName -> [Attr] -> String -> Element-mkLeaf a b c = node (a::QName) ((b::[Attr]),[Text blank_cdata{cdData=c}])--mkAttr :: String -> String -> Attr-mkAttr a b = Attr blank_name{qName=a} b--xmlns_app :: Attr-xmlns_app = Attr (mkQName (Just "xmlns") "app") appNS---appNS :: String-appNS = "http://purl.org/atom/app#"--appName :: String -> QName-appName nc = (mkQName (Just "app") nc){qURI=Just appNS}--xmlService :: Service -> Element-xmlService s =- mkElem (appName "service") [xmlns_app,xmlns_atom]- (concat [ map xmlWorkspace (serviceWorkspaces s)- , serviceOther s- ])--xmlWorkspace :: Workspace -> Element-xmlWorkspace w =- mkElem (appName "workspace")- [mkAttr "xml:lang" "en"]- (concat [ [xmlTitle (workspaceTitle w)]- , map xmlCollection (workspaceCols w)- , workspaceOther w- ])--xmlCollection :: Collection -> Element-xmlCollection c =- mkElem (appName "collection")- [mkAttr "href" (collectionURI c)]- (concat [ [xmlTitle (collectionTitle c)]- , map xmlAccept (collectionAccept c)- , map xmlCategories (collectionCats c)- , collectionOther c- ])--xmlCategories :: Categories -> Element-xmlCategories (CategoriesExternal u) =- mkElem (appName "categories") [mkAttr "href" u] []-xmlCategories (Categories mbFixed mbScheme cs) =- mkElem (appName "categories")- (concat [ mb (\ f -> mkAttr "fixed" (if f then "yes" else "no")) mbFixed- , mb (mkAttr "scheme") mbScheme- ])- (map xmlCategory cs)--xmlAccept :: Accept -> Element-xmlAccept a = mkLeaf (appName "accept") [] (acceptType a)
− Text/DublinCore/Types.hs
@@ -1,82 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.DublinCore.Types--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional------ Representing the DublinCore metadata elements in Haskell.--- For information on the Dublin Core Metadata Element Set,--- see: <http://dublincore.org/>----module Text.DublinCore.Types where---- | A DCItem pairs a specific element with its (string) value.-data DCItem- = DCItem- { dcElt :: DCInfo- , dcText :: String- }- deriving (Eq, Show)---- | The Dublin Core Metadata Element Set, all 15 of them (plus an extension constructor.)-data DCInfo- = DC_Title -- ^ A name given to the resource.- | DC_Creator -- ^ An entity primarily responsible for making the content of the resource.- | DC_Subject -- ^ The topic of the content of the resource.- | DC_Description -- ^ An account of the content of the resource.- | DC_Publisher -- ^ An entity responsible for making the resource available- | DC_Contributor -- ^ An entity responsible for making contributions to the content of the resource.- | DC_Date -- ^ A date associated with an event in the life cycle of the resource (YYYY-MM-DD)- | DC_Type -- ^ The nature or genre of the content of the resource.- | DC_Format -- ^ The physical or digital manifestation of the resource.- | DC_Identifier -- ^ An unambiguous reference to the resource within a given context.- | DC_Source -- ^ A Reference to a resource from which the present resource is derived.- | DC_Language -- ^ A language of the intellectual content of the resource.- | DC_Relation -- ^ A reference to a related resource.- | DC_Coverage -- ^ The extent or scope of the content of the resource.- | DC_Rights -- ^ Information about rights held in and over the resource.- | DC_Other String -- ^ Other; data type extension mechanism.- deriving (Eq, Show)--infoToTag :: DCInfo -> String-infoToTag i =- case i of- DC_Title -> "title"- DC_Creator -> "creator"- DC_Subject -> "subject"- DC_Description -> "description"- DC_Publisher -> "publisher"- DC_Contributor -> "contributor"- DC_Date -> "date"- DC_Type -> "type"- DC_Format -> "format"- DC_Identifier -> "identifier"- DC_Source -> "source"- DC_Language -> "language"- DC_Relation -> "relation"- DC_Coverage -> "coverage"- DC_Rights -> "rights"- DC_Other o -> o--dc_element_names :: [String]-dc_element_names- = [ "title"- , "creator"- , "subject"- , "description"- , "publisher"- , "contributor"- , "date"- , "type"- , "format"- , "identifier"- , "source"- , "language"- , "relation"- , "coverage"- , "rights"- ]
− Text/Feed/Constructor.hs
@@ -1,726 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.Feed.Constructor--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Description: Module for an abstraction layer between different kinds of feeds.--------------------------------------------------------------------------module Text.Feed.Constructor- ( FeedKind(..)- , newFeed -- :: FeedKind -> Feed- , feedFromRSS -- :: RSS -> Feed- , feedFromAtom -- :: Atom.Feed -> Feed- , feedFromRDF -- :: RSS1.Feed -> Feed- , feedFromXML -- :: Element -> Feed- , getFeedKind -- :: Feed -> FeedKind-- , FeedSetter -- type _ a = a -> Feed -> Feed- , addItem -- :: FeedSetter Item-- , withFeedTitle -- :: FeedSetter String- , withFeedHome -- :: FeedSetter URLString- , withFeedHTML -- :: FeedSetter URLString- , withFeedDescription -- :: FeedSetter String- , withFeedPubDate -- :: FeedSetter DateString- , withFeedLastUpdate -- :: FeedSetter DateString- , withFeedDate -- :: FeedSetter DateString- , withFeedLogoLink -- :: FeedSetter URLString- , withFeedLanguage -- :: FeedSetter String- , withFeedCategories -- :: FeedSetter [(String,Maybe String)]- , withFeedGenerator -- :: FeedSetter String- , withFeedItems -- :: FeedSetter [Item]-- , newItem -- :: FeedKind -> Item- , getItemKind -- :: Item -> FeedKind- , atomEntryToItem -- :: Atom.Entry -> Item- , rssItemToItem -- :: RSS.Item -> Item- , rdfItemToItem -- :: RSS1.Item -> Item-- , ItemSetter -- type _ a = a -> Item -> Item- , withItemTitle -- :: ItemSetter String- , withItemLink -- :: ItemSetter URLString- , withItemPubDate -- :: ItemSetter DateString- , withItemDate -- :: ItemSetter DateString- , withItemAuthor -- :: ItemSetter String- , withItemCommentLink -- :: ItemSetter String- , withItemEnclosure -- :: String -> Maybe String -> ItemSetter Integer- , withItemFeedLink -- :: String -> ItemSetter String- , withItemId -- :: Bool -> ItemSetter String- , withItemCategories -- :: ItemSetter [(String, Maybe String)]- , withItemDescription -- :: ItemSetter String- , withItemRights -- :: ItemSetter String- ) where--import Text.Feed.Types as Feed.Types--import Text.Atom.Feed as Atom-import Text.RSS.Syntax as RSS-import Text.RSS1.Syntax as RSS1-import Text.DublinCore.Types-import Text.XML.Light as XML hiding ( filterChildren )--import Data.Maybe ( fromMaybe, mapMaybe )-import Data.Char ( toLower )---- ToDo:------ - complete set of constructors over feeds--- - provide a unified treatment of date string reps.--- (i.e., I know they differ across formats, but ignorant what--- the constraints are at the moment.)----- | Construct an empty feed document, intending to output it in--- the 'fk' feed format.-newFeed :: FeedKind -> Feed.Types.Feed-newFeed fk =- case fk of- AtomKind -> AtomFeed (Atom.nullFeed "feed-id-not-filled-in"- (TextString "dummy-title")- "dummy-and-bogus-update-date")- RSSKind mbV ->- let def = (RSS.nullRSS "dummy-title" "default-channel-url") in- RSSFeed $ fromMaybe def $ fmap (\ v -> def{RSS.rssVersion=v}) mbV- RDFKind mbV ->- let def = (RSS1.nullFeed "default-channel-url" "dummy-title") in- RSS1Feed $ fromMaybe def $ fmap (\ v -> def{RSS1.feedVersion=v}) mbV---feedFromRSS :: RSS.RSS -> Feed.Types.Feed-feedFromRSS r = RSSFeed r--feedFromAtom :: Atom.Feed -> Feed.Types.Feed-feedFromAtom f = AtomFeed f--feedFromRDF :: RSS1.Feed -> Feed.Types.Feed-feedFromRDF f = RSS1Feed f--feedFromXML :: XML.Element -> Feed.Types.Feed-feedFromXML f = XMLFeed f--getFeedKind :: Feed.Types.Feed -> FeedKind-getFeedKind f =- case f of- Feed.Types.AtomFeed{} -> AtomKind- Feed.Types.RSSFeed r -> RSSKind (case RSS.rssVersion r of { "2.0" -> Nothing; v -> Just v})- Feed.Types.RSS1Feed r -> RDFKind (case RSS1.feedVersion r of { "1.0" -> Nothing; v -> Just v})- Feed.Types.XMLFeed{} -> RSSKind (Just "2.0") -- for now, just a hunch..--addItem :: Feed.Types.Item -> Feed.Types.Feed -> Feed.Types.Feed-addItem it f =- case (it,f) of- (Feed.Types.AtomItem e, Feed.Types.AtomFeed fe) ->- Feed.Types.AtomFeed fe{Atom.feedEntries=e:Atom.feedEntries fe}- (Feed.Types.RSSItem e, Feed.Types.RSSFeed r) ->- Feed.Types.RSSFeed r{RSS.rssChannel=(RSS.rssChannel r){RSS.rssItems=e:RSS.rssItems (RSS.rssChannel r)}}- (Feed.Types.RSS1Item e, Feed.Types.RSS1Feed r) ->- -- note: do not update the channel item URIs at this point;- -- will delay doing so until serialization.- Feed.Types.RSS1Feed r{RSS1.feedItems=e:RSS1.feedItems r}- _ -> error "addItem: currently unable to automatically convert items from one feed type to another"--withFeedItems :: FeedSetter [Feed.Types.Item]-withFeedItems is fe =- foldr addItem- (case fe of- Feed.Types.AtomFeed f -> Feed.Types.AtomFeed- f{Atom.feedEntries=[]}- Feed.Types.RSSFeed f -> Feed.Types.RSSFeed- f{rssChannel=(rssChannel f){rssItems=[]}}- Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed- f{feedItems=[]})- is--newItem :: FeedKind -> Feed.Types.Item-newItem fk =- case fk of- AtomKind -> Feed.Types.AtomItem $- Atom.nullEntry "entry-id-not-filled-in"- (TextString "dummy-entry-title")- "dummy-and-bogus-entry-update-date"- RSSKind{} -> Feed.Types.RSSItem $- RSS.nullItem "dummy-rss-item-title"- RDFKind{} -> Feed.Types.RSS1Item $- RSS1.nullItem "dummy-item-uri"- "dummy-item-title"- "dummy-item-link"--getItemKind :: Feed.Types.Item -> FeedKind-getItemKind f =- case f of- Feed.Types.AtomItem{} -> AtomKind- Feed.Types.RSSItem{} -> RSSKind (Just "2.0") -- good guess..- Feed.Types.RSS1Item{} -> RDFKind (Just "1.0")- Feed.Types.XMLItem{} -> RSSKind (Just "2.0")--type FeedSetter a = a -> Feed.Types.Feed -> Feed.Types.Feed--withFeedTitle :: FeedSetter String-withFeedTitle tit fe =- case fe of- Feed.Types.AtomFeed f -> Feed.Types.AtomFeed f{feedTitle=TextString tit}- Feed.Types.RSSFeed f -> Feed.Types.RSSFeed f{rssChannel=(rssChannel f){rssTitle=tit}}- Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed f{feedChannel=(feedChannel f){channelTitle=tit}}- Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $- mapMaybeChildren (\ e ->- if (elName e == unqual "channel")- then Just (mapMaybeChildren (\ e2 ->- if (elName e2 == unqual "title")- then Just (unode "title" tit)- else Nothing) e)- else Nothing) f--withFeedHome :: FeedSetter URLString-withFeedHome url fe =- case fe of- Feed.Types.AtomFeed f -> Feed.Types.AtomFeed f{feedLinks=newSelf:Atom.feedLinks f}- -- ToDo: fix, the <link> element is for the HTML home of the channel, not the- -- location of the feed itself. Struggling to find if there is a common way- -- to represent this outside of RSS 2.0 standard elements..- Feed.Types.RSSFeed f -> Feed.Types.RSSFeed f{rssChannel=(rssChannel f){rssLink=url}}- Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed f{feedChannel=(feedChannel f){channelURI=url}}- Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $- mapMaybeChildren (\ e ->- if (elName e == unqual "channel")- then Just (mapMaybeChildren (\ e2 ->- if (elName e2 == unqual "link")- then Just (unode "link" url)- else Nothing) e)- else Nothing) f- where- newSelf = (nullLink url){ linkRel=Just (Left "self")- , linkType=Just "application/atom+xml"- }---- | 'withFeedHTML' sets the URL where an HTML version of the--- feed is published.-withFeedHTML :: FeedSetter URLString-withFeedHTML url fe =- case fe of- Feed.Types.AtomFeed f -> Feed.Types.AtomFeed f{feedLinks=newAlt:Atom.feedLinks f}- Feed.Types.RSSFeed f -> Feed.Types.RSSFeed f{rssChannel=(rssChannel f){rssLink=url}}- Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed f{feedChannel=(feedChannel f){channelLink=url}}- Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $- mapMaybeChildren (\ e ->- if (elName e == unqual "channel")- then Just (mapMaybeChildren (\ e2 ->- if (elName e2 == unqual "link")- then Just (unode "link" url)- else Nothing) e)- else Nothing) f- where- newAlt = (nullLink url){ linkRel=Just (Left "alternate")- , linkType=Just "text/html"- }---- | 'withFeedHTML' sets the URL where an HTML version of the--- feed is published.-withFeedDescription :: FeedSetter String-withFeedDescription desc fe =- case fe of- Feed.Types.AtomFeed f -> Feed.Types.AtomFeed- f{feedSubtitle=Just (TextString desc)}- Feed.Types.RSSFeed f -> Feed.Types.RSSFeed- f{rssChannel=(rssChannel f){rssDescription=desc}}- Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed- f{feedChannel=(feedChannel f){channelDesc=desc}}- Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $- mapMaybeChildren (\ e ->- if (elName e == unqual "channel")- then Just (mapMaybeChildren (\ e2 ->- if (elName e2 == unqual "description")- then Just (unode "description" desc)- else Nothing) e)- else Nothing) f--withFeedPubDate :: FeedSetter String-withFeedPubDate dateStr fe =- case fe of- Feed.Types.AtomFeed f -> Feed.Types.AtomFeed- f{feedUpdated=dateStr}- Feed.Types.RSSFeed f -> Feed.Types.RSSFeed- f{rssChannel=(rssChannel f){rssPubDate=Just dateStr}}- Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed $- case break isDate $ RSS1.channelDC (RSS1.feedChannel f) of- (as,(dci:bs)) ->- f{RSS1.feedChannel=- (RSS1.feedChannel f)- {RSS1.channelDC=as++dci{dcText=dateStr}:bs}}- (_,[]) ->- f{RSS1.feedChannel=- (RSS1.feedChannel f)- {RSS1.channelDC=- DCItem{dcElt=DC_Date,dcText=dateStr}:- RSS1.channelDC (RSS1.feedChannel f)}}- Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $- mapMaybeChildren (\ e ->- if (elName e == unqual "channel")- then Just (mapMaybeChildren (\ e2 ->- if (elName e2 == unqual "pubDate")- then Just (unode "pubDate" dateStr)- else Nothing) e)- else Nothing) f- where- isDate dc = dcElt dc == DC_Date--withFeedLastUpdate :: FeedSetter DateString-withFeedLastUpdate dateStr fe =- case fe of- Feed.Types.AtomFeed f -> Feed.Types.AtomFeed- f{feedUpdated=dateStr}- Feed.Types.RSSFeed f -> Feed.Types.RSSFeed- f{rssChannel=(rssChannel f){rssLastUpdate=Just dateStr}}- Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed $- case break isDate $ RSS1.channelDC (RSS1.feedChannel f) of- (as,(dci:bs)) ->- f{RSS1.feedChannel=- (RSS1.feedChannel f)- {RSS1.channelDC=as++dci{dcText=dateStr}:bs}}- (_,[]) ->- f{RSS1.feedChannel=- (RSS1.feedChannel f)- {RSS1.channelDC=- DCItem{dcElt=DC_Date,dcText=dateStr}:- RSS1.channelDC (RSS1.feedChannel f)}}- Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $- mapMaybeChildren (\ e ->- if (elName e == unqual "channel")- then Just (mapMaybeChildren (\ e2 ->- if (elName e2 == unqual "lastUpdate")- then Just (unode "lastUpdate" dateStr)- else Nothing) e)- else Nothing) f- where- isDate dc = dcElt dc == DC_Date----- | 'withFeedDate dt' is the composition of 'withFeedPubDate'--- and 'withFeedLastUpdate', setting both publication date and--- last update date to 'dt'. Notice that RSS2.0 is the only format--- supporting both pub and last-update.-withFeedDate :: FeedSetter DateString-withFeedDate dt f = withFeedPubDate dt(withFeedLastUpdate dt f)---withFeedLogoLink :: URLString -> FeedSetter URLString-withFeedLogoLink imgURL lnk fe =- case fe of- Feed.Types.AtomFeed f -> Feed.Types.AtomFeed- f{ feedLogo = Just imgURL- , feedLinks = newSelf:Atom.feedLinks f- }- Feed.Types.RSSFeed f -> Feed.Types.RSSFeed- f{ rssChannel=(rssChannel f)- {rssImage=Just $- RSS.nullImage imgURL (rssTitle (rssChannel f)) lnk}}- Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed $- f{ feedImage = Just $- RSS1.nullImage imgURL (RSS1.channelTitle (RSS1.feedChannel f)) lnk- , feedChannel =- (feedChannel f){channelImageURI=Just imgURL}- }- Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $- mapMaybeChildren (\ e ->- if (elName e == unqual "channel")- then Just (mapMaybeChildren (\ e2 ->- if (elName e2 == unqual "image")- then Just (unode "image" [ unode "url" imgURL- , unode "title" title- , unode "link" lnk- ])- else Nothing) e)- else Nothing) f- where- title =- case fmap (findChild (unqual "title"))- (findChild (unqual "channel") f) of- Just (Just e1) -> strContent e1- _ -> "feed_title" -- shouldn't happen..-- where- newSelf = (nullLink lnk){ linkRel=Just (Left "self")- , linkType=Just "application/atom+xml"- }---withFeedLanguage :: FeedSetter String-withFeedLanguage lang fe =- case fe of- Feed.Types.AtomFeed f -> Feed.Types.AtomFeed $- f{Atom.feedAttrs=(XML.Attr (unqual "lang"){qPrefix=Just "xml"} lang):Atom.feedAttrs f}- Feed.Types.RSSFeed f -> Feed.Types.RSSFeed- f{rssChannel=(rssChannel f){rssLanguage=Just lang}}- Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed $- case break isLang $ RSS1.channelDC (RSS1.feedChannel f) of- (as,(dci:bs)) ->- f{RSS1.feedChannel=- (RSS1.feedChannel f)- {RSS1.channelDC=as++dci{dcText=lang}:bs}}- (_,[]) ->- f{RSS1.feedChannel=- (RSS1.feedChannel f)- {RSS1.channelDC=- DCItem{dcElt=DC_Language,dcText=lang}:- RSS1.channelDC (RSS1.feedChannel f)}}- Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $- mapMaybeChildren (\ e ->- if (elName e == unqual "channel")- then Just (mapMaybeChildren (\ e2 ->- if (elName e2 == unqual "language")- then Just (unode "language" lang)- else Nothing) e)- else Nothing) f- where- isLang dc = dcElt dc == DC_Language--withFeedCategories :: FeedSetter [(String,Maybe String)]-withFeedCategories cats fe =- case fe of- Feed.Types.AtomFeed f -> Feed.Types.AtomFeed- f{ Atom.feedCategories =- map ( \ (t,mb) -> (Atom.newCategory t){Atom.catScheme=mb})- cats ++ feedCategories f}- Feed.Types.RSSFeed f -> Feed.Types.RSSFeed- f{rssChannel=(rssChannel f){- RSS.rssCategories=- map (\ (t,mb) -> (RSS.newCategory t){RSS.rssCategoryDomain=mb})- cats ++ RSS.rssCategories (rssChannel f)}}- Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed- f{feedChannel=(feedChannel f){- RSS1.channelDC=- map (\ (t,_) -> DCItem{dcElt=DC_Subject,dcText=t})- cats ++ RSS1.channelDC (feedChannel f)}}- Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $- mapMaybeChildren (\ e ->- if (elName e == unqual "channel")- then Just (- foldr- (\ (t,mb) acc ->- addChild (unode "category"- (fromMaybe (\x -> [x])- (fmap (\v -> (\ x -> [Attr (unqual "domain") v,x])) mb) $- (Attr (unqual "term") t))- ) acc)- e- cats)- else Nothing) f---withFeedGenerator :: FeedSetter (String,Maybe URLString)-withFeedGenerator (gen,mbURI) fe =- case fe of- Feed.Types.AtomFeed f -> Feed.Types.AtomFeed $- f{Atom.feedGenerator=Just ((Atom.nullGenerator gen){Atom.genURI=mbURI})}- Feed.Types.RSSFeed f -> Feed.Types.RSSFeed- f{rssChannel=(rssChannel f){rssGenerator=Just gen}}- Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed $- case break isSource $ RSS1.channelDC (RSS1.feedChannel f) of- (as,(dci:bs)) ->- f{RSS1.feedChannel=- (RSS1.feedChannel f)- {RSS1.channelDC=as++dci{dcText=gen}:bs}}- (_,[]) ->- f{RSS1.feedChannel=- (RSS1.feedChannel f)- {RSS1.channelDC=- DCItem{dcElt=DC_Source,dcText=gen}:- RSS1.channelDC (RSS1.feedChannel f)}}- Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $- mapMaybeChildren (\ e ->- if (elName e == unqual "channel")- then Just (mapMaybeChildren (\ e2 ->- if (elName e2 == unqual "generator")- then Just (unode "generator" gen)- else Nothing) e)- else Nothing) f- where- isSource dc = dcElt dc == DC_Source------ Item constructors (all the way to the end):--atomEntryToItem :: Atom.Entry -> Feed.Types.Item-atomEntryToItem e = Feed.Types.AtomItem e--rssItemToItem :: RSS.RSSItem -> Feed.Types.Item-rssItemToItem i = Feed.Types.RSSItem i--rdfItemToItem :: RSS1.Item -> Feed.Types.Item-rdfItemToItem i = Feed.Types.RSS1Item i--type ItemSetter a = a -> Feed.Types.Item -> Feed.Types.Item---- | 'withItemPubDate dt' associates the creation\/ publication date 'dt'--- with a feed item.-withItemPubDate :: ItemSetter DateString-withItemPubDate dt fi =- case fi of- Feed.Types.AtomItem e ->- Feed.Types.AtomItem e{Atom.entryUpdated=dt}- Feed.Types.RSSItem i ->- Feed.Types.RSSItem i{RSS.rssItemPubDate=Just dt}- Feed.Types.RSS1Item i ->- case break isDate $ RSS1.itemDC i of- (as,(dci:bs)) -> Feed.Types.RSS1Item i{RSS1.itemDC=as++dci{dcText=dt}:bs}- (_,[]) -> Feed.Types.RSS1Item i{RSS1.itemDC=DCItem{dcElt=DC_Date,dcText=dt}:RSS1.itemDC i}- Feed.Types.XMLItem i ->- Feed.Types.XMLItem $- addChild (unode "pubDate" dt) $- filterChildren (\ e -> elName e /= unqual "pubDate")- i- where- isDate dc = dcElt dc == DC_Date---- | 'withItemDate' is a synonym for 'withItemPubDate'.-withItemDate :: ItemSetter DateString-withItemDate dt fi = withItemPubDate dt fi---- | 'withItemTitle myTitle' associates a new title, 'myTitle',--- with a feed item.-withItemTitle :: ItemSetter String-withItemTitle tit fi =- case fi of- Feed.Types.AtomItem e ->- Feed.Types.AtomItem e{Atom.entryTitle=TextString tit}- Feed.Types.RSSItem i ->- Feed.Types.RSSItem i{RSS.rssItemTitle=Just tit}- Feed.Types.RSS1Item i ->- Feed.Types.RSS1Item i{RSS1.itemTitle=tit}- Feed.Types.XMLItem i ->- Feed.Types.XMLItem $- addChild (unode "title" tit) $- filterChildren (\ e -> elName e /= unqual "title")- i---- | 'withItemAuthor auStr' associates new author info--- with a feed item.-withItemAuthor :: ItemSetter String-withItemAuthor au fi =- case fi of- Feed.Types.AtomItem e ->- Feed.Types.AtomItem e{Atom.entryAuthors=[nullPerson{personName=au,personURI=Just au}]}- Feed.Types.RSSItem i ->- Feed.Types.RSSItem i{RSS.rssItemAuthor=Just au}- Feed.Types.RSS1Item i ->- case break isAuthor $ RSS1.itemDC i of- (as,(dci:bs)) -> Feed.Types.RSS1Item i{RSS1.itemDC=as++dci{dcText=au}:bs}- (_,[]) -> Feed.Types.RSS1Item i{RSS1.itemDC=DCItem{dcElt=DC_Creator,dcText=au}:RSS1.itemDC i}- Feed.Types.XMLItem i ->- Feed.Types.XMLItem $- addChild (unode "author" au) $- filterChildren (\ e -> elName e /= unqual "author")- i- where- isAuthor dc = dcElt dc == DC_Creator---- | 'withItemFeedLink name myFeed' associates the parent feed URL 'myFeed'--- with a feed item. It is labelled as 'name'.-withItemFeedLink :: String -> ItemSetter String-withItemFeedLink tit url fi =- case fi of- Feed.Types.AtomItem e ->- Feed.Types.AtomItem e{Atom.entrySource=Just Atom.nullSource{sourceId=Just url,sourceTitle=Just (TextString tit)}}- Feed.Types.RSSItem i ->- Feed.Types.RSSItem i{RSS.rssItemSource=Just (RSS.nullSource url tit)}- Feed.Types.RSS1Item i ->- Feed.Types.RSS1Item i{RSS1.itemTitle=tit}- Feed.Types.XMLItem i ->- Feed.Types.XMLItem $- addChild (unode "source" (Attr (unqual "url") url,tit)) $- filterChildren (\ e -> elName e /= unqual "source")- i------ | 'withItemCommentLink url' sets the URL reference to the comment page to 'url'.-withItemCommentLink :: ItemSetter String-withItemCommentLink url fi =- case fi of- Feed.Types.AtomItem e ->- Feed.Types.AtomItem e{Atom.entryLinks=((nullLink url){linkRel=Just (Left "replies")}):Atom.entryLinks e}- Feed.Types.RSSItem i ->- Feed.Types.RSSItem i{RSS.rssItemComments=Just url}- Feed.Types.RSS1Item i ->- case break isRel $ RSS1.itemDC i of- (as,(dci:bs)) -> Feed.Types.RSS1Item i{RSS1.itemDC=as++dci{dcText=url}:bs}- (_,[]) -> Feed.Types.RSS1Item i{RSS1.itemDC=DCItem{dcElt=DC_Relation,dcText=url}:RSS1.itemDC i}- Feed.Types.XMLItem i ->- Feed.Types.XMLItem $- addChild (unode "comments" url) $- filterChildren (\ e -> elName e /= unqual "comments")- i- where- isRel dc = dcElt dc == DC_Relation---- | 'withItemEnclosure url mbTy len' sets the URL reference to the comment page to 'url'.-withItemEnclosure :: String -> Maybe String -> ItemSetter (Maybe Integer)-withItemEnclosure url ty mb_len fi =- case fi of- Feed.Types.AtomItem e -> Feed.Types.AtomItem- e{Atom.entryLinks=((nullLink url){linkRel=Just (Left "enclosure")- ,linkType=ty- ,linkLength=fmap show mb_len- }):Atom.entryLinks e}- Feed.Types.RSSItem i ->- Feed.Types.RSSItem i{RSS.rssItemEnclosure=Just (nullEnclosure url mb_len (fromMaybe "text/html" ty))}- Feed.Types.RSS1Item i -> Feed.Types.RSS1Item- i{RSS1.itemContent=nullContentInfo{ contentURI=Just url- , contentFormat=ty- }:RSS1.itemContent i}- Feed.Types.XMLItem i ->- Feed.Types.XMLItem $- addChild ((unode "enclosure" url)- {elAttribs= [ Attr (unqual "length") "0"- , Attr (unqual "type") (fromMaybe "text/html" ty)- ]}) $- filterChildren (\ e -> elName e /= unqual "enclosure")- i----- | 'withItemId isURL id' associates new unique identifier with a feed item.--- If 'isURL' is 'True', then the id is assumed to point to a valid web resource.-withItemId :: Bool -> ItemSetter String-withItemId isURL idS fi =- case fi of- Feed.Types.AtomItem e ->- Feed.Types.AtomItem e{Atom.entryId=idS}- Feed.Types.RSSItem i ->- Feed.Types.RSSItem i{RSS.rssItemGuid=Just (nullGuid idS){rssGuidPermanentURL=Just isURL}}- Feed.Types.RSS1Item i ->- case break isId $ RSS1.itemDC i of- (as,(dci:bs)) -> Feed.Types.RSS1Item i{RSS1.itemDC=as++dci{dcText=idS}:bs}- (_,[]) -> Feed.Types.RSS1Item i{RSS1.itemDC=DCItem{dcElt=DC_Identifier,dcText=idS}:RSS1.itemDC i}- Feed.Types.XMLItem i ->- Feed.Types.XMLItem $- addChild (unode "guid" (Attr (unqual "isPermaLink") (showBool isURL),idS)) $- filterChildren (\ e -> elName e /= unqual "guid")- i- where- showBool x = map toLower (show x)- isId dc = dcElt dc == DC_Identifier---- | 'withItemDescription desc' associates a new descriptive string (aka summary)--- with a feed item.-withItemDescription :: ItemSetter String-withItemDescription desc fi =- case fi of- Feed.Types.AtomItem e ->- Feed.Types.AtomItem e{Atom.entrySummary=Just (TextString desc)}- Feed.Types.RSSItem i ->- Feed.Types.RSSItem i{RSS.rssItemDescription=Just desc}- Feed.Types.RSS1Item i ->- Feed.Types.RSS1Item i{RSS1.itemDesc=Just desc}- Feed.Types.XMLItem i ->- Feed.Types.XMLItem $- addChild (unode "description" desc) $- filterChildren (\ e -> elName e /= unqual "description")- i---- | 'withItemRights rightStr' associates the rights information 'rightStr'--- with a feed item.-withItemRights :: ItemSetter String-withItemRights desc fi =- case fi of- Feed.Types.AtomItem e ->- Feed.Types.AtomItem e{Atom.entryRights=Just (TextString desc)}- -- Note: per-item copyright information isn't supported by RSS2.0 (and earlier editions),- -- you can only attach this at the feed/channel level. So, there's not much we can do- -- except dropping the information on the floor here. (Rolling our own attribute or- -- extension element is an option, but would prefer if someone else had started that- -- effort already.- Feed.Types.RSSItem{} -> fi- Feed.Types.RSS1Item i ->- case break ((==DC_Rights).dcElt) $ RSS1.itemDC i of- (as,(dci:bs)) -> Feed.Types.RSS1Item i{RSS1.itemDC=as++dci{dcText=desc}:bs}- (_,[]) -> Feed.Types.RSS1Item i{RSS1.itemDC=DCItem{dcElt=DC_Rights,dcText=desc}:RSS1.itemDC i}- -- Since we're so far assuming that a shallow XML rep. of an item- -- is of RSS2.0 ilk, pinning on the rights info is hard (see above.)- Feed.Types.XMLItem{} -> fi---- | 'withItemTitle myLink' associates a new URL, 'myLink',--- with a feed item.-withItemLink :: ItemSetter URLString-withItemLink url fi =- case fi of- Feed.Types.AtomItem e ->- Feed.Types.AtomItem e{Atom.entryLinks=replaceAlternate url (Atom.entryLinks e)}- Feed.Types.RSSItem i ->- Feed.Types.RSSItem i{RSS.rssItemLink=Just url}- Feed.Types.RSS1Item i ->- Feed.Types.RSS1Item i{RSS1.itemLink=url}- Feed.Types.XMLItem i ->- Feed.Types.XMLItem $- addChild (unode "link" url) $- filterChildren (\ e -> elName e /= unqual "link")- i- where- replaceAlternate _ [] = []- replaceAlternate x (lr:xs)- | toStr (Atom.linkRel lr) == "alternate" = lr{Atom.linkHref=x} : xs- | otherwise = lr : replaceAlternate x xs-- toStr Nothing = ""- toStr (Just (Left x)) = x- toStr (Just (Right x)) = x--withItemCategories :: ItemSetter [(String,Maybe String)]-withItemCategories cats fi =- case fi of- Feed.Types.AtomItem e -> Feed.Types.AtomItem- e{ Atom.entryCategories =- map ( \ (t,mb) -> (Atom.newCategory t){Atom.catScheme=mb})- cats ++ entryCategories e}- Feed.Types.RSSItem i -> Feed.Types.RSSItem- i{RSS.rssItemCategories=- map (\ (t,mb) -> (RSS.newCategory t){RSS.rssCategoryDomain=mb})- cats ++ rssItemCategories i}- Feed.Types.RSS1Item i -> Feed.Types.RSS1Item- i{RSS1.itemDC=- map (\ (t,_) -> DCItem{dcElt=DC_Subject,dcText=t})- cats ++ RSS1.itemDC i}- Feed.Types.XMLItem i -> Feed.Types.XMLItem $- foldr (\ (t,mb) acc ->- addChild (unode "category"- (fromMaybe (\x -> [x])- (fmap (\v -> (\ x -> [Attr (unqual "domain") v,x])) mb) $- (Attr (unqual "term") t))- ) acc)- i- cats---- helpers..--filterChildren :: (XML.Element -> Bool) -> XML.Element -> XML.Element-filterChildren pre e =- case elContent e of- [] -> e- cs -> e { elContent = mapMaybe filterElt cs }- where- filterElt xe@(XML.Elem el)- | pre el = Just xe- | otherwise = Nothing- filterElt xe = Just xe--addChild :: XML.Element -> XML.Element -> XML.Element-addChild a b = b { elContent = XML.Elem a : elContent b }--mapMaybeChildren :: (XML.Element -> Maybe XML.Element)- -> XML.Element- -> XML.Element-mapMaybeChildren f e =- case elContent e of- [] -> e- cs -> e { elContent = map procElt cs }- where- procElt xe@(XML.Elem el) =- case f el of- Nothing -> xe- Just el1 -> XML.Elem el1- procElt xe = xe
− Text/Feed/Export.hs
@@ -1,36 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.Feed.Export--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional------ Convert from Feeds to XML.---------------------------------------------------------------------------module Text.Feed.Export- ( Text.Feed.Export.xmlFeed -- :: Feed -> XML.Element- ) where--import Text.Feed.Types--import Text.Atom.Feed.Export as Atom-import Text.RSS.Export as RSS-import Text.RSS1.Export as RSS1--import Text.XML.Light as XML---- | 'xmlFeed f' serializes a @Feed@ document into a conforming--- XML toplevel element.-xmlFeed :: Feed -> XML.Element-xmlFeed fe =- case fe of- AtomFeed f -> Atom.xmlFeed f- RSSFeed f -> RSS.xmlRSS f- RSS1Feed f -> RSS1.xmlFeed f- XMLFeed e -> e -- that was easy!
− Text/Feed/Import.hs
@@ -1,94 +0,0 @@-{-# LANGUAGE CPP #-}------------------------------------------------------------------------ |--- Module : Text.Feed.Import--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional------ Convert from XML to Feeds.--------------------------------------------------------------------------module Text.Feed.Import- ( parseFeedFromFile -- :: FilePath -> IO Feed- , parseFeedString -- :: String -> IO Feed-- -- if you know your format, use these directly:- , readRSS2 -- :: XML.Element -> Maybe Feed- , readRSS1 -- :: XML.Element -> Maybe Feed- , readAtom -- :: XML.Element -> Maybe Feed- ) where--import Text.Atom.Feed.Import as Atom-import Text.RSS.Import as RSS-import Text.RSS1.Import as RSS1--import Text.Feed.Types-import Text.XML.Light as XML-import Text.XML.Light.Lexer ( XmlSource )--import Control.Monad--#if MIN_VERSION_utf8_string(1,0,0)-import Codec.Binary.UTF8.String (decodeString)-import System.IO (IOMode(..), hGetContents, openBinaryFile )-utf8readFile :: FilePath -> IO String-utf8readFile fp = fmap decodeString (hGetContents =<< openBinaryFile fp ReadMode)-#else-import System.IO.UTF8 as UTF8 ( readFile )-utf8readFile :: FilePath -> IO String-utf8readFile = UTF8.readFile-#endif------ | 'parseFeedFromFile fp' reads in the contents of the file at @fp@;--- the assumed encoding is UTF-8.-parseFeedFromFile :: FilePath -> IO Feed-parseFeedFromFile fp = do- ls <- utf8readFile fp- case parseFeedString ls of- Nothing -> fail ("parseFeedFromFile: not a well-formed XML content in: " ++ fp)- Just f -> return f---- | 'parseFeedWithParser tries to parse the string @str@--- as one of the feed formats. First as Atom, then RSS2 before--- giving RSS1 a try. @Nothing@ is, rather unhelpfully, returned--- as an indication of error.-parseFeedWithParser :: XmlSource s => (s -> Maybe Element) -> s -> Maybe Feed-parseFeedWithParser parser str =- case parser str of- Nothing -> Nothing- Just e ->- readAtom e `mplus`- readRSS2 e `mplus`- readRSS1 e `mplus`- Just (XMLFeed e)----- | 'parseFeedString str' tries to parse the string @str@ as--- one of the feed formats. First as Atom, then RSS2 before--- giving RSS1 a try. @Nothing@ is, rather unhelpfully, returned--- as an indication of error.-parseFeedString :: String -> Maybe Feed-parseFeedString = parseFeedWithParser parseXMLDoc---- | 'readRSS2 elt' tries to derive an RSS2.x, RSS-0.9x feed document--- from the XML element @e@.-readRSS2 :: XML.Element -> Maybe Feed-readRSS2 e = fmap RSSFeed $ RSS.elementToRSS e---- | 'readRSS1 elt' tries to derive an RSS1.0 feed document--- from the XML element @e@.-readRSS1 :: XML.Element -> Maybe Feed-readRSS1 e = fmap RSS1Feed $ RSS1.elementToFeed e---- | 'readAtom elt' tries to derive an Atom feed document--- from the XML element @e@.-readAtom :: XML.Element -> Maybe Feed-readAtom e = fmap AtomFeed $ Atom.elementFeed e-
− Text/Feed/Query.hs
@@ -1,427 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.Feed.Query--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability: portable---------------------------------------------------------------------------module Text.Feed.Query- ( Text.Feed.Query.feedItems -- :: Feed.Feed -> [Feed.Item]-- , FeedGetter -- type _ a = Feed -> a- , getFeedTitle -- :: FeedGetter String- , getFeedAuthor -- :: FeedGetter String- , getFeedHome -- :: FeedGetter URLString- , getFeedHTML -- :: FeedGetter URLString- , getFeedDescription -- :: FeedGetter String- , getFeedPubDate -- :: FeedGetter DateString- , getFeedLastUpdate -- :: FeedGetter (Maybe String)- , getFeedDate -- :: FeedGetter DateString- , getFeedLogoLink -- :: FeedGetter URLString- , getFeedLanguage -- :: FeedGetter String- , getFeedCategories -- :: FeedGetter [(String, Maybe String)]- , getFeedGenerator -- :: FeedGetter String- , getFeedItems -- :: FeedGetter [Item]-- , ItemGetter -- type _ a = Item -> Maybe a- , getItemTitle -- :: ItemGetter (String)- , getItemLink -- :: ItemGetter (String)- , getItemPublishDate -- :: Data.Time.ParseTime t => ItemGetter (Maybe t)- , getItemPublishDateString -- :: ItemGetter (DateString)- , getItemDate -- :: ItemGetter (DateString)- , getItemAuthor -- :: ItemGetter (String)- , getItemCommentLink -- :: ItemGetter (URLString)- , getItemEnclosure -- :: ItemGetter (String,Maybe String,Integer)- , getItemFeedLink -- :: ItemGetter (URLString)- , getItemId -- :: ItemGetter (Bool,String)- , getItemCategories -- :: ItemGetter [String]- , getItemRights -- :: ItemGetter String- , getItemSummary -- :: ItemGetter String- , getItemDescription -- :: ItemGetter String (synonym of previous.)-- ) where--import Text.Feed.Types as Feed--import Text.RSS.Syntax as RSS-import Text.Atom.Feed as Atom-import Text.RSS1.Syntax as RSS1-import Text.XML.Light as XML--import Text.DublinCore.Types--import Control.Monad ( mplus )-import Data.List-import Data.Maybe---- for getItemPublishDate rfc822 date parsing.-import System.Locale ( rfc822DateFormat, iso8601DateFormat )-import Data.Time.Locale.Compat ( defaultTimeLocale )-import Data.Time.Format ( ParseTime, parseTime )--feedItems :: Feed.Feed -> [Feed.Item]-feedItems fe =- case fe of- AtomFeed f -> map Feed.AtomItem (Atom.feedEntries f)- RSSFeed f -> map Feed.RSSItem (RSS.rssItems $ RSS.rssChannel f)- RSS1Feed f -> map Feed.RSS1Item (RSS1.feedItems f)- -- ToDo: look for 'entry' elements if 'items' are missing..- XMLFeed f -> map Feed.XMLItem $ XML.findElements (XML.unqual "item") f---getFeedItems :: Feed.Feed -> [Feed.Item]-getFeedItems = Text.Feed.Query.feedItems--type FeedGetter a = Feed.Feed -> Maybe a--getFeedAuthor :: FeedGetter String-getFeedAuthor ft =- case ft of- Feed.AtomFeed f -> fmap Atom.personName $ listToMaybe $ Atom.feedAuthors f- Feed.RSSFeed f -> RSS.rssEditor (RSS.rssChannel f)- Feed.RSS1Feed f -> fmap dcText $ listToMaybe $ filter isAuthor $ RSS1.channelDC (RSS1.feedChannel f)- Feed.XMLFeed f ->- case findElement (unqual "channel") f of- Just e1 -> fmap XML.strContent $ findElement (unqual "editor") e1- Nothing -> Nothing- where- isAuthor dc = dcElt dc == DC_Creator--getFeedTitle :: Feed.Feed -> String-getFeedTitle ft =- case ft of- Feed.AtomFeed f -> contentToStr $ Atom.feedTitle f- Feed.RSSFeed f -> RSS.rssTitle (RSS.rssChannel f)- Feed.RSS1Feed f -> RSS1.channelTitle (RSS1.feedChannel f)- Feed.XMLFeed f ->- case findElement (unqual "channel") f of- Just e1 -> fromMaybe "" (fmap XML.strContent $ findElement (unqual "title") e1)- Nothing -> ""--getFeedHome :: FeedGetter URLString-getFeedHome ft =- case ft of- Feed.AtomFeed f -> fmap Atom.linkHref $ listToMaybe $ filter isSelf (Atom.feedLinks f)- Feed.RSSFeed f -> Just (RSS.rssLink (RSS.rssChannel f))- Feed.RSS1Feed f -> Just (RSS1.channelURI (RSS1.feedChannel f))- Feed.XMLFeed f ->- case findElement (unqual "channel") f of- Just e1 -> fmap XML.strContent $ findElement (unqual "link") e1- Nothing -> Nothing- where- isSelf lr = toStr (Atom.linkRel lr) == "self"--getFeedHTML :: FeedGetter URLString-getFeedHTML ft =- case ft of- Feed.AtomFeed f -> fmap Atom.linkHref $ listToMaybe $ filter isSelf (Atom.feedLinks f)- Feed.RSSFeed f -> Just (RSS.rssLink (RSS.rssChannel f))- Feed.RSS1Feed f -> Just (RSS1.channelURI (RSS1.feedChannel f))- Feed.XMLFeed f ->- case findElement (unqual "channel") f of- Just e1 -> fmap XML.strContent $ findElement (unqual "link") e1- Nothing -> Nothing- where- isSelf lr = toStr (Atom.linkRel lr) == "alternate" && isHTMLType (linkType lr)-- isHTMLType (Just str) = "lmth" `isPrefixOf` (reverse str)- isHTMLType _ = True -- if none given, assume html.--getFeedDescription :: FeedGetter String-getFeedDescription ft =- case ft of- Feed.AtomFeed f -> fmap contentToStr (Atom.feedSubtitle f)- Feed.RSSFeed f -> Just $ RSS.rssDescription (RSS.rssChannel f)- Feed.RSS1Feed f -> Just (RSS1.channelDesc (RSS1.feedChannel f))- Feed.XMLFeed f ->- case findElement (unqual "channel") f of- Just e1 -> fmap XML.strContent $ findElement (unqual "description") e1- Nothing -> Nothing--getFeedPubDate :: FeedGetter DateString-getFeedPubDate ft =- case ft of- Feed.AtomFeed f -> Just $ Atom.feedUpdated f- Feed.RSSFeed f -> RSS.rssPubDate (RSS.rssChannel f)- Feed.RSS1Feed f -> fmap dcText $ listToMaybe $ filter isDate (RSS1.channelDC $ RSS1.feedChannel f)- Feed.XMLFeed f ->- case findElement (unqual "channel") f of- Just e1 -> fmap XML.strContent $ findElement (unqual "pubDate") e1- Nothing -> Nothing- where- isDate dc = dcElt dc == DC_Date--getFeedLastUpdate :: FeedGetter (String)-getFeedLastUpdate ft =- case ft of- Feed.AtomFeed f -> Just $ Atom.feedUpdated f- Feed.RSSFeed f -> RSS.rssPubDate (RSS.rssChannel f)- Feed.RSS1Feed f -> fmap dcText $ listToMaybe $ filter isDate (RSS1.channelDC $ RSS1.feedChannel f)- Feed.XMLFeed f ->- case findElement (unqual "channel") f of- Just e1 -> fmap XML.strContent $ findElement (unqual "pubDate") e1- Nothing -> Nothing- where- isDate dc = dcElt dc == DC_Date--getFeedDate :: FeedGetter DateString-getFeedDate ft = getFeedPubDate ft--getFeedLogoLink :: FeedGetter URLString-getFeedLogoLink ft =- case ft of- Feed.AtomFeed f -> Atom.feedLogo f- Feed.RSSFeed f -> fmap RSS.rssImageURL (RSS.rssImage $ RSS.rssChannel f)- Feed.RSS1Feed f -> (fmap RSS1.imageURI $ RSS1.feedImage f)- Feed.XMLFeed f -> do- ch <- findElement (unqual "channel") f- e1 <- findElement (unqual "image") ch- v <- findElement (unqual "url") e1- return (XML.strContent v)--getFeedLanguage :: FeedGetter String-getFeedLanguage ft =- case ft of- Feed.AtomFeed f ->- lookupAttr (unqual "lang"){qPrefix=Just "xml"} (Atom.feedAttrs f)- Feed.RSSFeed f -> RSS.rssLanguage (RSS.rssChannel f)- Feed.RSS1Feed f -> fmap dcText $ listToMaybe $ filter isLang (RSS1.channelDC $ RSS1.feedChannel f)- Feed.XMLFeed f -> do- ch <- findElement (unqual "channel") f- e1 <- findElement (unqual "language") ch- return (XML.strContent e1)- where- isLang dc = dcElt dc == DC_Language---getFeedCategories :: Feed.Feed -> [(String, Maybe String)]-getFeedCategories ft =- case ft of- Feed.AtomFeed f -> map (\ c -> (Atom.catTerm c, Atom.catScheme c)) (Atom.feedCategories f)- Feed.RSSFeed f -> map (\ c -> (RSS.rssCategoryValue c, RSS.rssCategoryDomain c)) (RSS.rssCategories (RSS.rssChannel f))- Feed.RSS1Feed f ->- case filter isCat (RSS1.channelDC $ RSS1.feedChannel f) of- ls -> map (\ l -> (dcText l,Nothing)) ls- Feed.XMLFeed f ->- case fromMaybe [] $ fmap (XML.findElements (XML.unqual "category")) (findElement (unqual "channel") f) of- ls -> map (\ l -> (fromMaybe "" (fmap XML.strContent $ findElement (unqual "term") l), findAttr (unqual "domain") l)) ls- where- isCat dc = dcElt dc == DC_Subject--getFeedGenerator :: FeedGetter String-getFeedGenerator ft =- case ft of- Feed.AtomFeed f -> do- gen <- Atom.feedGenerator f- Atom.genURI gen- Feed.RSSFeed f -> RSS.rssGenerator (RSS.rssChannel f)- Feed.RSS1Feed f -> fmap dcText $ listToMaybe $ filter isSource (RSS1.channelDC (RSS1.feedChannel f))- Feed.XMLFeed f -> do- ch <- findElement (unqual "channel") f- e1 <- findElement (unqual "generator") ch- return (XML.strContent e1)- where- isSource dc = dcElt dc == DC_Source--type ItemGetter a = Feed.Item -> Maybe a--getItemTitle :: ItemGetter String-getItemTitle it =- case it of- Feed.AtomItem i -> Just (contentToStr $ Atom.entryTitle i)- Feed.RSSItem i -> RSS.rssItemTitle i- Feed.RSS1Item i -> Just (RSS1.itemTitle i)- Feed.XMLItem e -> fmap XML.strContent $ findElement (unqual "title") e--getItemLink :: ItemGetter String-getItemLink it =- case it of- -- look up the 'alternate' HTML link relation on the entry:- Feed.AtomItem i -> fmap Atom.linkHref $ listToMaybe $ filter isSelf $ Atom.entryLinks i- Feed.RSSItem i -> RSS.rssItemLink i- Feed.RSS1Item i -> Just (RSS1.itemLink i)- Feed.XMLItem i -> fmap (\ ei -> XML.strContent ei) $ findElement (unqual "link") i- where- isSelf lr = toStr (Atom.linkRel lr) == "alternate" && isHTMLType (linkType lr)-- isHTMLType (Just str) = "lmth" `isPrefixOf` (reverse str)- isHTMLType _ = True -- if none given, assume html.----- | 'getItemPublishDate item' returns the publication date of the item,--- but first parsed per the supported RFC 822 and RFC 3339 formats.------ If the date string cannot be parsed as such, Just Nothing is--- returned. The caller must then instead fall back to processing the--- date string from 'getItemPublishDateString'.------ The parsed date representation is one of the ParseTime instances;--- see 'Data.Time.Format'.-getItemPublishDate :: ParseTime t => ItemGetter (Maybe t)-getItemPublishDate it = do- ds <- getItemPublishDateString it- let- rfc3339DateFormat1 = iso8601DateFormat (Just "%H:%M:%S%Z")- rfc3339DateFormat2 = iso8601DateFormat (Just "%H:%M:%S%Q%Z")-- formats = [ rfc3339DateFormat1, rfc3339DateFormat2, rfc822DateFormat ]-- date = foldl1 mplus (map (\ fmt -> parseTime defaultTimeLocale fmt ds) formats)- return date--getItemPublishDateString :: ItemGetter DateString-getItemPublishDateString it =- case it of- Feed.AtomItem i -> Just $ Atom.entryUpdated i- Feed.RSSItem i -> RSS.rssItemPubDate i- Feed.RSS1Item i -> fmap dcText $ listToMaybe $ filter isDate $ RSS1.itemDC i- -- ToDo: look for it in Atom \/ RSS1 like-content as well if no 'pubDate' element.- Feed.XMLItem e -> fmap XML.strContent $ findElement (unqual "pubDate") e- where- isDate dc = dcElt dc == DC_Date--getItemDate :: ItemGetter DateString-getItemDate it = getItemPublishDateString it---- | 'getItemAuthor f' returns the optional author of the item.-getItemAuthor :: ItemGetter String-getItemAuthor it =- case it of- Feed.AtomItem i -> fmap Atom.personName $ listToMaybe $ Atom.entryAuthors i- Feed.RSSItem i -> RSS.rssItemAuthor i- Feed.RSS1Item i -> fmap dcText $ listToMaybe $ filter isAuthor $ RSS1.itemDC i- Feed.XMLItem e -> fmap XML.strContent $ findElement (unqual "author") e- where- isAuthor dc = dcElt dc == DC_Creator--getItemCommentLink :: ItemGetter URLString-getItemCommentLink it =- case it of- -- look up the 'replies' HTML link relation on the entry:- Feed.AtomItem e -> fmap Atom.linkHref $ listToMaybe $ filter isReplies $ Atom.entryLinks e- Feed.RSSItem i -> RSS.rssItemComments i- Feed.RSS1Item i -> fmap dcText $ listToMaybe $ filter isRel $ RSS1.itemDC i- Feed.XMLItem i -> fmap (\ ei -> XML.strContent ei) $ findElement (unqual "comments") i- where- isReplies lr = toStr (Atom.linkRel lr) == "replies"- isRel dc = dcElt dc == DC_Relation--getItemEnclosure :: ItemGetter (String, Maybe String, Maybe Integer)-getItemEnclosure it =- case it of- Feed.AtomItem e ->- case filter isEnc $ Atom.entryLinks e of- (l:_) -> Just (Atom.linkHref l,- Atom.linkType l,- readLength (Atom.linkLength l))- _ -> Nothing- Feed.RSSItem i ->- fmap (\ e -> (RSS.rssEnclosureURL e, Just (RSS.rssEnclosureType e), RSS.rssEnclosureLength e))- (RSS.rssItemEnclosure i)- Feed.RSS1Item i ->- case RSS1.itemContent i of- [] -> Nothing- (c:_) -> Just (fromMaybe "" (RSS1.contentURI c), RSS1.contentFormat c, Nothing)- Feed.XMLItem e -> fmap xmlToEnclosure (findElement (unqual "enclosure") e)- where- isEnc lr = toStr (Atom.linkRel lr) == "enclosure"-- readLength Nothing = Nothing- readLength (Just str) =- case reads str of- [] -> Nothing- ((v,_):_) -> Just v-- xmlToEnclosure e =- ( fromMaybe "" (findAttr (unqual "url") e)- , findAttr (unqual "type") e- , readLength $ findAttr (unqual "length") e- )--getItemFeedLink :: ItemGetter URLString-getItemFeedLink it =- case it of- Feed.AtomItem e ->- case (Atom.entrySource e) of- Nothing -> Nothing- Just s -> Atom.sourceId s- Feed.RSSItem i ->- case (RSS.rssItemSource i) of- Nothing -> Nothing- Just s -> Just (RSS.rssSourceURL s)- Feed.RSS1Item _ -> Nothing- Feed.XMLItem e ->- case findElement (unqual "source") e of- Nothing -> Nothing- Just s -> fmap XML.strContent (findElement (unqual "url") s)--getItemId :: ItemGetter (Bool,String)-getItemId it =- case it of- Feed.AtomItem e -> Just (True, Atom.entryId e)- Feed.RSSItem i ->- case RSS.rssItemGuid i of- Nothing -> Nothing- Just ig -> Just (fromMaybe True (RSS.rssGuidPermanentURL ig), RSS.rssGuidValue ig)- Feed.RSS1Item i ->- case filter isId (RSS1.itemDC i) of- (l:_) -> Just (True,dcText l)- _ -> Nothing- Feed.XMLItem e ->- fmap (\ e1 -> (True,XML.strContent e1)) (findElement (unqual "guid") e)- where- isId dc = dcElt dc == DC_Identifier--getItemCategories :: Feed.Item -> [String]-getItemCategories it =- case it of- Feed.AtomItem i -> map Atom.catTerm $ Atom.entryCategories i- Feed.RSSItem i -> map RSS.rssCategoryValue $ RSS.rssItemCategories i- Feed.RSS1Item i -> concat $ getCats1 i- Feed.XMLItem i -> map XML.strContent $ XML.findElements (XML.unqual "category") i- where- -- get RSS1 categories; either via DublinCore's subject (or taxonomy topics...not yet.)- getCats1 i1 =- map (words.dcText) $ filter (\ dc -> dcElt dc == DC_Subject) $ RSS1.itemDC i1---getItemRights :: ItemGetter String-getItemRights it =- case it of- Feed.AtomItem e -> fmap contentToStr $ Atom.entryRights e- Feed.RSSItem _ -> Nothing- Feed.RSS1Item i -> fmap dcText $ listToMaybe $ filter isRights (RSS1.itemDC i)- Feed.XMLItem _ -> Nothing- where- isRights dc = dcElt dc == DC_Rights--getItemSummary :: ItemGetter String-getItemSummary it = getItemDescription it--getItemDescription :: ItemGetter String-getItemDescription it =- case it of- Feed.AtomItem e -> fmap contentToStr $ Atom.entrySummary e- Feed.RSSItem e -> RSS.rssItemDescription e- Feed.RSS1Item i -> itemDesc i- Feed.XMLItem _ -> Nothing-- -- strip away-toStr :: Maybe (Either String String) -> String-toStr Nothing = ""-toStr (Just (Left x)) = x-toStr (Just (Right x)) = x--contentToStr :: TextContent -> String-contentToStr x =- case x of- Atom.TextString s -> s- Atom.HTMLString s -> s- Atom.XHTMLString s -> XML.strContent s
− Text/Feed/Translate.hs
@@ -1,134 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.Feed.Translate--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability: portable------ Translating between RSS formats; work in progress.----module Text.Feed.Translate- ( translateItemTo -- :: FeedKind -> Item -> Item- , withAtomEntry -- :: (Atom.Entry -> Atom.Entry) -> Item -> Item- , withRSSItem -- :: (RSS.RSSItem -> RSS.RSSItem) -> Item -> Item- , withRSS1Item -- :: (RSS1.Item -> RSS1.Item) -> Item -> Item- ) where--import Text.Feed.Types as Feed-import Text.Feed.Constructor--import Text.RSS.Syntax as RSS-import qualified Text.RSS1.Syntax as RSS1-import Text.Atom.Feed as Atom--import Data.Maybe ( fromMaybe )---- functions for performing format-specific transformations.--- If the item isn't in the of-interest format, no transformation--- is performed (i.e., no on-the-fly translation into the requested--- format is performed; the caller is responsible-----withAtomEntry :: (Atom.Entry -> Atom.Entry) -> Item -> Item-withAtomEntry f it =- case it of- Feed.AtomItem e -> Feed.AtomItem (f e)- _ -> it--withRSSItem :: (RSS.RSSItem -> RSS.RSSItem) -> Item -> Item-withRSSItem f it =- case it of- Feed.RSSItem e -> Feed.RSSItem (f e)- _ -> it--withRSS1Item :: (RSS1.Item -> RSS1.Item) -> Item -> Item-withRSS1Item f it =- case it of- Feed.RSS1Item e -> Feed.RSS1Item (f e)- _ -> it--translateItemTo :: FeedKind -> Item -> Item-translateItemTo fk it =- case fk of- AtomKind -> toAtomItem it- RSSKind v -> toRSSItem v it- RDFKind v -> toRDFItem v it--toRSSItem :: Maybe String -> Item -> Item-toRSSItem = error "toRSSItem: unimplemented"--toRDFItem :: Maybe String -> Item -> Item-toRDFItem = error "toRDFItem: unimplemented"--toAtomItem :: Item -> Item-toAtomItem it =- case it of- AtomItem{} -> it- RSS1Item{} -> error "toAtomItem: unimplemented (from RSS1 item rep.)"- XMLItem{} -> error "toAtomItem: unimplemented (from shallow XML rep.)"- Feed.RSSItem ri -> foldl (\ oi f -> f oi) outIt pipeline_rss_atom- where- outIt =- (flip withAtomEntry) (newItem AtomKind)- (\ e -> e{ Atom.entryOther = RSS.rssItemOther ri- , Atom.entryAttrs = RSS.rssItemAttrs ri- })-- pipeline_rss_atom =- [ mb withItemTitle (rssItemTitle ri)- , mb withItemLink (rssItemLink ri)- , mb withItemDescription (rssItemDescription ri)- , mb withItemAuthor (rssItemAuthor ri)- , ls withItemCategories (rssItemCategories ri)- , mb withItemId' (rssItemGuid ri)- , mb withItemCommentLink (rssItemComments ri)- , mb withItemEnclosure' (rssItemEnclosure ri)- , mb withItemPubDate (rssItemPubDate ri)- ]-- withItemEnclosure' e =- withItemEnclosure (rssEnclosureURL e)- (Just $ rssEnclosureType e)- (rssEnclosureLength e)- withItemId' g = withItemId (fromMaybe True (rssGuidPermanentURL g)) (rssGuidValue g)-- mb _ Nothing = id- mb f (Just v) = f v-- ls _ [] = id- -- hack, only used for cats, so specialize:- ls f xs = f (map (\ c -> (rssCategoryValue c, rssCategoryDomain c)) xs)--{-- pipeline_rss_atom =- [ withItemTitle (rssItemTitle ri)- , withItemLink (rssLink ri)- , withDescription (rssDescription ri)- , \ inp -> mb (\ la -> inp{feedLanguage=...}) (rssLanguage ri)- , \ inp -> mb (\ ed -> inp{feedAuthors=[nullPerson{personName=ed}]})- (rssEditor ri)- , \ inp -> mb (\ ed -> inp{feedAuthors=[nullPerson{personName=ed}]})- (rssWebMaster ri)- , \ inp -> mb (\ pu -> withPubDate)- (rssPubDate ri)- , \ inp -> mb withLastUpdate- (rssLastUpdate ri)- , \ inp -> withCategories (map (\c -> (RSS.rssCategoryValue c, RSS.rssCategoryDomain c))- (rssCategories ri)) inp- , \ inp -> mb withGenerator- (rssGenerator ri)- , rssDocs- , rssCloud- , rssTTL- , rssImage- , rssRating- , rssTextInput- , rssSkipHours- , rssSkipDays- }- in--}
− Text/Feed/Types.hs
@@ -1,49 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.Feed.Types--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability: portable--------------------------------------------------------------------------module Text.Feed.Types where--import Text.RSS.Syntax as RSS-import Text.Atom.Feed as Atom-import Text.RSS1.Syntax as RSS1-import Text.XML.Light as XML---- | The abstract type of feed documents. The internal representation--- is as whatever feed variant type the document was either imported or--- has now been translated to.-data Feed- = AtomFeed Atom.Feed- | RSSFeed RSS.RSS- | RSS1Feed RSS1.Feed- -- if we're unable to correctly the well-formed XML as a feed,- -- keep it as an untyped document.- | XMLFeed XML.Element- deriving (Show)---- | The abstract type of feed items. Like the 'Text.Feed.Types.Feed' type, the--- representation of a value is as one of the different RSS item\/entry--- variants.-data Item- = AtomItem Atom.Entry- | RSSItem RSS.RSSItem- | RSS1Item RSS1.Item- | XMLItem XML.Element- deriving (Show)---- | The kinds of feed documents supported.-data FeedKind- = AtomKind- | RSSKind (Maybe String) -- Nothing => default version (2.0)- | RDFKind (Maybe String) -- Nothing => default version (1.0)- deriving (Eq, Show)-
− Text/Feed/Util.hs
@@ -1,26 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.Feed.Util--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability: portable-------------------------------------------------------------------------module Text.Feed.Util where--import Text.Feed.Types-import System.Time-import System.Locale---- | 'toFeedDate' translates a calendar time into--- the format expected by the feed kind.-toFeedDateString :: FeedKind -> ClockTime -> {-Date-}String-toFeedDateString fk ct =- case fk of- AtomKind{} -> formatCalendarTime defaultTimeLocale "%Y-%m-%dT%H:%M:%sZ" (toUTCTime ct)- RSSKind{} -> formatCalendarTime defaultTimeLocale "%a, %d %b %Y %H:%m:%s GMT" (toUTCTime ct)- RDFKind{} -> formatCalendarTime defaultTimeLocale "%Y-%m-%dT%H:%M:%sZ" (toUTCTime ct)
− Text/RSS/Export.hs
@@ -1,173 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.RSS.Export--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Description: Convert from RSS to XML---------------------------------------------------------------------------module Text.RSS.Export where--import Text.XML.Light as XML-import Text.RSS.Syntax--import Data.Maybe--qualNode :: String -> [XML.Content] -> XML.Element-qualNode n cs =- blank_element- { elName = qualName n- , elContent = cs- }--qualName :: String -> QName-qualName n = QName{qName=n,qURI=Nothing,qPrefix=Nothing}------xmlRSS :: RSS -> XML.Element-xmlRSS r =- (qualNode "rss" $ map Elem $- ( [ xmlChannel (rssChannel r) ]- ++ rssOther r))- { elAttribs = (Attr (qualName "version") (rssVersion r)):rssAttrs r }--xmlChannel :: RSSChannel -> XML.Element-xmlChannel ch =- (qualNode "channel" $ map Elem $- ( [ xmlLeaf "title" (rssTitle ch)- , xmlLeaf "link" (rssLink ch)- , xmlLeaf "description" (rssDescription ch)- ]- ++ map xmlItem (rssItems ch)- ++ mb (xmlLeaf "language") (rssLanguage ch)- ++ mb (xmlLeaf "copyright") (rssCopyright ch)- ++ mb (xmlLeaf "managingEditor") (rssEditor ch)- ++ mb (xmlLeaf "webMaster") (rssWebMaster ch)- ++ mb (xmlLeaf "pubDate") (rssPubDate ch)- ++ mb (xmlLeaf "lastBuildDate") (rssLastUpdate ch)- ++ map xmlCategory (rssCategories ch)- ++ mb (xmlLeaf "generator") (rssGenerator ch)- ++ mb (xmlLeaf "docs") (rssDocs ch)- ++ mb xmlCloud (rssCloud ch)- ++ mb ((xmlLeaf "ttl") . show) (rssTTL ch)- ++ mb xmlImage (rssImage ch)- ++ mb (xmlLeaf "rating") (rssRating ch)- ++ mb xmlTextInput (rssTextInput ch)- ++ mb xmlSkipHours (rssSkipHours ch)- ++ mb xmlSkipDays (rssSkipDays ch)- ++ rssChannelOther ch))--xmlItem :: RSSItem -> XML.Element-xmlItem it =- (qualNode "item" $ map Elem $- ( mb (xmlLeaf "title") (rssItemTitle it)- ++ mb (xmlLeaf "link") (rssItemLink it)- ++ mb (xmlLeaf "description") (rssItemDescription it)- ++ mb (xmlLeaf "author") (rssItemAuthor it)- ++ map xmlCategory (rssItemCategories it)- ++ mb (xmlLeaf "comments") (rssItemComments it)- ++ mb xmlEnclosure (rssItemEnclosure it)- ++ mb xmlGuid (rssItemGuid it)- ++ mb (xmlLeaf "pubDate") (rssItemPubDate it)- ++ mb xmlSource (rssItemSource it)- ++ rssItemOther it))- { elAttribs = rssItemAttrs it }--xmlSource :: RSSSource -> XML.Element-xmlSource s =- (xmlLeaf "source" (rssSourceTitle s))- { elAttribs = (Attr (qualName "url") (rssSourceURL s)) :- rssSourceAttrs s }--xmlEnclosure :: RSSEnclosure -> XML.Element-xmlEnclosure e =- (xmlLeaf "enclosure" "")- { elAttribs =- (Attr (qualName "url") (rssEnclosureURL e)) :- (Attr (qualName "length") (show $ rssEnclosureLength e)) :- (Attr (qualName "type") (rssEnclosureType e)) :- rssEnclosureAttrs e }--xmlCategory :: RSSCategory -> XML.Element-xmlCategory c =- (xmlLeaf "category" (rssCategoryValue c))- { elAttribs =- (fromMaybe id (fmap (\ n -> ((Attr (qualName "domain") n):))- (rssCategoryDomain c))) $- (rssCategoryAttrs c) }--xmlGuid :: RSSGuid -> XML.Element-xmlGuid g =- (xmlLeaf "guid" (rssGuidValue g))- { elAttribs =- (fromMaybe id (fmap (\ n -> ((Attr (qualName "isPermaLink") (toBool n)):))- (rssGuidPermanentURL g))) $- (rssGuidAttrs g) }- where- toBool False = "false"- toBool _ = "true"--xmlImage :: RSSImage -> XML.Element-xmlImage im =- (qualNode "image" $ map Elem $- ( [ xmlLeaf "url" (rssImageURL im)- , xmlLeaf "title" (rssImageTitle im)- , xmlLeaf "link" (rssImageLink im)- ]- ++ mb ((xmlLeaf "width") . show) (rssImageWidth im)- ++ mb ((xmlLeaf "height") . show) (rssImageHeight im)- ++ mb (xmlLeaf "description") (rssImageDesc im)- ++ rssImageOther im))--xmlCloud :: RSSCloud -> XML.Element-xmlCloud cl =- (xmlLeaf "cloud" "")- { elAttribs =- ( mb (Attr (qualName "domain")) (rssCloudDomain cl)- ++ mb (Attr (qualName "port")) (rssCloudPort cl)- ++ mb (Attr (qualName "path")) (rssCloudPath cl)- ++ mb (Attr (qualName "register")) (rssCloudRegister cl)- ++ mb (Attr (qualName "protocol")) (rssCloudProtocol cl)- ++ rssCloudAttrs cl) }--xmlTextInput :: RSSTextInput -> XML.Element-xmlTextInput ti =- (qualNode "textInput" $ map Elem $- ( [ xmlLeaf "title" (rssTextInputTitle ti)- , xmlLeaf "description" (rssTextInputDesc ti)- , xmlLeaf "name" (rssTextInputName ti)- , xmlLeaf "link" (rssTextInputLink ti)- ] ++ rssTextInputOther ti))- { elAttribs = rssTextInputAttrs ti }--xmlSkipHours :: [Integer] -> XML.Element-xmlSkipHours hs =- (qualNode "skipHours" $ map Elem $- (map (\ n -> xmlLeaf "hour" (show n)) hs))--xmlSkipDays :: [String] -> XML.Element-xmlSkipDays hs =- (qualNode "skipDayss" $ map Elem $- (map (\ n -> xmlLeaf "day" n) hs))------xmlAttr :: String -> String -> XML.Attr-xmlAttr k v = Attr (qualName k) v--xmlLeaf :: String -> String -> XML.Element-xmlLeaf tg txt =- blank_element{ elName = qualName tg- , elContent = [ Text blank_cdata { cdData = txt } ]- }------mb :: (a -> b) -> Maybe a -> [b]-mb _ Nothing = []-mb f (Just x) = [f x]
− Text/RSS/Import.hs
@@ -1,277 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.RSS.Import--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional------ Converting from XML to RSS--------------------------------------------------------------------------module Text.RSS.Import where--import Text.RSS.Syntax-import Text.RSS1.Utils ( dcNS, dcPrefix )-import Text.XML.Light as XML--import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)-import Data.Char (isSpace )-import Control.Monad (guard,mplus)--pNodes :: String -> [XML.Element] -> [XML.Element]-pNodes x es = filter ((qualName x ==) . elName) es--pQNodes :: QName -> [XML.Element] -> [XML.Element]-pQNodes x es = filter ((x==) . elName) es--pNode :: String -> [XML.Element] -> Maybe XML.Element-pNode x es = listToMaybe (pNodes x es)--pQNode :: QName -> [XML.Element] -> Maybe XML.Element-pQNode x es = listToMaybe (pQNodes x es)--pLeaf :: String -> [XML.Element] -> Maybe String-pLeaf x es = strContent `fmap` pNode x es--pQLeaf :: QName -> [XML.Element] -> Maybe String-pQLeaf x es = strContent `fmap` (pQNode x es)--pAttr :: String -> XML.Element -> Maybe String-pAttr x e = lookup (qualName x) [ (k,v) | Attr k v <- elAttribs e ]--pMany :: String -> (XML.Element -> Maybe a) -> [XML.Element] -> [a]-pMany p f es = mapMaybe f (pNodes p es)--children :: XML.Element -> [XML.Element]-children e = onlyElems (elContent e)--qualName :: String -> QName-qualName x = QName{qName=x,qURI=Nothing,qPrefix=Nothing}--dcName :: String -> QName-dcName x = blank_name{qName=x,qURI=dcNS,qPrefix=dcPrefix}--elementToRSS :: XML.Element -> Maybe RSS-elementToRSS e = do- guard (elName e == qualName "rss")- let es = children e- let as = elAttribs e- v <- pAttr "version" e- ch <- pNode "channel" es >>= elementToChannel- return RSS- { rssVersion = v- , rssAttrs = filter (\ a -> not (qName (attrKey a) `elem` known_attrs)) as- , rssChannel = ch- , rssOther = filter (\ e1 -> elName e1 /= qualName "channel") es- }- where- known_attrs = ["version"]--elementToChannel :: XML.Element -> Maybe RSSChannel-elementToChannel e = do- guard (elName e == qualName "channel")- let es = children e- title <- pLeaf "title" es- link <- pLeaf "link" es- return RSSChannel- { rssTitle = title- , rssLink = link- -- being liberal, <description/> is a required channel element.- , rssDescription = fromMaybe title (pLeaf "description" es)- , rssItems = pMany "item" elementToItem es- , rssLanguage = pLeaf "language" es `mplus` pQLeaf (dcName "lang") es- , rssCopyright = pLeaf "copyright" es- , rssEditor = pLeaf "managingEditor" es `mplus` pQLeaf (dcName "creator") es- , rssWebMaster = pLeaf "webMaster" es- , rssPubDate = pLeaf "pubDate" es `mplus` pQLeaf (dcName "date") es- , rssLastUpdate = pLeaf "lastBuildDate" es `mplus` pQLeaf (dcName "date") es- , rssCategories = pMany "category" elementToCategory es- , rssGenerator = pLeaf "generator" es `mplus` pQLeaf (dcName "source") es- , rssDocs = pLeaf "docs" es- , rssCloud = pNode "cloud" es >>= elementToCloud- , rssTTL = pLeaf "ttl" es >>= readInt- , rssImage = pNode "image" es >>= elementToImage- , rssRating = pLeaf "rating" es- , rssTextInput = pNode "textInput" es >>= elementToTextInput- , rssSkipHours = pNode "skipHours" es >>= elementToSkipHours- , rssSkipDays = pNode "skipDays" es >>= elementToSkipDays- , rssChannelOther = filter (\ e1 -> not (elName e1 `elem` known_channel_elts)) es- }- where- known_channel_elts = map qualName- [ "title", "link", "description"- , "item", "language", "copyright"- , "managingEditor", "webMaster"- , "pubDate", "lastBuildDate"- , "category", "generator", "docs"- , "cloud", "ttl", "image"- , "rating", "textInput"- , "skipHours", "skipDays"- ]--elementToImage :: XML.Element -> Maybe RSSImage-elementToImage e = do- guard (elName e == qualName "image")- let es = children e- url <- pLeaf "url" es- title <- pLeaf "title" es- link <- pLeaf "link" es- return RSSImage- { rssImageURL = url- , rssImageTitle = title- , rssImageLink = link- , rssImageWidth = pLeaf "width" es >>= readInt- , rssImageHeight = pLeaf "height" es >>= readInt- , rssImageDesc = pLeaf "description" es- , rssImageOther = filter (\ e1 -> not (elName e1 `elem` known_image_elts)) es- }- where- known_image_elts = map qualName- [ "url", "title", "link"- , "width", "height", "description"- ]--elementToCategory :: XML.Element -> Maybe RSSCategory-elementToCategory e = do- guard (elName e == qualName "category")- let as = elAttribs e- return RSSCategory- { rssCategoryDomain = pAttr "domain" e- , rssCategoryAttrs = filter (\ a -> not (qName (attrKey a) `elem` known_attrs)) as- , rssCategoryValue = strContent e- }- where- known_attrs = ["domain"]--elementToCloud :: XML.Element -> Maybe RSSCloud-elementToCloud e = do- guard (elName e == qualName "cloud")- let as = elAttribs e- return RSSCloud- { rssCloudDomain = pAttr "domain" e- , rssCloudPort = pAttr "port" e- , rssCloudPath = pAttr "path" e- , rssCloudRegister = pAttr "register" e- , rssCloudProtocol = pAttr "protocol" e- , rssCloudAttrs = filter (\ a -> not (qName (attrKey a) `elem` known_attrs)) as- }- where- known_attrs = [ "domain", "port", "path", "register", "protocol" ]--elementToItem :: XML.Element -> Maybe RSSItem-elementToItem e = do- guard (elName e == qualName "item")- let es = children e- return RSSItem- { rssItemTitle = pLeaf "title" es- , rssItemLink = pLeaf "link" es- , rssItemDescription = pLeaf "description" es- , rssItemAuthor = pLeaf "author" es `mplus` pQLeaf (dcName "creator") es- , rssItemCategories = pMany "category" elementToCategory es- , rssItemComments = pLeaf "comments" es- , rssItemEnclosure = pNode "enclosure" es >>= elementToEnclosure- , rssItemGuid = pNode "guid" es >>= elementToGuid- , rssItemPubDate = pLeaf "pubDate" es `mplus` pQLeaf (dcName "date") es- , rssItemSource = pNode "source" es >>= elementToSource- , rssItemAttrs = elAttribs e- , rssItemOther = filter (\ e1 -> not (elName e1 `elem` known_item_elts)) es- }- where- known_item_elts = map qualName- [ "title", "link", "description"- , "author", "category", "comments"- , "enclosure", "guid", "pubDate"- , "source"- ]--elementToSource :: XML.Element -> Maybe RSSSource-elementToSource e = do- guard (elName e == qualName "source")- let as = elAttribs e- url <- pAttr "url" e- return RSSSource- { rssSourceURL = url- , rssSourceAttrs = filter (\ a -> not (qName (attrKey a) `elem` known_attrs)) as- , rssSourceTitle = strContent e- }- where- known_attrs = [ "url" ]--elementToEnclosure :: XML.Element -> Maybe RSSEnclosure-elementToEnclosure e = do- guard (elName e == qualName "enclosure")- let as = elAttribs e- url <- pAttr "url" e- ty <- pAttr "type" e- return RSSEnclosure- { rssEnclosureURL = url- , rssEnclosureType = ty- , rssEnclosureLength = pAttr "length" e >>= readInt- , rssEnclosureAttrs = filter (\ a -> not (qName (attrKey a) `elem` known_attrs)) as- }- where- known_attrs = [ "url", "type", "length" ]--elementToGuid :: XML.Element -> Maybe RSSGuid-elementToGuid e = do- guard (elName e == qualName "guid")- let as = elAttribs e- return RSSGuid- { rssGuidPermanentURL = pAttr "isPermaLink" e >>= readBool- , rssGuidAttrs = filter (\ a -> not (qName (attrKey a) `elem` known_attrs)) as- , rssGuidValue = strContent e- }- where- known_attrs = ["isPermaLink"]--elementToTextInput :: XML.Element -> Maybe RSSTextInput-elementToTextInput e = do- guard (elName e == qualName "textInput")- let es = children e- title <- pLeaf "title" es- desc <- pLeaf "description" es- name <- pLeaf "name" es- link <- pLeaf "link" es- return RSSTextInput- { rssTextInputTitle = title- , rssTextInputDesc = desc- , rssTextInputName = name- , rssTextInputLink = link- , rssTextInputAttrs = elAttribs e- , rssTextInputOther = filter (\ e1 -> not (elName e1 `elem` known_ti_elts)) es- }- where- known_ti_elts = map qualName- ["title", "description", "name", "link"]--elementToSkipHours :: XML.Element -> Maybe [Integer]-elementToSkipHours e = do- guard (elName e == qualName "skipHours")- -- don't bother checking that this is below limit ( <= 24)- return (pMany "hour" (readInt.strContent) (children e))--elementToSkipDays :: XML.Element -> Maybe [String]-elementToSkipDays e = do- guard (elName e == qualName "skipDays")- -- don't bother checking that this is below limit ( <= 7)- return (pMany "day" (return . strContent) (children e))--------readInt :: String -> Maybe Integer-readInt s =- case reads s of- ((x,_):_) -> Just x- _ -> Nothing--readBool :: String -> Maybe Bool-readBool s =- case dropWhile isSpace s of- 't':'r':'u':'e':_ -> Just True- 'f':'a':'l':'s':'e':_ -> Just False- _ -> Nothing-
− Text/RSS/Syntax.hs
@@ -1,293 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.RSS.Syntax--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional------ The basic syntax for putting together feeds.------ For instance, to create a feed with a single item item:--- (nullRSS \"rss title\" \"link\") {rssChannel=(nullChannel \"channel title\" \"link\") {rssItems=[(nullItem \"item title\")]}}-------------------------------------------------------------------------module Text.RSS.Syntax where--import Text.XML.Light as XML---- * Core Types---- ^The Radio Userland version of RSS documents\/feeds.--- (versions 0.9x, 2.x)-data RSS- = RSS- { rssVersion :: String- , rssAttrs :: [XML.Attr]- , rssChannel :: RSSChannel- , rssOther :: [XML.Element]- }- deriving (Show)--type URLString = String--- | RFC 822 conforming.-type DateString = String--data RSSChannel- = RSSChannel- { rssTitle :: String- , rssLink :: URLString- , rssDescription :: String- , rssItems :: [RSSItem]- , rssLanguage :: Maybe String- , rssCopyright :: Maybe String- , rssEditor :: Maybe String- , rssWebMaster :: Maybe String- , rssPubDate :: Maybe DateString -- ^ rfc 822 conforming.- , rssLastUpdate :: Maybe DateString -- ^ rfc 822 conforming.- , rssCategories :: [RSSCategory]- , rssGenerator :: Maybe String- , rssDocs :: Maybe URLString- , rssCloud :: Maybe RSSCloud- , rssTTL :: Maybe Integer- , rssImage :: Maybe RSSImage- , rssRating :: Maybe String- , rssTextInput :: Maybe RSSTextInput- , rssSkipHours :: Maybe [Integer]- , rssSkipDays :: Maybe [String]- , rssChannelOther :: [XML.Element]- }- deriving (Show)--data RSSItem- = RSSItem- { rssItemTitle :: Maybe String- , rssItemLink :: Maybe URLString- , rssItemDescription :: Maybe String -- ^if not present, the title is. (per spec, at least.)- , rssItemAuthor :: Maybe String- , rssItemCategories :: [RSSCategory]- , rssItemComments :: Maybe URLString- , rssItemEnclosure :: Maybe RSSEnclosure- , rssItemGuid :: Maybe RSSGuid- , rssItemPubDate :: Maybe DateString- , rssItemSource :: Maybe RSSSource- , rssItemAttrs :: [XML.Attr]- , rssItemOther :: [XML.Element]- }- deriving (Show)--data RSSSource- = RSSSource- { rssSourceURL :: URLString- , rssSourceAttrs :: [XML.Attr]- , rssSourceTitle :: String- }- deriving (Show)--data RSSEnclosure- = RSSEnclosure- { rssEnclosureURL :: URLString- , rssEnclosureLength :: Maybe Integer- , rssEnclosureType :: String- , rssEnclosureAttrs :: [XML.Attr]- }- deriving (Show)--data RSSCategory- = RSSCategory- { rssCategoryDomain :: Maybe String- , rssCategoryAttrs :: [XML.Attr]- , rssCategoryValue :: String- }- deriving (Show)--data RSSGuid- = RSSGuid- { rssGuidPermanentURL :: Maybe Bool- , rssGuidAttrs :: [XML.Attr]- , rssGuidValue :: String- }- deriving (Show)---data RSSImage- = RSSImage- { rssImageURL :: URLString -- the URL to the image resource.- , rssImageTitle :: String- , rssImageLink :: URLString -- URL that the image resource should be an href to.- , rssImageWidth :: Maybe Integer- , rssImageHeight :: Maybe Integer- , rssImageDesc :: Maybe String- , rssImageOther :: [XML.Element]- }- deriving (Show)--data RSSCloud- = RSSCloud- { rssCloudDomain :: Maybe String- , rssCloudPort :: Maybe String -- on purpose (i.e., not an int)- , rssCloudPath :: Maybe String- , rssCloudRegister :: Maybe String- , rssCloudProtocol :: Maybe String- , rssCloudAttrs :: [XML.Attr]- }- deriving (Show)--data RSSTextInput- = RSSTextInput- { rssTextInputTitle :: String- , rssTextInputDesc :: String- , rssTextInputName :: String- , rssTextInputLink :: URLString- , rssTextInputAttrs :: [XML.Attr]- , rssTextInputOther :: [XML.Element]- }- deriving (Show)---- * Default Constructors:--nullRSS :: String -- ^channel title- -> URLString -- ^channel link- -> RSS-nullRSS title link =- RSS- { rssVersion = "2.0"- , rssAttrs = []- , rssChannel = nullChannel title link- , rssOther = []- }--nullChannel :: String -- ^rssTitle- -> URLString -- ^rssLink- -> RSSChannel-nullChannel title link =- RSSChannel- { rssTitle = title- , rssLink = link- , rssDescription = title- , rssItems = []- , rssLanguage = Nothing- , rssCopyright = Nothing- , rssEditor = Nothing- , rssWebMaster = Nothing- , rssPubDate = Nothing- , rssLastUpdate = Nothing- , rssCategories = []- , rssGenerator = Nothing- , rssDocs = Nothing- , rssCloud = Nothing- , rssTTL = Nothing- , rssImage = Nothing- , rssRating = Nothing- , rssTextInput = Nothing- , rssSkipHours = Nothing- , rssSkipDays = Nothing- , rssChannelOther = []- }--nullItem :: String -- ^title- -> RSSItem-nullItem title =- RSSItem- { rssItemTitle = Just title- , rssItemLink = Nothing- , rssItemDescription = Nothing- , rssItemAuthor = Nothing- , rssItemCategories = []- , rssItemComments = Nothing- , rssItemEnclosure = Nothing- , rssItemGuid = Nothing- , rssItemPubDate = Nothing- , rssItemSource = Nothing- , rssItemAttrs = []- , rssItemOther = []- }--nullSource :: URLString -- ^source URL- -> String -- ^title- -> RSSSource-nullSource url title =- RSSSource- { rssSourceURL = url- , rssSourceAttrs = []- , rssSourceTitle = title- }--nullEnclosure :: URLString -- ^enclosure URL- -> Maybe Integer -- ^enclosure length- -> String -- ^enclosure type- -> RSSEnclosure-nullEnclosure url mb_len ty =- RSSEnclosure- { rssEnclosureURL = url- , rssEnclosureLength = mb_len- , rssEnclosureType = ty- , rssEnclosureAttrs = []- }--newCategory :: String -- ^category Value- -> RSSCategory-newCategory nm =- RSSCategory- { rssCategoryDomain = Nothing- , rssCategoryAttrs = []- , rssCategoryValue = nm- }--nullGuid :: String -- ^guid value- -> RSSGuid-nullGuid v =- RSSGuid- { rssGuidPermanentURL = Nothing- , rssGuidAttrs = []- , rssGuidValue = v- }--nullPermaGuid :: String -- ^guid value- -> RSSGuid-nullPermaGuid v = (nullGuid v){rssGuidPermanentURL=Just True}--nullImage :: URLString -- ^imageURL- -> String -- ^imageTitle- -> URLString -- ^imageLink- -> RSSImage-nullImage url title link =- RSSImage- { rssImageURL = url- , rssImageTitle = title- , rssImageLink = link- , rssImageWidth = Nothing- , rssImageHeight = Nothing- , rssImageDesc = Nothing- , rssImageOther = []- }--nullCloud :: RSSCloud-nullCloud =- RSSCloud- { rssCloudDomain = Nothing- , rssCloudPort = Nothing- , rssCloudPath = Nothing- , rssCloudRegister = Nothing- , rssCloudProtocol = Nothing- , rssCloudAttrs = []- }--nullTextInput :: String -- ^inputTitle- -> String -- ^inputName- -> URLString -- ^inputLink- -> RSSTextInput-nullTextInput title nm link =- RSSTextInput- { rssTextInputTitle = title- , rssTextInputDesc = title- , rssTextInputName = nm- , rssTextInputLink = link- , rssTextInputAttrs = []- , rssTextInputOther = []- }-
− Text/RSS1/Export.hs
@@ -1,194 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.RSS1.Export--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability: portable--------------------------------------------------------------------------module Text.RSS1.Export- ( xmlFeed- ) where--import Text.XML.Light as XML-import Text.RSS1.Syntax-import Text.RSS1.Utils-import Text.DublinCore.Types--import Data.List-import Data.Maybe--qualNode :: (Maybe String,Maybe String) -> String -> [XML.Content] -> XML.Element-qualNode ns n cs =- blank_element- { elName = qualName ns n- , elContent = cs- }------xmlFeed :: Feed -> XML.Element-xmlFeed f =- (qualNode (rdfNS,rdfPrefix) "RDF" $ map Elem $- (concat [ [xmlChannel (feedChannel f)]- , mb xmlImage (feedImage f)- , map xmlItem (feedItems f)- , mb xmlTextInput (feedTextInput f)- , map xmlTopic (feedTopics f)- , feedOther f- ] ))- -- should we expect these to be derived by the XML pretty printer..?- { elAttribs = nub $- Attr (qualName (Nothing,Nothing) "xmlns") (fromJust rss10NS) :- Attr (qualName (Nothing,Just "xmlns") (fromJust rdfPrefix)) (fromJust rdfNS) :- Attr (qualName (Nothing,Just "xmlns") (fromJust synPrefix)) (fromJust synNS) :- Attr (qualName (Nothing,Just "xmlns") (fromJust taxPrefix)) (fromJust taxNS) :- Attr (qualName (Nothing,Just "xmlns") (fromJust conPrefix)) (fromJust conNS) :- Attr (qualName (Nothing,Just "xmlns") (fromJust dcPrefix)) (fromJust dcNS) :- feedAttrs f}--xmlChannel :: Channel -> XML.Element-xmlChannel ch =- (qualNode (rss10NS,Nothing) "channel" $ map Elem $- ([ xmlLeaf (rss10NS,Nothing) "title" (channelTitle ch)- , xmlLeaf (rss10NS,Nothing) "link" (channelLink ch)- , xmlLeaf (rss10NS,Nothing) "description" (channelDesc ch)- ] ++- mb xmlTextInputURI (channelTextInputURI ch) ++- mb xmlImageURI (channelImageURI ch) ++- xmlItemURIs (channelItemURIs ch) ++ map xmlDC (channelDC ch) ++- concat [ mb xmlUpdatePeriod (channelUpdatePeriod ch)- , mb xmlUpdateFreq (channelUpdateFreq ch)- , mb (xmlLeaf (synNS,synPrefix) "updateBase") (channelUpdateBase ch)- ] ++- xmlContentItems (channelContent ch) ++- xmlTopics (channelTopics ch) ++- channelOther ch))- { elAttribs = ( Attr (qualName (rdfNS,rdfPrefix) "about") (channelURI ch) :- channelAttrs ch)}--xmlImageURI :: URIString -> XML.Element-xmlImageURI u = xmlEmpty (rss10NS,Nothing) "image" [Attr (rdfName "resource") u ]--xmlImage :: Image -> XML.Element-xmlImage i =- (qualNode (rss10NS,Nothing) "image" $ map Elem $- ([ xmlLeaf (rss10NS,Nothing) "title" (imageTitle i)- , xmlLeaf (rss10NS,Nothing) "url" (imageURL i)- , xmlLeaf (rss10NS,Nothing) "link" (imageLink i)- ] ++ map xmlDC (imageDC i) ++- imageOther i))- { elAttribs = ( Attr (qualName (rdfNS,rdfPrefix) "about") (imageURI i) :- imageAttrs i)}--xmlItemURIs :: [URIString] -> [XML.Element]-xmlItemURIs [] = []-xmlItemURIs xs =- [qualNode (rss10NS, Nothing) "items" $- [Elem (qualNode (rdfNS,rdfPrefix) "Seq" (map toRes xs))]]- where- toRes u = Elem (xmlEmpty (rdfNS,rdfPrefix) "li" [Attr (rdfName "resource") u])--xmlTextInputURI :: URIString -> XML.Element-xmlTextInputURI u = xmlEmpty (rss10NS,Nothing) "textinput" [Attr (rdfName "resource") u ]--xmlTextInput :: TextInputInfo -> XML.Element-xmlTextInput ti =- (qualNode (rss10NS, Nothing) "textinput" $ map Elem $- [ xmlLeaf (rss10NS,Nothing) "title" (textInputTitle ti)- , xmlLeaf (rss10NS,Nothing) "description" (textInputDesc ti)- , xmlLeaf (rss10NS,Nothing) "name" (textInputName ti)- , xmlLeaf (rss10NS,Nothing) "link" (textInputLink ti)- ] ++ map xmlDC (textInputDC ti) ++- textInputOther ti)- {elAttribs=Attr (rdfName "about") (textInputURI ti) : textInputAttrs ti}--xmlDC :: DCItem -> XML.Element-xmlDC dc = xmlLeaf (dcNS,dcPrefix) (infoToTag (dcElt dc)) (dcText dc)--xmlUpdatePeriod :: UpdatePeriod -> XML.Element-xmlUpdatePeriod u = xmlLeaf (synNS,synPrefix) "updatePeriod" (toStr u)- where- toStr ux =- case ux of- Update_Hourly -> "hourly"- Update_Daily -> "daily"- Update_Weekly -> "weekly"- Update_Monthly -> "monthly"- Update_Yearly -> "yearly"--xmlUpdateFreq :: Integer -> XML.Element-xmlUpdateFreq f = xmlLeaf (synNS,synPrefix) "updateFrequency" (show f)--xmlContentItems :: [ContentInfo] -> [XML.Element]-xmlContentItems [] = []-xmlContentItems xs =- [qualNode (conNS,conPrefix) "items"- [Elem $ qualNode (rdfNS,rdfPrefix) "Bag"- (map (\ e -> Elem (qualNode (rdfNS,rdfPrefix) "li" [Elem (xmlContentInfo e)]))- xs)]]--xmlContentInfo :: ContentInfo -> XML.Element-xmlContentInfo ci =- (qualNode (conNS,conPrefix) "item" $ map Elem $- (concat [ mb (rdfResource (conNS,conPrefix) "format") (contentFormat ci)- , mb (rdfResource (conNS,conPrefix) "encoding") (contentEncoding ci)- , mb (rdfValue []) (contentValue ci)- ]))- {elAttribs=mb (Attr (rdfName "about")) (contentURI ci)}--rdfResource :: (Maybe String,Maybe String) -> String -> String -> XML.Element-rdfResource ns t v = xmlEmpty ns t [Attr (rdfName "resource") v ]--rdfValue :: [XML.Attr] -> String -> XML.Element-rdfValue as s = (xmlLeaf (rdfNS,rdfPrefix) "value" s){elAttribs=as}--xmlTopics :: [URIString] -> [XML.Element]-xmlTopics [] = []-xmlTopics xs =- [qualNode (taxNS,taxPrefix) "topics"- [Elem (qualNode (rdfNS,rdfPrefix) "Bag" $- (map (Elem . rdfResource (rdfNS,rdfPrefix) "li") xs))]]--xmlTopic :: TaxonomyTopic -> XML.Element-xmlTopic tt =- (qualNode (taxNS,taxPrefix) "topic" $ map Elem $- (xmlLeaf (rss10NS,Nothing) "link" (taxonomyLink tt):- mb (xmlLeaf (rss10NS,Nothing) "title") (taxonomyTitle tt) ++- mb (xmlLeaf (rss10NS,Nothing) "description") (taxonomyDesc tt) ++- xmlTopics (taxonomyTopics tt) ++- map xmlDC (taxonomyDC tt) ++- taxonomyOther tt))- {elAttribs=[Attr (rdfName "about") (taxonomyURI tt)]}--xmlItem :: Item -> XML.Element-xmlItem i =- (qualNode (rss10NS,Nothing) "item" $ map Elem $- ([ xmlLeaf (rss10NS,Nothing) "title" (itemTitle i)- , xmlLeaf (rss10NS,Nothing) "link" (itemLink i)- ] ++- mb (xmlLeaf (rss10NS,Nothing) "description") (itemDesc i) ++- map xmlDC (itemDC i) ++- xmlTopics (itemTopics i) ++- map xmlContentInfo (itemContent i) ++- itemOther i))- { elAttribs = ( Attr (qualName (rdfNS,rdfPrefix) "about") (itemURI i) :- itemAttrs i)}--xmlLeaf :: (Maybe String,Maybe String) -> String -> String -> XML.Element-xmlLeaf ns tg txt =- blank_element{ elName = qualName ns tg- , elContent = [ Text blank_cdata { cdData = txt } ]- }--xmlEmpty :: (Maybe String,Maybe String) -> String -> [XML.Attr] -> XML.Element-xmlEmpty ns t as = (qualNode ns t []){elAttribs=as}------mb :: (a -> b) -> Maybe a -> [b]-mb _ Nothing = []-mb f (Just x) = [f x]
− Text/RSS1/Import.hs
@@ -1,247 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.RSS1.Import--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability: portable--------------------------------------------------------------------------module Text.RSS1.Import- ( elementToFeed- ) where--import Text.RSS1.Syntax-import Text.RSS1.Utils-import Text.XML.Light as XML-import Text.DublinCore.Types--import Data.Maybe (mapMaybe, fromMaybe)-import Control.Monad (guard,mplus)------elementToFeed :: XML.Element -> Maybe Feed-elementToFeed e = do- guard (elName e == rdfName "RDF")- ver <- pAttr (Nothing,Nothing) "xmlns" e `mplus` rss10NS- ch <- pNode "channel" e >>= elementToChannel- let mbImg = pNode "image" e >>= elementToImage- let is = fromMaybe [] $ fmap elementToItems $ pNode "items" e- let mbTI = pNode "textinput" e >>= elementToTextInput- let ch1 = ch{channelItemURIs = is}- let its = pMany (rss10NS,Nothing) "item" elementToItem e-- let es_rest = removeKnownElts e- let as_rest = removeKnownAttrs e- return Feed- { feedVersion = ver- , feedChannel = ch1- , feedImage = mbImg- , feedItems = its- , feedTextInput = mbTI- , feedTopics = mapMaybe elementToTaxonomyTopic $ pQNodes (qualName (taxNS,taxPrefix) "topic") e- , feedOther = es_rest- , feedAttrs = as_rest- }--elementToItems :: XML.Element -> [URIString]-elementToItems e = seqLeaves e--elementToTextInput :: XML.Element -> Maybe TextInputInfo-elementToTextInput e = do- let es = children e- uri <- pAttr (rdfNS,rdfPrefix) "about" e- ti <- pQLeaf (rss10NS,Nothing) "title" e- desc <- pQLeaf (rss10NS,Nothing) "description" e- na <- pQLeaf (rss10NS,Nothing) "name" e- li <- pQLeaf (rss10NS,Nothing) "link" e- let dcs = mapMaybe elementToDC es- return $ TextInputInfo- { textInputURI = uri- , textInputTitle = ti- , textInputDesc = desc- , textInputName = na- , textInputLink = li- , textInputDC = dcs- , textInputOther = es- , textInputAttrs = elAttribs e- }--elementToItem :: XML.Element -> Maybe Item-elementToItem e = do- guard (elName e == qualName (rss10NS,Nothing) "item")- let es = children e- uri <- pAttr (rdfNS,rdfPrefix) "about" e- ti <- pQLeaf (rss10NS,Nothing) "title" e- li <- pQLeaf (rss10NS,Nothing) "link" e- let desc= pQLeaf (rss10NS,Nothing) "description" e- let dcs = mapMaybe elementToDC es- let tos = fromMaybe [] (fmap bagLeaves $ pQNode (qualName (taxNS,taxPrefix) "topics") e)- let cs = mapMaybe elementToContent es- let es_other = removeKnownElts e- let as_other = removeKnownAttrs e- return Item- { itemURI = uri- , itemTitle = ti- , itemLink = li- , itemDesc = desc- , itemDC = dcs- , itemTopics = tos- , itemContent = cs- , itemOther = es_other- , itemAttrs = as_other- }--elementToImage :: XML.Element -> Maybe Image-elementToImage e = do- let es = children e- let as = elAttribs e- uri <- pAttr (rdfNS,rdfPrefix) "about" e- ti <- pLeaf "title" e- ur <- pLeaf "url" e- li <- pLeaf "link" e- let dcs = mapMaybe elementToDC es- return Image- { imageURI = uri- , imageTitle = ti- , imageURL = ur- , imageLink = li- , imageDC = dcs- , imageOther = es- , imageAttrs = as- }--elementToChannel :: XML.Element -> Maybe Channel-elementToChannel e = do- let es = children e- uri <- pAttr (rdfNS,rdfPrefix) "about" e- ti <- pLeaf "title" e- li <- pLeaf "link" e- de <- pLeaf "description" e- let mbImg = pLeaf "image" e- let is =- case fmap seqLeaves $ pNode "items" e of- Nothing -> []- Just ss -> ss- let tinp = pLeaf "textinput" e- let dcs = mapMaybe elementToDC es- let tos = fromMaybe [] (fmap bagLeaves $ pQNode (qualName (taxNS,taxPrefix) "topics") e)- let cs = mapMaybe elementToContent es- let es_other = removeKnownElts e- let as_other = removeKnownAttrs e- let def_chan =- Channel- { channelURI = uri- , channelTitle = ti- , channelLink = li- , channelDesc = de- , channelImageURI = mbImg- , channelItemURIs = is- , channelTextInputURI = tinp- , channelDC = dcs- , channelUpdatePeriod = Nothing- , channelUpdateFreq = Nothing- , channelUpdateBase = Nothing- , channelContent = cs- , channelTopics = tos- , channelOther = es_other- , channelAttrs = as_other- }- return (addSyndication e def_chan)--addSyndication :: XML.Element -> Channel -> Channel-addSyndication e ch =- ch{ channelUpdatePeriod = fmap toUpdatePeriod $ pQLeaf (synNS,synPrefix) "updatePeriod" e- , channelUpdateFreq = fmap read $ pQLeaf (synNS,synPrefix) "updateFrequency" e- , channelUpdateBase = pQLeaf (synNS,synPrefix) "updateBase" e- }- where- toUpdatePeriod x =- case x of- "hourly" -> Update_Hourly- "daily" -> Update_Daily- "weekly" -> Update_Weekly- "monthly" -> Update_Monthly- "yearly" -> Update_Yearly- _ -> Update_Hourly -- ToDo: whine---elementToDC :: XML.Element -> Maybe DCItem-elementToDC e = do- guard (qURI (elName e) == dcNS)- let dcItem x = DCItem{dcElt=x,dcText=strContent e}- return $ dcItem $- case qName $ elName e of- "title" -> DC_Title- "creator" -> DC_Creator- "subject" -> DC_Subject- "description" -> DC_Description- "publisher" -> DC_Publisher- "contributor" -> DC_Contributor- "date" -> DC_Date- "type" -> DC_Type- "format" -> DC_Format- "identifier" -> DC_Identifier- "source" -> DC_Source- "language" -> DC_Language- "relation" -> DC_Relation- "coverage" -> DC_Coverage- "rights" -> DC_Rights- oth -> DC_Other oth--elementToTaxonomyTopic :: XML.Element -> Maybe TaxonomyTopic-elementToTaxonomyTopic e = do- guard (elName e == qualName (taxNS,taxPrefix) "topic")- let es = children e- uri <- pAttr (rdfNS,rdfPrefix) "about" e- li <- pQLeaf (taxNS,taxPrefix) "link" e- return TaxonomyTopic- { taxonomyURI = uri- , taxonomyLink = li- , taxonomyTitle = pLeaf "title" e- , taxonomyDesc = pLeaf "description" e- , taxonomyTopics = fromMaybe [] (fmap bagLeaves $ pQNode (qualName (taxNS,taxPrefix) "topics") e)- , taxonomyDC = mapMaybe elementToDC es- , taxonomyOther = es- }--elementToContent :: XML.Element -> Maybe ContentInfo-elementToContent e = do- guard (elName e == qualName (conNS,conPrefix) "items")- return ContentInfo- { contentURI = pAttr (rdfNS,rdfPrefix) "about" e- , contentFormat = pQLeaf (conNS,conPrefix) "format" e- , contentEncoding = pQLeaf (conNS,conPrefix) "encoding" e- , contentValue = pQLeaf (rdfNS,rdfPrefix) "value" e- }--bagLeaves :: XML.Element -> [URIString]-bagLeaves be =- mapMaybe- (\ e -> do- guard (elName e == qualName (rdfNS,rdfPrefix) "li")- pAttr (rdfNS,rdfPrefix) "resource" e `mplus`- fmap strContent (pQNode (qualName (rdfNS,rdfPrefix) "li") e))- (fromMaybe [] $ fmap children $ pQNode (qualName (rdfNS,rdfPrefix) "Bag") be)--{--bagElements :: XML.Element -> [XML.Element]-bagElements be =- mapMaybe- (\ e -> do- guard (elName e == rdfName "li")- return e)- (fromMaybe [] $ fmap children $ pQNode (rdfName "Bag") be)--}--seqLeaves :: XML.Element -> [URIString]-seqLeaves se =- mapMaybe- (\ e -> do- guard (elName e == rdfName "li")- return (strContent e))- (fromMaybe [] $ fmap children $ pQNode (rdfName "Seq") se)
− Text/RSS1/Syntax.hs
@@ -1,219 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.RSS1.Syntax--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability: portable--------------------------------------------------------------------------module Text.RSS1.Syntax where--import Text.XML.Light.Types as XML-import Text.DublinCore.Types--type URIString = String-type TitleString = String-type TimeString = String-type TextString = String--data Feed- = Feed { feedVersion :: String- , feedChannel :: Channel- , feedImage :: Maybe Image- , feedItems :: [Item]- , feedTextInput :: Maybe TextInputInfo- , feedTopics :: [TaxonomyTopic]- , feedOther :: [XML.Element]- , feedAttrs :: [XML.Attr]- }- deriving (Show)--data Channel- = Channel- { channelURI :: URIString- , channelTitle :: TitleString- , channelLink :: URIString- , channelDesc :: TextString- -- these are indirect RDF associations to elements declared- -- outside the channel element in the RDF \/ feed document.- , channelImageURI :: Maybe URIString- , channelItemURIs :: [URIString]- , channelTextInputURI :: Maybe URIString- , channelDC :: [DCItem]- , channelUpdatePeriod :: Maybe UpdatePeriod- , channelUpdateFreq :: Maybe Integer- , channelUpdateBase :: Maybe TimeString -- format is yyyy-mm-ddThh:mm- , channelContent :: [ContentInfo]- , channelTopics :: [URIString]- , channelOther :: [XML.Element]- , channelAttrs :: [XML.Attr]- }- deriving (Show)--data Image- = Image- { imageURI :: URIString -- the image resource, most likely.- , imageTitle :: TextString -- the "alt"ernative text.- , imageURL :: URIString- , imageLink :: URIString -- the href of the rendered img resource.- , imageDC :: [DCItem]- , imageOther :: [XML.Element]- , imageAttrs :: [XML.Attr]- }- deriving (Show)--data Item- = Item- { itemURI :: URIString- , itemTitle :: TextString- , itemLink :: URIString- , itemDesc :: Maybe TextString- , itemDC :: [DCItem]- , itemTopics :: [URIString]- , itemContent :: [ContentInfo]- , itemOther :: [XML.Element]- , itemAttrs :: [XML.Attr]- }- deriving (Show)--data TextInputInfo- = TextInputInfo- { textInputURI :: URIString- , textInputTitle :: TextString- , textInputDesc :: TextString- , textInputName :: TextString- , textInputLink :: URIString- , textInputDC :: [DCItem]- , textInputOther :: [XML.Element]- , textInputAttrs :: [XML.Attr]- }- deriving (Show)--data TaxonomyTopic- = TaxonomyTopic- { taxonomyURI :: URIString- , taxonomyLink :: URIString- , taxonomyTitle :: Maybe String- , taxonomyDesc :: Maybe String- , taxonomyTopics :: [URIString]- , taxonomyDC :: [DCItem]- , taxonomyOther :: [XML.Element]- }- deriving (Show)---data UpdatePeriod- = Update_Hourly- | Update_Daily- | Update_Weekly- | Update_Monthly- | Update_Yearly- deriving (Eq, Show)--data ContentInfo- = ContentInfo- { contentURI :: Maybe URIString- , contentFormat :: Maybe URIString- , contentEncoding :: Maybe URIString- , contentValue :: Maybe String -- should be: RDFValue- }- deriving (Eq, Show)----default constructors:-nullFeed :: URIString -> TitleString -> Feed-nullFeed uri title =- Feed { feedVersion = "1.0"- , feedChannel = nullChannel uri title- , feedImage = Nothing- , feedItems = []- , feedTextInput = Nothing- , feedTopics = []- , feedOther = []- , feedAttrs = []- }--nullChannel :: URIString -> TitleString -> Channel-nullChannel uri title =- Channel- { channelURI = uri- , channelTitle = title- , channelLink = uri- , channelDesc = title- , channelImageURI = Nothing- , channelItemURIs = []- , channelTextInputURI = Nothing- , channelDC = []- , channelUpdatePeriod = Nothing- , channelUpdateFreq = Nothing- , channelUpdateBase = Nothing- , channelContent = []- , channelTopics = []- , channelOther = []- , channelAttrs = []- }--nullImage :: URIString -> String -> URIString -> Image-nullImage imguri title link =- Image- { imageURI = imguri- , imageTitle = title- , imageURL = imguri- , imageLink = link- , imageDC = []- , imageOther = []- , imageAttrs = []- }--nullItem :: URIString -> TextString -> URIString -> Item-nullItem uri title link =- Item- { itemURI = uri- , itemTitle = title- , itemLink = link- , itemDesc = Nothing- , itemDC = []- , itemTopics = []- , itemContent = []- , itemOther = []- , itemAttrs = []- }--nullTextInputInfo :: URIString -> TextString -> TextString -> URIString -> TextInputInfo-nullTextInputInfo uri title nm link =- TextInputInfo- { textInputURI = uri- , textInputTitle = title- , textInputDesc = title- , textInputName = nm- , textInputLink = link- , textInputDC = []- , textInputOther = []- , textInputAttrs = []- }--nullTaxonomyTopic :: URIString -> URIString -> TaxonomyTopic-nullTaxonomyTopic uri link =- TaxonomyTopic- { taxonomyURI = uri- , taxonomyLink = link- , taxonomyTitle = Nothing- , taxonomyDesc = Nothing- , taxonomyTopics = []- , taxonomyDC = []- , taxonomyOther = []- }--nullContentInfo :: ContentInfo-nullContentInfo =- ContentInfo- { contentURI = Nothing- , contentFormat = Nothing- , contentEncoding = Nothing- , contentValue = Nothing- }-
− Text/RSS1/Utils.hs
@@ -1,113 +0,0 @@------------------------------------------------------------------------ |--- Module : Text.RSS1.Utils--- Copyright : (c) Galois, Inc. 2008,--- (c) Sigbjorn Finne 2009---- License : BSD3------ Maintainer: Sigbjorn Finne <sof@forkIO.com>--- Stability : provisional--- Portability: portable--------------------------------------------------------------------------module Text.RSS1.Utils where--import Text.XML.Light as XML-import Text.DublinCore.Types--import Data.Maybe (listToMaybe, mapMaybe)--pQNodes :: QName -> XML.Element -> [XML.Element]-pQNodes = XML.findChildren--pNode :: String -> XML.Element -> Maybe XML.Element-pNode x e = listToMaybe (pQNodes (qualName (rss10NS,Nothing) x) e)--pQNode :: QName -> XML.Element -> Maybe XML.Element-pQNode x e = listToMaybe (pQNodes x e)--pLeaf :: String -> XML.Element -> Maybe String-pLeaf x e = strContent `fmap` pQNode (qualName (rss10NS,Nothing) x) e--pQLeaf :: (Maybe String,Maybe String) -> String -> XML.Element -> Maybe String-pQLeaf ns x e = strContent `fmap` pQNode (qualName ns x) e--pAttr :: (Maybe String, Maybe String) -> String -> XML.Element -> Maybe String-pAttr ns x e = lookup (qualName ns x) [ (k,v) | Attr k v <- elAttribs e ]--pMany :: (Maybe String,Maybe String) -> String -> (XML.Element -> Maybe a) -> XML.Element -> [a]-pMany ns p f e = mapMaybe f (pQNodes (qualName ns p) e)--children :: XML.Element -> [XML.Element]-children e = onlyElems (elContent e)--qualName :: (Maybe String, Maybe String) -> String -> QName-qualName (ns,pre) x = QName{qName=x,qURI=ns,qPrefix=pre}--rssPrefix, rss10NS :: Maybe String-rss10NS = Just "http://purl.org/rss/1.0/"-rssPrefix = Nothing--rdfPrefix, rdfNS :: Maybe String-rdfNS = Just "http://www.w3.org/1999/02/22-rdf-syntax-ns#"-rdfPrefix = Just "rdf"--synPrefix, synNS :: Maybe String-synNS = Just "http://purl.org/rss/1.0/modules/syndication/"-synPrefix = Just "sy"--taxPrefix, taxNS :: Maybe String-taxNS = Just "http://purl.org/rss/1.0/modules/taxonomy/"-taxPrefix = Just "taxo"--conPrefix, conNS :: Maybe String-conNS = Just "http://purl.org/rss/1.0/modules/content/"-conPrefix = Just "content"--dcPrefix, dcNS :: Maybe String-dcNS = Just "http://purl.org/dc/elements/1.1/"-dcPrefix = Just "dc"--rdfName :: String -> QName-rdfName x = QName{qName=x,qURI=rdfNS,qPrefix=rdfPrefix}--rssName :: String -> QName-rssName x = QName{qName=x,qURI=rss10NS,qPrefix=rssPrefix}--synName :: String -> QName-synName x = QName{qName=x,qURI=synNS,qPrefix=synPrefix}--known_rss_elts :: [QName]-known_rss_elts = map rssName [ "channel", "item", "image", "textinput" ]--known_syn_elts :: [QName]-known_syn_elts = map synName [ "updateBase", "updateFrequency", "updatePeriod" ]--known_dc_elts :: [QName]-known_dc_elts = map (qualName (dcNS,dcPrefix)) dc_element_names--known_tax_elts :: [QName]-known_tax_elts = map (qualName (taxNS,taxPrefix)) [ "topic", "topics" ]--known_con_elts :: [QName]-known_con_elts = map (qualName (conNS,conPrefix)) [ "items", "item", "format", "encoding" ]--removeKnownElts :: XML.Element -> [XML.Element]-removeKnownElts e =- filter (\ e1 -> not (elName e1 `elem` known_elts)) (children e)- where- known_elts =- concat [ known_rss_elts- , known_syn_elts- , known_dc_elts- , known_con_elts- , known_tax_elts- ]--removeKnownAttrs :: XML.Element -> [XML.Attr]-removeKnownAttrs e =- filter (\ a -> not (attrKey a `elem` known_attrs)) (elAttribs e)- where- known_attrs =- map rdfName [ "about" ]
feed.cabal view
@@ -1,51 +1,81 @@-Name: feed-Version: 0.3.9.3-License: BSD3-License-file: LICENSE-Category: Text-Synopsis: Interfacing with RSS (v 0.9x, 2.x, 1.0) + Atom feeds.-Description: Interfacing with RSS (v 0.9x, 2.x, 1.0) + Atom feeds.- .- To help working with the multiple feed formats we've- ended up with, this set of modules provides parsers,- pretty printers and some utility code for querying- and just generally working with a concrete representation- of feeds in Haskell.-Author: Sigbjorn Finne <sof@forkIO.com>-Maintainer: Sigbjorn Finne <sof@forkIO.com>-Homepage: https://github.com/sof/feed-Extra-Source-Files: tests/Main.hs tests/rss20.xml CHANGES-Cabal-version: >= 1.2-build-type: Simple+name: feed+version: 0.3.9.4+license: BSD3+license-file: LICENSE+category: Text+synopsis: Interfacing with RSS (v 0.9x, 2.x, 1.0) + Atom feeds.+description: Interfacing with RSS (v 0.9x, 2.x, 1.0) + Atom feeds.+ .+ To help working with the multiple feed formats we've+ ended up with, this set of modules provides parsers,+ pretty printers and some utility code for querying+ and just generally working with a concrete representation+ of feeds in Haskell.+author: Sigbjorn Finne <sof@forkIO.com>+maintainer: Adam Bergmark <adam@bergmark.nl>+homepage: https://github.com/bergmark/feed+bug-reports: https://github.com/bergmark/feed/issues+cabal-version: >= 1.8+build-type: Simple+data-files: tests/files/rss20.xml+extra-source-files:+ README.md+ CHANGELOG.md +source-repository head+ type: git+ location: https://github.com/bergmark/feed.git+ library- Exposed-Modules: Text.RSS.Syntax- Text.RSS.Import- Text.RSS.Export- Text.RSS1.Syntax- Text.RSS1.Import- Text.RSS1.Utils- Text.RSS1.Export- Text.DublinCore.Types- Text.Atom.Feed- Text.Atom.Feed.Export- Text.Atom.Feed.Import- Text.Atom.Feed.Link- Text.Atom.Feed.Validate- Text.Atom.Pub- Text.Atom.Pub.Export- Text.Feed.Import- Text.Feed.Types- Text.Feed.Export- Text.Feed.Query- Text.Feed.Constructor- Text.Feed.Translate- Text.Feed.Util- Ghc-Options: -Wall- Build-Depends: base >= 4 && < 5,- old-locale >= 1,- old-time >= 1,- xml >= 1.2.6,- utf8-string,- time,- time-locale-compat >= 0.1 && < 0.2+ ghc-options: -Wall+ hs-source-dirs: src+ exposed-modules:+ Paths_feed+ Text.Atom.Feed+ Text.Atom.Feed.Export+ Text.Atom.Feed.Import+ Text.Atom.Feed.Link+ Text.Atom.Feed.Validate+ Text.Atom.Pub+ Text.Atom.Pub.Export+ Text.DublinCore.Types+ Text.Feed.Constructor+ Text.Feed.Export+ Text.Feed.Import+ Text.Feed.Query+ Text.Feed.Translate+ Text.Feed.Types+ Text.Feed.Util+ Text.RSS.Export+ Text.RSS.Import+ Text.RSS.Syntax+ Text.RSS1.Export+ Text.RSS1.Import+ Text.RSS1.Syntax+ Text.RSS1.Utils+ build-depends:+ base >= 4 && < 4.9+ , old-locale == 1.0.*+ , old-time >= 1 && < 1.2+ , time < 1.6+ , time-locale-compat == 0.1.*+ , utf8-string < 1.1+ , xml >= 1.2.6 && < 1.3.15++test-suite tests+ ghc-options: -Wall+ hs-source-dirs: tests+ main-is: Main.hs+ type: exitcode-stdio-1.0+ build-depends:+ base >= 4 && < 4.9+ , HUnit == 1.2.*+ , feed+ , old-locale == 1.0.*+ , old-time >= 1 && < 1.2+ , test-framework == 0.8.*+ , test-framework-hunit == 0.3.*+ , time < 1.6+ , time-locale-compat == 0.1.*+ , utf8-string < 1.1+ , xml >= 1.2.6 && < 1.4
+ src/Text/Atom/Feed.hs view
@@ -0,0 +1,264 @@+--------------------------------------------------------------------+-- |+-- Module : Text.Atom.Feed+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+--------------------------------------------------------------------++module Text.Atom.Feed where++import qualified Text.XML.Light as XML++-- *Core types++-- NOTE: In the future we may want to have more structured+-- types for these.+type URI = String+type NCName = String+type Date = String+type MediaType = String++data Feed+ = Feed+ { feedId :: String+ , feedTitle :: TextContent+ , feedUpdated :: Date+ , feedAuthors :: [Person]+ , feedCategories :: [Category]+ , feedContributors :: [Person]+ , feedGenerator :: Maybe Generator+ , feedIcon :: Maybe URI+ , feedLinks :: [Link]+ , feedLogo :: Maybe URI+ , feedRights :: Maybe TextContent+ , feedSubtitle :: Maybe TextContent+ , feedEntries :: [Entry]+ , feedAttrs :: [XML.Attr]+ , feedOther :: [XML.Element]+ }+ deriving (Show)++data Entry+ = Entry+ { entryId :: String+ , entryTitle :: TextContent+ , entryUpdated :: Date+ , entryAuthors :: [Person]+ , entryCategories :: [Category]+ , entryContent :: Maybe EntryContent+ , entryContributor :: [Person]+ , entryLinks :: [Link]+ , entryPublished :: Maybe Date+ , entryRights :: Maybe TextContent+ , entrySource :: Maybe Source+ , entrySummary :: Maybe TextContent+ , entryInReplyTo :: Maybe InReplyTo+ , entryInReplyTotal :: Maybe InReplyTotal+ , entryAttrs :: [XML.Attr]+ , entryOther :: [XML.Element]+ }+ deriving (Show)++data EntryContent+ = TextContent String+ | HTMLContent String+ | XHTMLContent XML.Element+ | MixedContent (Maybe String) [XML.Content]+ | ExternalContent (Maybe MediaType) URI+ deriving (Show)++data Category+ = Category+ { catTerm :: String -- ^ the tag\/term of the category.+ , catScheme :: Maybe URI -- ^ optional URL for identifying the categorization scheme.+ , catLabel :: Maybe String -- ^ human-readable label of the category+ , catOther :: [XML.Element] -- ^ unknown elements, for extensibility.+ }+ deriving (Show)+++data Generator+ = Generator+ { genURI :: Maybe URI+ , genVersion :: Maybe String+ , genText :: String+ }+ deriving (Eq, Show)++data Link+ = Link+ { linkHref :: URI+ -- ToDo: make the switch over to using the Atom.Feed.Link relation type.+ , linkRel :: Maybe (Either NCName URI)+ , linkType :: Maybe MediaType+ , linkHrefLang :: Maybe String+ , linkTitle :: Maybe String+ , linkLength :: Maybe String+ , linkAttrs :: [XML.Attr]+ , linkOther :: [XML.Element]+ }+ deriving (Show)++data TextContent+ = TextString String+ | HTMLString String+ | XHTMLString XML.Element+ deriving (Show)++txtToString :: TextContent -> String+txtToString (TextString s) = s+txtToString (HTMLString s) = s+txtToString (XHTMLString x) = show x++data Source+ = Source+ { sourceAuthors :: [Person]+ , sourceCategories :: [Category]+ , sourceGenerator :: Maybe Generator+ , sourceIcon :: Maybe URI+ , sourceId :: Maybe String+ , sourceLinks :: [Link]+ , sourceLogo :: Maybe URI+ , sourceRights :: Maybe TextContent+ , sourceSubtitle :: Maybe TextContent+ , sourceTitle :: Maybe TextContent+ , sourceUpdated :: Maybe Date+ , sourceOther :: [XML.Element]+ }+ deriving (Show)+++data Person+ = Person+ { personName :: String+ , personURI :: Maybe URI+ , personEmail :: Maybe String+ , personOther :: [XML.Element]+ }+ deriving (Show)++data InReplyTo+ = InReplyTo+ { replyToRef :: URI+ , replyToHRef :: Maybe URI+ , replyToType :: Maybe MediaType+ , replyToSource :: Maybe URI+ , replyToOther :: [XML.Attr]+ , replyToContent :: [XML.Content]+ }+ deriving (Show)++data InReplyTotal+ = InReplyTotal+ { replyToTotal :: Integer -- non-negative :)+ , replyToTotalOther :: [XML.Attr]+ }+ deriving (Show)++-- *Smart Constructors++newCategory :: String -- ^catTerm+ -> Category+newCategory t = Category+ { catTerm = t+ , catScheme = Nothing+ , catLabel = Just t+ , catOther = []+ }++nullFeed :: String -- ^feedId+ -> TextContent -- ^feedTitle+ -> Date -- ^feedUpdated+ -> Feed+nullFeed i t u = Feed+ { feedId = i+ , feedTitle = t+ , feedUpdated = u+ , feedAuthors = []+ , feedCategories = []+ , feedContributors = []+ , feedGenerator = Nothing+ , feedIcon = Nothing+ , feedLinks = []+ , feedLogo = Nothing+ , feedRights = Nothing+ , feedSubtitle = Nothing+ , feedEntries = []+ , feedAttrs = []+ , feedOther = []+ }++nullEntry :: String -- ^entryId+ -> TextContent -- ^entryTitle+ -> Date -- ^entryUpdated+ -> Entry+nullEntry i t u = Entry+ { entryId = i+ , entryTitle = t+ , entryUpdated = u+ , entryAuthors = []+ , entryCategories = []+ , entryContent = Nothing+ , entryContributor = []+ , entryLinks = []+ , entryPublished = Nothing+ , entryRights = Nothing+ , entrySource = Nothing+ , entrySummary = Nothing+ , entryInReplyTo = Nothing+ , entryInReplyTotal = Nothing+ , entryAttrs = []+ , entryOther = []+ }+++nullGenerator :: String -- ^genText+ -> Generator+nullGenerator t = Generator+ { genURI = Nothing+ , genVersion = Nothing+ , genText = t+ }++nullLink :: URI -- ^linkHref+ -> Link+nullLink uri = Link+ { linkHref = uri+ , linkRel = Nothing+ , linkType = Nothing+ , linkHrefLang = Nothing+ , linkTitle = Nothing+ , linkLength = Nothing+ , linkAttrs = []+ , linkOther = []+ }++nullSource :: Source+nullSource = Source+ { sourceAuthors = []+ , sourceCategories = []+ , sourceGenerator = Nothing+ , sourceIcon = Nothing+ , sourceId = Nothing+ , sourceLinks = []+ , sourceLogo = Nothing+ , sourceRights = Nothing+ , sourceSubtitle = Nothing+ , sourceTitle = Nothing+ , sourceUpdated = Nothing+ , sourceOther = []+ }++nullPerson :: Person+nullPerson = Person+ { personName = ""+ , personURI = Nothing+ , personEmail = Nothing+ , personOther = []+ }
+ src/Text/Atom/Feed/Export.hs view
@@ -0,0 +1,272 @@+--------------------------------------------------------------------+-- |+-- Module : Text.Atom.Feed.Export+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability:: portable+-- Description: Convert from Atom to XML+--+-- Convert from Atom to XML+--+--------------------------------------------------------------------+++module Text.Atom.Feed.Export where++import Text.XML.Light as XML+import Text.Atom.Feed++atom_prefix :: Maybe String+atom_prefix = Nothing -- Just "atom"++atom_thr_prefix :: Maybe String+atom_thr_prefix = Just "thr"++atomNS :: String+atomNS = "http://www.w3.org/2005/Atom"++atomThreadNS :: String+atomThreadNS = "http://purl.org/syndication/thread/1.0"++xmlns_atom :: Attr+xmlns_atom = Attr qn atomNS+ where+ qn = case atom_prefix of+ Nothing -> QName { qName = "xmlns"+ , qURI = Nothing+ , qPrefix = Nothing+ }+ Just s -> QName { qName = s+ , qURI = Nothing -- XXX: is this ok?+ , qPrefix = Just "xmlns"+ }++xmlns_atom_thread :: Attr+xmlns_atom_thread = Attr qn atomThreadNS+ where+ qn = case atom_prefix of+ Nothing -> QName { qName = "xmlns"+ , qURI = Nothing+ , qPrefix = Nothing+ }+ Just s -> QName { qName = s+ , qURI = Nothing -- XXX: is this ok?+ , qPrefix = Just "xmlns"+ }++atomName :: String -> QName+atomName nc = QName { qName = nc+ , qURI = Just atomNS+ , qPrefix = atom_prefix+ }++atomAttr :: String -> String -> Attr+atomAttr x y = Attr (atomName x) y++atomNode :: String -> [XML.Content] -> XML.Element+atomNode x xs = blank_element { elName = atomName x, elContent = xs }++atomLeaf :: String -> String -> XML.Element+atomLeaf tag txt = blank_element+ { elName = atomName tag+ , elContent = [ Text blank_cdata { cdData = txt } ]+ }++atomThreadName :: String -> QName+atomThreadName nc =+ QName { qName = nc+ , qURI = Just atomThreadNS+ , qPrefix = atom_thr_prefix+ }++atomThreadAttr :: String -> String -> Attr+atomThreadAttr x y = Attr (atomThreadName x) y++atomThreadNode :: String -> [XML.Content] -> XML.Element+atomThreadNode x xs =+ blank_element { elName = atomThreadName x, elContent = xs }++atomThreadLeaf :: String -> String -> XML.Element+atomThreadLeaf tag txt =+ blank_element { elName = atomThreadName tag+ , elContent = [ Text blank_cdata { cdData = txt } ]+ }++--------------------------------------------------------------------------------++xmlFeed :: Feed -> XML.Element+xmlFeed f = ( atomNode "feed"+ $ map Elem+ $ [ xmlTitle (feedTitle f) ]+ ++ [ xmlId (feedId f) ]+ ++ [ xmlUpdated (feedUpdated f) ]+ ++ map xmlLink (feedLinks f)+ ++ map xmlAuthor (feedAuthors f)+ ++ map xmlCategory (feedCategories f)+ ++ map xmlContributor (feedContributors f)+ ++ mb xmlGenerator (feedGenerator f)+ ++ mb xmlIcon (feedIcon f)+ ++ mb xmlLogo (feedLogo f)+ ++ mb xmlRights (feedRights f)+ ++ mb xmlSubtitle (feedSubtitle f)+ ++ map xmlEntry (feedEntries f)+ ++ feedOther f )++ { elAttribs = [xmlns_atom] }+++xmlEntry :: Entry -> XML.Element+xmlEntry e = ( atomNode "entry"+ $ map Elem+ $ [ xmlId (entryId e) ]+ ++ [ xmlTitle (entryTitle e) ]+ ++ [ xmlUpdated (entryUpdated e) ]+ ++ map xmlAuthor (entryAuthors e)+ ++ map xmlCategory (entryCategories e)+ ++ mb xmlContent (entryContent e)+ ++ map xmlContributor (entryContributor e)+ ++ map xmlLink (entryLinks e)+ ++ mb xmlPublished (entryPublished e)+ ++ mb xmlRights (entryRights e)+ ++ mb xmlSource (entrySource e)+ ++ mb xmlSummary (entrySummary e)+ ++ mb xmlInReplyTo (entryInReplyTo e)+ ++ mb xmlInReplyTotal (entryInReplyTotal e)+ ++ entryOther e )++ { elAttribs = entryAttrs e }++xmlContent :: EntryContent -> XML.Element+xmlContent cont = case cont of++ TextContent t -> (atomLeaf "content" t)+ { elAttribs = [ atomAttr "type" "text" ] }++ HTMLContent t -> (atomLeaf "content" t)+ { elAttribs = [ atomAttr "type" "html" ] }++ XHTMLContent x -> (atomNode "content" [ Elem x ])+ { elAttribs = [ atomAttr "type" "xhtml" ] }++ MixedContent mbTy cs -> (atomNode "content" cs)+ { elAttribs = mb (atomAttr "type") mbTy }++ ExternalContent mbTy src -> (atomNode "content" [])+ { elAttribs = [ atomAttr "src" src ]+ ++ mb (atomAttr "type") mbTy }+++xmlCategory :: Category -> XML.Element+xmlCategory c = (atomNode "category" (map Elem (catOther c)))+ { elAttribs = [ atomAttr "term" (catTerm c) ]+ ++ mb (atomAttr "scheme") (catScheme c)+ ++ mb (atomAttr "label") (catLabel c)+ }++xmlLink :: Link -> XML.Element+xmlLink l = (atomNode "link" (map Elem (linkOther l)))+ { elAttribs = [ atomAttr "href" (linkHref l) ]+ ++ mb (atomAttr "rel" . either id id) (linkRel l)+ ++ mb (atomAttr "type") (linkType l)+ ++ mb (atomAttr "hreflang") (linkHrefLang l)+ ++ mb (atomAttr "title") (linkTitle l)+ ++ mb (atomAttr "length") (linkLength l)+ ++ linkAttrs l+ }++xmlSource :: Source -> Element+xmlSource s = atomNode "source"+ $ map Elem+ $ sourceOther s+ ++ map xmlAuthor (sourceAuthors s)+ ++ map xmlCategory (sourceCategories s)+ ++ mb xmlGenerator (sourceGenerator s)+ ++ mb xmlIcon (sourceIcon s)+ ++ mb xmlId (sourceId s)+ ++ map xmlLink (sourceLinks s)+ ++ mb xmlLogo (sourceLogo s)+ ++ mb xmlRights (sourceRights s)+ ++ mb xmlSubtitle (sourceSubtitle s)+ ++ mb xmlTitle (sourceTitle s)+ ++ mb xmlUpdated (sourceUpdated s)+++xmlGenerator :: Generator -> Element+xmlGenerator g = (atomLeaf "generator" (genText g))+ { elAttribs = mb (atomAttr "uri") (genURI g)+ ++ mb (atomAttr "version") (genVersion g)+ }+++xmlAuthor :: Person -> XML.Element+xmlAuthor p = atomNode "author" (xmlPerson p)++xmlContributor :: Person -> XML.Element+xmlContributor c = atomNode "contributor" (xmlPerson c)++xmlPerson :: Person -> [XML.Content]+xmlPerson p = map Elem $+ [ atomLeaf "name" (personName p) ]+ ++ mb (atomLeaf "uri") (personURI p)+ ++ mb (atomLeaf "email") (personEmail p)+ ++ personOther p++xmlInReplyTo :: InReplyTo -> XML.Element+xmlInReplyTo irt =+ (atomThreadNode "in-reply-to" (replyToContent irt))+ { elAttribs =+ mb (atomThreadAttr "ref") (Just $ replyToRef irt)+ ++ mb (atomThreadAttr "href") (replyToHRef irt)+ ++ mb (atomThreadAttr "type") (replyToType irt)+ ++ mb (atomThreadAttr "source") (replyToSource irt)+ ++ replyToOther irt+ }++xmlInReplyTotal :: InReplyTotal -> XML.Element+xmlInReplyTotal irt =+ (atomThreadLeaf "total" (show $ replyToTotal irt))+ { elAttribs = replyToTotalOther irt }++xmlId :: String -> XML.Element+xmlId i = atomLeaf "id" i++xmlIcon :: URI -> XML.Element+xmlIcon i = atomLeaf "icon" i++xmlLogo :: URI -> XML.Element+xmlLogo l = atomLeaf "logo" l++xmlUpdated :: Date -> XML.Element+xmlUpdated u = atomLeaf "updated" u++xmlPublished :: Date -> XML.Element+xmlPublished p = atomLeaf "published" p++xmlRights :: TextContent -> XML.Element+xmlRights r = xmlTextContent "rights" r++xmlTitle :: TextContent -> XML.Element+xmlTitle r = xmlTextContent "title" r++xmlSubtitle :: TextContent -> XML.Element+xmlSubtitle s = xmlTextContent "subtitle" s++xmlSummary :: TextContent -> XML.Element+xmlSummary s = xmlTextContent "summary" s++xmlTextContent :: String -> TextContent -> XML.Element+xmlTextContent tg t =+ case t of+ TextString s -> (atomLeaf tg s) { elAttribs = [atomAttr "type" "text"] }+ HTMLString s -> (atomLeaf tg s) { elAttribs = [atomAttr "type" "html"] }+ XHTMLString e -> (atomNode tg [XML.Elem e])+ { elAttribs = [atomAttr "type" "xhtml"] }++--------------------------------------------------------------------------------+mb :: (a -> b) -> Maybe a -> [b]+mb _ Nothing = []+mb f (Just x) = [f x]
+ src/Text/Atom/Feed/Import.hs view
@@ -0,0 +1,263 @@+--------------------------------------------------------------------+-- |+-- Module : Text.Atom.Feed.Import+-- Copyright : (c) Galois, Inc. 2007-2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability:: portable+-- Description: Convert from XML to Atom+--+-- Convert from XML to Atom+--+--------------------------------------------------------------------++module Text.Atom.Feed.Import where++import Data.Maybe (listToMaybe, mapMaybe, isJust)+import Data.List (find)+import Control.Monad (guard,mplus)++import Text.Atom.Feed+import Text.Atom.Feed.Export (atomName, atomThreadName)+import Text.XML.Light as XML++pNodes :: String -> [XML.Element] -> [XML.Element]+pNodes x es = filter ((atomName x ==) . elName) es++pQNodes :: QName -> [XML.Element] -> [XML.Element]+pQNodes x es = filter ((x==) . elName) es++pNode :: String -> [XML.Element] -> Maybe XML.Element+pNode x es = listToMaybe (pNodes x es)++pQNode :: QName -> [XML.Element] -> Maybe XML.Element+pQNode x es = listToMaybe (pQNodes x es)++pLeaf :: String -> [XML.Element] -> Maybe String+pLeaf x es = strContent `fmap` pNode x es++pQLeaf :: QName -> [XML.Element] -> Maybe String+pQLeaf x es = strContent `fmap` pQNode x es++pAttr :: String -> XML.Element -> Maybe String+pAttr x e = fmap snd $ find sameAttr [ (k,v) | Attr k v <- elAttribs e ]+ where+ ax = atomName x+ sameAttr (k,_) = k == ax || (not (isJust (qURI k)) && qName k == x)++pAttrs :: String -> XML.Element -> [String]+pAttrs x e = [ v | Attr k v <- elAttribs e, k == atomName x ]++pQAttr :: QName -> XML.Element -> Maybe String+pQAttr x e = lookup x [ (k,v) | Attr k v <- elAttribs e ]++pMany :: String -> (XML.Element -> Maybe a) -> [XML.Element] -> [a]+pMany p f es = mapMaybe f (pNodes p es)++children :: XML.Element -> [XML.Element]+children e = onlyElems (elContent e)++elementFeed :: XML.Element -> Maybe Feed+elementFeed e =+ do guard (elName e == atomName "feed")+ let es = children e+ i <- pLeaf "id" es+ t <- pTextContent "title" es `mplus` return (TextString "<no-title>")+ u <- pLeaf "updated" es+ return Feed+ { feedId = i+ , feedTitle = t+ , feedSubtitle = pTextContent "subtitle" es+ , feedUpdated = u+ , feedAuthors = pMany "author" pPerson es+ , feedContributors = pMany "contributor" pPerson es+ , feedCategories = pMany "category" pCategory es+ , feedGenerator = pGenerator `fmap` pNode "generator" es+ , feedIcon = pLeaf "icon" es+ , feedLogo = pLeaf "logo" es+ , feedRights = pTextContent "rights" es+ , feedLinks = pMany "link" pLink es+ , feedEntries = pMany "entry" pEntry es+ , feedOther = other_es es+ , feedAttrs = other_as (elAttribs e)+ }+ where+ other_es es = filter (\ el -> not (elName el `elem` known_elts))+ es++ other_as as = filter (\ a -> not (attrKey a `elem` known_attrs))+ as++ -- let's have them all (including xml:base and xml:lang + xmlns: stuff)+ known_attrs = []+ known_elts = map atomName+ [ "author"+ , "category"+ , "contributor"+ , "generator"+ , "icon"+ , "id"+ , "link"+ , "logo"+ , "rights"+ , "subtitle"+ , "title"+ , "updated"+ , "entry"+ ]++pTextContent :: String -> [XML.Element] -> Maybe TextContent+pTextContent tag es =+ do e <- pNode tag es+ case pAttr "type" e of+ Nothing -> return (TextString (strContent e))+ Just "text" -> return (TextString (strContent e))+ Just "html" -> return (HTMLString (strContent e))+ Just "xhtml" -> case children e of -- hmm...+ [c] -> return (XHTMLString c)+ _ -> Nothing -- Multiple XHTML children.+ _ -> Nothing -- Unknown text content type.++pPerson :: XML.Element -> Maybe Person+pPerson e =+ do let es = children e+ name <- pLeaf "name" es -- or missing "name"+ return Person+ { personName = name+ , personURI = pLeaf "uri" es+ , personEmail = pLeaf "email" es+ , personOther = [] -- XXX?+ }++pCategory :: XML.Element -> Maybe Category+pCategory e =+ do term <- pAttr "term" e -- or missing "term" attribute+ return Category+ { catTerm = term+ , catScheme = pAttr "scheme" e+ , catLabel = pAttr "label" e+ , catOther = [] -- XXX?+ }++pGenerator :: XML.Element -> Generator+pGenerator e = Generator+ { genURI = pAttr "href" e+ , genVersion = pAttr "version" e+ , genText = strContent e+ }++pSource :: XML.Element -> Source+pSource e =+ let es = children e+ in Source+ { sourceAuthors = pMany "author" pPerson es+ , sourceCategories = pMany "category" pCategory es+ , sourceGenerator = pGenerator `fmap` pNode "generator" es+ , sourceIcon = pLeaf "icon" es+ , sourceId = pLeaf "id" es+ , sourceLinks = pMany "link" pLink es+ , sourceLogo = pLeaf "logo" es+ , sourceRights = pTextContent "rights" es+ , sourceSubtitle = pTextContent "subtitle" es+ , sourceTitle = pTextContent "title" es+ , sourceUpdated = pLeaf "updated" es+ , sourceOther = [] -- XXX ?+ }++pLink :: XML.Element -> Maybe Link+pLink e =+ do uri <- pAttr "href" e+ return Link+ { linkHref = uri+ , linkRel = Right `fmap` pAttr "rel" e+ , linkType = pAttr "type" e+ , linkHrefLang = pAttr "hreflang" e+ , linkTitle = pAttr "title" e+ , linkLength = pAttr "length" e+ , linkAttrs = other_as (elAttribs e)+ , linkOther = []+ }+ where+ other_as as = filter (\ a -> not (attrKey a `elem` known_attrs))+ as++ known_attrs = map atomName+ [ "href", "rel", "type", "hreflang", "title", "length"]+++pEntry :: XML.Element -> Maybe Entry+pEntry e =+ do let es = children e+ i <- pLeaf "id" es+ t <- pTextContent "title" es+ u <- pLeaf "updated" es `mplus` pLeaf "published" es+ return Entry+ { entryId = i+ , entryTitle = t+ , entryUpdated = u+ , entryAuthors = pMany "author" pPerson es+ , entryContributor = pMany "contributor" pPerson es+ , entryCategories = pMany "category" pCategory es+ , entryContent = pContent =<< pNode "content" es+ , entryLinks = pMany "link" pLink es+ , entryPublished = pLeaf "published" es+ , entryRights = pTextContent "rights" es+ , entrySource = pSource `fmap` pNode "source" es+ , entrySummary = pTextContent "summary" es+ , entryInReplyTo = pInReplyTo es+ , entryInReplyTotal = pInReplyTotal es+ , entryAttrs = other_as (elAttribs e)+ , entryOther = [] -- ?+ }+ where+ other_as as = filter (\ a -> not (attrKey a `elem` known_attrs))+ as++ -- let's have them all (including xml:base and xml:lang + xmlns: stuff)+ known_attrs = []++pContent :: XML.Element -> Maybe EntryContent+pContent e =+ case pAttr "type" e of+ Nothing -> return (TextContent (strContent e))+ Just "text" -> return (TextContent (strContent e))+ Just "html" -> return (HTMLContent (strContent e))+ Just "xhtml" ->+ case children e of+ [] -> return (TextContent "")+ [c] -> return (XHTMLContent c)+ _ -> Nothing+ Just ty ->+ case pAttr "src" e of+ Nothing -> return (MixedContent (Just ty) (elContent e))+ Just uri -> return (ExternalContent (Just ty) uri)++pInReplyTotal :: [XML.Element] -> Maybe InReplyTotal+pInReplyTotal es = do+ t <- pQLeaf (atomThreadName "total") es+ case reads t of+ ((x,_):_) -> do+ n <- pQNode (atomThreadName "total") es+ return InReplyTotal+ { replyToTotal = x+ , replyToTotalOther = elAttribs n+ }+ _ -> fail "no parse"++pInReplyTo :: [XML.Element] -> Maybe InReplyTo+pInReplyTo es = do+ t <- pQNode (atomThreadName "reply-to") es+ case pQAttr (atomThreadName "ref") t of+ Just ref ->+ return InReplyTo+ { replyToRef = ref+ , replyToHRef = pQAttr (atomThreadName "href") t+ , replyToType = pQAttr (atomThreadName "type") t+ , replyToSource = pQAttr (atomThreadName "source") t+ , replyToOther = elAttribs t -- ToDo: snip out matched ones.+ , replyToContent = elContent t+ }+ _ -> fail "no parse"
+ src/Text/Atom/Feed/Link.hs view
@@ -0,0 +1,81 @@+--------------------------------------------------------------------+-- |+-- Module : Text.Atom.Feed.Link+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+--------------------------------------------------------------------++module Text.Atom.Feed.Link+ ( LinkRelation(..)+ , showLinkRelation+ , showLinkAttr+ ) where++-- | Atom feeds uses typed IRI links to represent+-- information \/ metadata that is of interest to the+-- consumers (software, in the main) of feeds. For instance,+-- the edit link relation attached to an atom:entry element+-- points to the IRI to use to update\/edit it.+--+-- The Atom standard encourages that such typed links to+-- be registered with IANA if they have wider applicability,+-- and the 'LinkRelation' data type encodes the currently+-- registered link types (derived from:+-- http:\/\/www.iana.org\/assignments\/link-relations.html+-- on 2007-10-28]+--+data LinkRelation -- relevant RFC:+ = LinkAlternate -- http://www.rfc-editor.org/rfc/rfc4287.txt+ | LinkCurrent -- http://www.rfc-editor.org/rfc/rfc5005.txt+ | LinkEnclosure -- http://www.rfc-editor.org/rfc/rfc4287.txt+ | LinkEdit -- http://www.rfc-editor.org/rfc/rfc5023.txt+ | LinkEditMedia -- http://www.rfc-editor.org/rfc/rfc5023.txt+ | LinkFirst -- http://www.iana.org/assignments/link-relations/first+ | LinkLast -- http://www.iana.org/assignments/link-relations/last+ | LinkLicense -- http://www.rfc-editor.org/rfc/rfc4946.txt+ | LinkNext -- http://www.rfc-editor.org/rfc/rfc5005.txt+ | LinkNextArchive -- http://www.rfc-editor.org/rfc/rfc5005.txt+ | LinkPayment -- http://www.iana.org/assignments/link-relations/payment+ | LinkPrevArchive -- http://www.rfc-editor.org/rfc/rfc5005.txt+ | LinkPrevious -- http://www.rfc-editor.org/rfc/rfc5005.txt+ | LinkRelated -- http://www.rfc-editor.org/rfc/rfc4287.txt+ | LinkReplies -- http://www.rfc-editor.org/rfc/rfc4685.txt+ | LinkSelf -- http://www.rfc-editor.org/rfc/rfc4287.txt+ | LinkVia -- http://www.rfc-editor.org/rfc/rfc4287.txt+ | LinkOther String+ deriving (Eq, Show)++showLinkRelation :: LinkRelation -> String+showLinkRelation lr =+ case lr of+ LinkAlternate -> "alternate"+ LinkCurrent -> "current"+ LinkEnclosure -> "enclosure"+ LinkEdit -> "edit"+ LinkEditMedia -> "edit-media"+ LinkFirst -> "first"+ LinkLast -> "last"+ LinkLicense -> "license"+ LinkNext -> "next"+ LinkNextArchive -> "next-archive"+ LinkPayment -> "payment"+ LinkPrevArchive -> "prev-archive"+ LinkPrevious -> "previous"+ LinkRelated -> "related"+ LinkReplies -> "replies"+ LinkSelf -> "self"+ LinkVia -> "via"+ LinkOther s -> s++showLinkAttr :: LinkRelation -> String{-URI-} -> String+showLinkAttr lr s = showLinkRelation lr ++ '=':'"':concatMap escQ s ++ "\""+ where+ escQ '"' = "&dquot;"+ escQ x = [x]+
+ src/Text/Atom/Feed/Validate.hs view
@@ -0,0 +1,295 @@+--------------------------------------------------------------------+-- |+-- Module : Text.Atom.Feed.Validate+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+--------------------------------------------------------------------+module Text.Atom.Feed.Validate where++import Text.Atom.Feed.Import+import Text.XML.Light.Types+import Text.XML.Light.Proc+++import Data.List+import Data.Maybe++data VTree a = VNode [a] [VTree a] | VLeaf [a]+ deriving (Eq, Show)++type ValidatorResult = VTree (Bool,String)++advice :: String -> ValidatorResult+advice s = VLeaf [(False,s)]++demand :: String -> ValidatorResult+demand s = VLeaf [(True,s)]++valid :: ValidatorResult+valid = VLeaf []++mkTree :: [(Bool,String)] -> [ValidatorResult] -> ValidatorResult+mkTree as bs = VNode as bs++flattenT :: VTree a -> [a]+flattenT (VLeaf xs) = xs+flattenT (VNode as bs) = as ++ concatMap flattenT bs++validateEntry :: Element -> ValidatorResult+validateEntry e =+ mkTree []+ [ checkEntryAuthor e+ , checkCats e+ , checkContents e+ , checkContributor e+ , checkId e+ , checkContentLink e+ , checkLinks e+ , checkPublished e+ , checkRights e+ , checkSource e+ , checkSummary e+ , checkTitle e+ , checkUpdated e+ ]++-- Sec 4.1.2, check #1+checkEntryAuthor :: Element -> ValidatorResult+checkEntryAuthor e =+ case pNodes "author" (elChildren e) of+ [] -> -- required+ case pNode "summary" (elChildren e) of+ Nothing -> demand "Required 'author' element missing (no 'summary' either)"+ Just e1 ->+ case pNode "author" (elChildren e1) of+ Just a -> checkAuthor a+ _ -> demand "Required 'author' element missing"+ xs -> mkTree [] $ map checkAuthor xs+++-- Sec 4.1.2, check #2+checkCats :: Element -> ValidatorResult+checkCats e = mkTree [] $ map checkCat (pNodes "category" (elChildren e))++checkContents :: Element -> ValidatorResult+checkContents e =+ case pNodes "content" (elChildren e) of+ [] -> valid+ [c] -> mkTree [] $ [checkContent c]+ cs -> mkTree (flattenT (demand ("at most one 'content' element expected inside 'entry', found: " ++ show (length cs))))+ (map checkContent cs)+++checkContributor :: Element -> ValidatorResult+checkContributor _e = valid++checkContentLink :: Element -> ValidatorResult+checkContentLink e =+ case pNodes "content" (elChildren e) of+ [] ->+ case pNodes "link" (elChildren e) of+ [] -> demand ("An 'entry' element with no 'content' element must have at least one 'link-rel' element")+ xs ->+ case filter (=="alternate") $ mapMaybe (pAttr "rel") xs of+ [] -> demand ("An 'entry' element with no 'content' element must have at least one 'link-rel' element")+ _ -> valid+ _ -> valid++checkLinks :: Element -> ValidatorResult+checkLinks e =+ case pNodes "link" (elChildren e) of+ xs ->+ case map fst $ filter (\ (_,n) -> n =="alternate") $+ mapMaybe (\ ex -> fmap (\x -> (ex,x)) $ pAttr "rel" ex) xs of+ xs1 ->+ let+ jmb (Just x) (Just y) = Just (x,y)+ jmb _ _ = Nothing+ in+ case mapMaybe (\ ex -> pAttr "type" ex `jmb` pAttr "hreflang" ex) xs1 of+ xs2 ->+ case any (\ x -> length x > 1) (group xs2) of+ True -> demand ("An 'entry' element cannot have duplicate 'link-rel-alternate-type-hreflang' elements")+ _ -> valid++checkId :: Element -> ValidatorResult+checkId e =+ case pNodes "id" (elChildren e) of+ [] -> demand "required field 'id' missing from 'entry' element"+ [_] -> valid+ xs -> demand ("only one 'id' field expected in 'entry' element, found: " ++ show (length xs))++checkPublished :: Element -> ValidatorResult+checkPublished e =+ case pNodes "published" (elChildren e) of+ [] -> valid+ [_] -> valid+ xs -> demand ("expected at most one 'published' field in 'entry' element, found: " ++ show (length xs))++checkRights :: Element -> ValidatorResult+checkRights e =+ case pNodes "rights" (elChildren e) of+ [] -> valid+ [_] -> valid+ xs -> demand ("expected at most one 'rights' field in 'entry' element, found: " ++ show (length xs))++checkSource :: Element -> ValidatorResult+checkSource e =+ case pNodes "source" (elChildren e) of+ [] -> valid+ [_] -> valid+ xs -> demand ("expected at most one 'source' field in 'entry' element, found: " ++ show (length xs))++checkSummary :: Element -> ValidatorResult+checkSummary e =+ case pNodes "summary" (elChildren e) of+ [] -> valid+ [_] -> valid+ xs -> demand ("expected at most one 'summary' field in 'entry' element, found: " ++ show (length xs))++checkTitle :: Element -> ValidatorResult+checkTitle e =+ case pNodes "title" (elChildren e) of+ [] -> demand "required field 'title' missing from 'entry' element"+ [_] -> valid+ xs -> demand ("only one 'title' field expected in 'entry' element, found: " ++ show (length xs))++checkUpdated :: Element -> ValidatorResult+checkUpdated e =+ case pNodes "updated" (elChildren e) of+ [] -> demand "required field 'updated' missing from 'entry' element"+ [_] -> valid+ xs -> demand ("only one 'updated' field expected in 'entry' element, found: " ++ show (length xs))++checkCat :: Element -> ValidatorResult+checkCat e = mkTree []+ [ checkTerm e+ , checkScheme e+ , checkLabel e+ ]+ where+ checkScheme e' =+ case pAttrs "scheme" e' of+ [] -> valid+ (_:xs)+ | null xs -> valid+ | otherwise -> demand ("Expected at most one 'scheme' attribute, found: " ++ show (1+length xs))++ checkLabel e' =+ case pAttrs "label" e' of+ [] -> valid+ (_:xs)+ | null xs -> valid+ | otherwise -> demand ("Expected at most one 'label' attribute, found: " ++ show (1+length xs))++checkContent :: Element -> ValidatorResult+checkContent e = mkTree (flattenT (mkTree [] [type_valid, src_valid]))+ [case ty of+ "text" ->+ case onlyElems (elContent e) of+ [] -> valid+ _ -> demand ("content with type 'text' cannot have child elements, text only.")+ "html" ->+ case onlyElems (elContent e) of+ [] -> valid+ _ -> demand ("content with type 'html' cannot have child elements, text only.")++ "xhtml" ->+ case onlyElems (elContent e) of+ [] -> valid+ [_] -> valid -- ToDo: check that it is a 'div'.+ _ds -> demand ("content with type 'xhtml' should only contain one 'div' child.")+ _ -> valid]+{-+ case parseMIMEType ty of+ Nothing -> valid+ Just mt+ | isXmlType mt -> valid+ | otherwise ->+ case onlyElems (elContent e) of+ [] -> valid -- check+ _ -> demand ("content with MIME type '" ++ ty ++ "' must only contain base64 data")]+-}+ where+ types = pAttrs "type" e+ (ty, type_valid) =+ case types of+ [] -> ("text", valid)+ [t] -> checkTypeA t+ (t:ts) -> (t, demand ("Expected at most one 'type' attribute, found: " ++ show (1+length ts)))++ src_valid =+ case pAttrs "src" e of+ [] -> valid+ [_] ->+ case types of+ [] -> advice "It is advisable to provide a 'type' along with a 'src' attribute"+ (_:_) -> valid+{-+ case parseMIMEType t of+ Just{} -> valid+ _ -> demand "The 'type' attribute must be a valid MIME type"+-}+ ss -> demand ("Expected at most one 'src' attribute, found: " ++ show (length ss))+++ checkTypeA v+ | v `elem` std_types = (v, valid)+ | otherwise = (v,valid)+{-+ case parseMIMEType v of+ Nothing -> ("text", demand ("Invalid/unknown type value " ++ v))+ Just mt ->+ case mimeType mt of+ Multipart{} -> ("text", demand "Multipart MIME types not a legal 'type'")+ _ -> (v, valid)+-}+ where+ std_types = [ "text", "xhtml", "html"]++checkTerm :: Element -> ValidatorResult+checkTerm e =+ case pNodes "term" (elChildren e) of+ [] -> demand "required field 'term' missing from 'category' element"+ [_] -> valid+ xs -> demand ("only one 'term' field expected in 'category' element, found: " ++ show (length xs))++checkAuthor :: Element -> ValidatorResult+checkAuthor e = checkPerson e++checkPerson :: Element -> ValidatorResult+checkPerson e =+ mkTree (flattenT $ checkName e)+ [ checkEmail e+ , checkUri e+ ]++checkName :: Element -> ValidatorResult+checkName e =+ case pNodes "name" (elChildren e) of+ [] -> demand "required field 'name' missing from 'author' element"+ [_] -> valid+ xs -> demand ("only one 'name' expected in 'author' element, found: " ++ show (length xs))++checkEmail :: Element -> ValidatorResult+checkEmail e =+ case pNodes "email" (elChildren e) of+ [] -> valid+ (_:xs)+ | null xs -> valid+ | otherwise -> demand ("at most one 'email' expected in 'author' element, found: " ++ show (1+length xs))++checkUri :: Element -> ValidatorResult+checkUri e =+ case pNodes "email" (elChildren e) of+ [] -> valid+ (_:xs)+ | null xs -> valid+ | otherwise -> demand ("at most one 'uri' expected in 'author' element, found: " ++ show (1+length xs))+
+ src/Text/Atom/Pub.hs view
@@ -0,0 +1,47 @@+--------------------------------------------------------------------+-- |+-- Module : Text.Atom.Pub+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+-- Types for the Atom Publishing Protocol (APP)+--+--------------------------------------------------------------------+module Text.Atom.Pub where++import Text.XML.Light.Types as XML+import Text.Atom.Feed ( TextContent, Category, URI )++data Service+ = Service+ { serviceWorkspaces :: [Workspace]+ , serviceOther :: [XML.Element]+ }++data Workspace+ = Workspace+ { workspaceTitle :: TextContent+ , workspaceCols :: [Collection]+ , workspaceOther :: [XML.Element]+ }++data Collection+ = Collection+ { collectionURI :: URI+ , collectionTitle :: TextContent+ , collectionAccept :: [Accept]+ , collectionCats :: [Categories]+ , collectionOther :: [XML.Element]+ }++data Categories+ = CategoriesExternal URI+ | Categories (Maybe Bool) (Maybe URI) [Category]+ deriving (Show)++newtype Accept = Accept { acceptType :: String }
+ src/Text/Atom/Pub/Export.hs view
@@ -0,0 +1,88 @@+--------------------------------------------------------------------+-- |+-- Module : Text.Atom.Pub.Export+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability:: portable+-- Description: Serializing APP types (as XML.)+--+-- Serializing Atom Publishing Protocol types as XML.+--+--------------------------------------------------------------------+module Text.Atom.Pub.Export where++import Text.XML.Light+import Text.Atom.Pub+import Text.Atom.Feed.Export+ ( mb, xmlCategory, xmlTitle+ , xmlns_atom+ )++showServiceDoc :: Service -> String+showServiceDoc s = showElement (xmlService s)++-- ToDo: old crud; inline away.+mkQName :: Maybe String -> String -> QName+mkQName a b = blank_name{qPrefix=a,qName=b}++mkElem :: QName -> [Attr] -> [Element] -> Element+mkElem a b c = node a ((b::[Attr]),(c::[Element]))++mkLeaf :: QName -> [Attr] -> String -> Element+mkLeaf a b c = node (a::QName) ((b::[Attr]),[Text blank_cdata{cdData=c}])++mkAttr :: String -> String -> Attr+mkAttr a b = Attr blank_name{qName=a} b++xmlns_app :: Attr+xmlns_app = Attr (mkQName (Just "xmlns") "app") appNS+++appNS :: String+appNS = "http://purl.org/atom/app#"++appName :: String -> QName+appName nc = (mkQName (Just "app") nc){qURI=Just appNS}++xmlService :: Service -> Element+xmlService s =+ mkElem (appName "service") [xmlns_app,xmlns_atom]+ (concat [ map xmlWorkspace (serviceWorkspaces s)+ , serviceOther s+ ])++xmlWorkspace :: Workspace -> Element+xmlWorkspace w =+ mkElem (appName "workspace")+ [mkAttr "xml:lang" "en"]+ (concat [ [xmlTitle (workspaceTitle w)]+ , map xmlCollection (workspaceCols w)+ , workspaceOther w+ ])++xmlCollection :: Collection -> Element+xmlCollection c =+ mkElem (appName "collection")+ [mkAttr "href" (collectionURI c)]+ (concat [ [xmlTitle (collectionTitle c)]+ , map xmlAccept (collectionAccept c)+ , map xmlCategories (collectionCats c)+ , collectionOther c+ ])++xmlCategories :: Categories -> Element+xmlCategories (CategoriesExternal u) =+ mkElem (appName "categories") [mkAttr "href" u] []+xmlCategories (Categories mbFixed mbScheme cs) =+ mkElem (appName "categories")+ (concat [ mb (\ f -> mkAttr "fixed" (if f then "yes" else "no")) mbFixed+ , mb (mkAttr "scheme") mbScheme+ ])+ (map xmlCategory cs)++xmlAccept :: Accept -> Element+xmlAccept a = mkLeaf (appName "accept") [] (acceptType a)
+ src/Text/DublinCore/Types.hs view
@@ -0,0 +1,82 @@+--------------------------------------------------------------------+-- |+-- Module : Text.DublinCore.Types+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+--+-- Representing the DublinCore metadata elements in Haskell.+-- For information on the Dublin Core Metadata Element Set,+-- see: <http://dublincore.org/>+--+module Text.DublinCore.Types where++-- | A DCItem pairs a specific element with its (string) value.+data DCItem+ = DCItem+ { dcElt :: DCInfo+ , dcText :: String+ }+ deriving (Eq, Show)++-- | The Dublin Core Metadata Element Set, all 15 of them (plus an extension constructor.)+data DCInfo+ = DC_Title -- ^ A name given to the resource.+ | DC_Creator -- ^ An entity primarily responsible for making the content of the resource.+ | DC_Subject -- ^ The topic of the content of the resource.+ | DC_Description -- ^ An account of the content of the resource.+ | DC_Publisher -- ^ An entity responsible for making the resource available+ | DC_Contributor -- ^ An entity responsible for making contributions to the content of the resource.+ | DC_Date -- ^ A date associated with an event in the life cycle of the resource (YYYY-MM-DD)+ | DC_Type -- ^ The nature or genre of the content of the resource.+ | DC_Format -- ^ The physical or digital manifestation of the resource.+ | DC_Identifier -- ^ An unambiguous reference to the resource within a given context.+ | DC_Source -- ^ A Reference to a resource from which the present resource is derived.+ | DC_Language -- ^ A language of the intellectual content of the resource.+ | DC_Relation -- ^ A reference to a related resource.+ | DC_Coverage -- ^ The extent or scope of the content of the resource.+ | DC_Rights -- ^ Information about rights held in and over the resource.+ | DC_Other String -- ^ Other; data type extension mechanism.+ deriving (Eq, Show)++infoToTag :: DCInfo -> String+infoToTag i =+ case i of+ DC_Title -> "title"+ DC_Creator -> "creator"+ DC_Subject -> "subject"+ DC_Description -> "description"+ DC_Publisher -> "publisher"+ DC_Contributor -> "contributor"+ DC_Date -> "date"+ DC_Type -> "type"+ DC_Format -> "format"+ DC_Identifier -> "identifier"+ DC_Source -> "source"+ DC_Language -> "language"+ DC_Relation -> "relation"+ DC_Coverage -> "coverage"+ DC_Rights -> "rights"+ DC_Other o -> o++dc_element_names :: [String]+dc_element_names+ = [ "title"+ , "creator"+ , "subject"+ , "description"+ , "publisher"+ , "contributor"+ , "date"+ , "type"+ , "format"+ , "identifier"+ , "source"+ , "language"+ , "relation"+ , "coverage"+ , "rights"+ ]
+ src/Text/Feed/Constructor.hs view
@@ -0,0 +1,726 @@+--------------------------------------------------------------------+-- |+-- Module : Text.Feed.Constructor+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Description: Module for an abstraction layer between different kinds of feeds.+--+--------------------------------------------------------------------++module Text.Feed.Constructor+ ( FeedKind(..)+ , newFeed -- :: FeedKind -> Feed+ , feedFromRSS -- :: RSS -> Feed+ , feedFromAtom -- :: Atom.Feed -> Feed+ , feedFromRDF -- :: RSS1.Feed -> Feed+ , feedFromXML -- :: Element -> Feed+ , getFeedKind -- :: Feed -> FeedKind++ , FeedSetter -- type _ a = a -> Feed -> Feed+ , addItem -- :: FeedSetter Item++ , withFeedTitle -- :: FeedSetter String+ , withFeedHome -- :: FeedSetter URLString+ , withFeedHTML -- :: FeedSetter URLString+ , withFeedDescription -- :: FeedSetter String+ , withFeedPubDate -- :: FeedSetter DateString+ , withFeedLastUpdate -- :: FeedSetter DateString+ , withFeedDate -- :: FeedSetter DateString+ , withFeedLogoLink -- :: FeedSetter URLString+ , withFeedLanguage -- :: FeedSetter String+ , withFeedCategories -- :: FeedSetter [(String,Maybe String)]+ , withFeedGenerator -- :: FeedSetter String+ , withFeedItems -- :: FeedSetter [Item]++ , newItem -- :: FeedKind -> Item+ , getItemKind -- :: Item -> FeedKind+ , atomEntryToItem -- :: Atom.Entry -> Item+ , rssItemToItem -- :: RSS.Item -> Item+ , rdfItemToItem -- :: RSS1.Item -> Item++ , ItemSetter -- type _ a = a -> Item -> Item+ , withItemTitle -- :: ItemSetter String+ , withItemLink -- :: ItemSetter URLString+ , withItemPubDate -- :: ItemSetter DateString+ , withItemDate -- :: ItemSetter DateString+ , withItemAuthor -- :: ItemSetter String+ , withItemCommentLink -- :: ItemSetter String+ , withItemEnclosure -- :: String -> Maybe String -> ItemSetter Integer+ , withItemFeedLink -- :: String -> ItemSetter String+ , withItemId -- :: Bool -> ItemSetter String+ , withItemCategories -- :: ItemSetter [(String, Maybe String)]+ , withItemDescription -- :: ItemSetter String+ , withItemRights -- :: ItemSetter String+ ) where++import Text.Feed.Types as Feed.Types++import Text.Atom.Feed as Atom+import Text.RSS.Syntax as RSS+import Text.RSS1.Syntax as RSS1+import Text.DublinCore.Types+import Text.XML.Light as XML hiding ( filterChildren )++import Data.Maybe ( fromMaybe, mapMaybe )+import Data.Char ( toLower )++-- ToDo:+--+-- - complete set of constructors over feeds+-- - provide a unified treatment of date string reps.+-- (i.e., I know they differ across formats, but ignorant what+-- the constraints are at the moment.)+++-- | Construct an empty feed document, intending to output it in+-- the 'fk' feed format.+newFeed :: FeedKind -> Feed.Types.Feed+newFeed fk =+ case fk of+ AtomKind -> AtomFeed (Atom.nullFeed "feed-id-not-filled-in"+ (TextString "dummy-title")+ "dummy-and-bogus-update-date")+ RSSKind mbV ->+ let def = (RSS.nullRSS "dummy-title" "default-channel-url") in+ RSSFeed $ fromMaybe def $ fmap (\ v -> def{RSS.rssVersion=v}) mbV+ RDFKind mbV ->+ let def = (RSS1.nullFeed "default-channel-url" "dummy-title") in+ RSS1Feed $ fromMaybe def $ fmap (\ v -> def{RSS1.feedVersion=v}) mbV+++feedFromRSS :: RSS.RSS -> Feed.Types.Feed+feedFromRSS r = RSSFeed r++feedFromAtom :: Atom.Feed -> Feed.Types.Feed+feedFromAtom f = AtomFeed f++feedFromRDF :: RSS1.Feed -> Feed.Types.Feed+feedFromRDF f = RSS1Feed f++feedFromXML :: XML.Element -> Feed.Types.Feed+feedFromXML f = XMLFeed f++getFeedKind :: Feed.Types.Feed -> FeedKind+getFeedKind f =+ case f of+ Feed.Types.AtomFeed{} -> AtomKind+ Feed.Types.RSSFeed r -> RSSKind (case RSS.rssVersion r of { "2.0" -> Nothing; v -> Just v})+ Feed.Types.RSS1Feed r -> RDFKind (case RSS1.feedVersion r of { "1.0" -> Nothing; v -> Just v})+ Feed.Types.XMLFeed{} -> RSSKind (Just "2.0") -- for now, just a hunch..++addItem :: Feed.Types.Item -> Feed.Types.Feed -> Feed.Types.Feed+addItem it f =+ case (it,f) of+ (Feed.Types.AtomItem e, Feed.Types.AtomFeed fe) ->+ Feed.Types.AtomFeed fe{Atom.feedEntries=e:Atom.feedEntries fe}+ (Feed.Types.RSSItem e, Feed.Types.RSSFeed r) ->+ Feed.Types.RSSFeed r{RSS.rssChannel=(RSS.rssChannel r){RSS.rssItems=e:RSS.rssItems (RSS.rssChannel r)}}+ (Feed.Types.RSS1Item e, Feed.Types.RSS1Feed r) ->+ -- note: do not update the channel item URIs at this point;+ -- will delay doing so until serialization.+ Feed.Types.RSS1Feed r{RSS1.feedItems=e:RSS1.feedItems r}+ _ -> error "addItem: currently unable to automatically convert items from one feed type to another"++withFeedItems :: FeedSetter [Feed.Types.Item]+withFeedItems is fe =+ foldr addItem+ (case fe of+ Feed.Types.AtomFeed f -> Feed.Types.AtomFeed+ f{Atom.feedEntries=[]}+ Feed.Types.RSSFeed f -> Feed.Types.RSSFeed+ f{rssChannel=(rssChannel f){rssItems=[]}}+ Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed+ f{feedItems=[]})+ is++newItem :: FeedKind -> Feed.Types.Item+newItem fk =+ case fk of+ AtomKind -> Feed.Types.AtomItem $+ Atom.nullEntry "entry-id-not-filled-in"+ (TextString "dummy-entry-title")+ "dummy-and-bogus-entry-update-date"+ RSSKind{} -> Feed.Types.RSSItem $+ RSS.nullItem "dummy-rss-item-title"+ RDFKind{} -> Feed.Types.RSS1Item $+ RSS1.nullItem "dummy-item-uri"+ "dummy-item-title"+ "dummy-item-link"++getItemKind :: Feed.Types.Item -> FeedKind+getItemKind f =+ case f of+ Feed.Types.AtomItem{} -> AtomKind+ Feed.Types.RSSItem{} -> RSSKind (Just "2.0") -- good guess..+ Feed.Types.RSS1Item{} -> RDFKind (Just "1.0")+ Feed.Types.XMLItem{} -> RSSKind (Just "2.0")++type FeedSetter a = a -> Feed.Types.Feed -> Feed.Types.Feed++withFeedTitle :: FeedSetter String+withFeedTitle tit fe =+ case fe of+ Feed.Types.AtomFeed f -> Feed.Types.AtomFeed f{feedTitle=TextString tit}+ Feed.Types.RSSFeed f -> Feed.Types.RSSFeed f{rssChannel=(rssChannel f){rssTitle=tit}}+ Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed f{feedChannel=(feedChannel f){channelTitle=tit}}+ Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $+ mapMaybeChildren (\ e ->+ if (elName e == unqual "channel")+ then Just (mapMaybeChildren (\ e2 ->+ if (elName e2 == unqual "title")+ then Just (unode "title" tit)+ else Nothing) e)+ else Nothing) f++withFeedHome :: FeedSetter URLString+withFeedHome url fe =+ case fe of+ Feed.Types.AtomFeed f -> Feed.Types.AtomFeed f{feedLinks=newSelf:Atom.feedLinks f}+ -- ToDo: fix, the <link> element is for the HTML home of the channel, not the+ -- location of the feed itself. Struggling to find if there is a common way+ -- to represent this outside of RSS 2.0 standard elements..+ Feed.Types.RSSFeed f -> Feed.Types.RSSFeed f{rssChannel=(rssChannel f){rssLink=url}}+ Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed f{feedChannel=(feedChannel f){channelURI=url}}+ Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $+ mapMaybeChildren (\ e ->+ if (elName e == unqual "channel")+ then Just (mapMaybeChildren (\ e2 ->+ if (elName e2 == unqual "link")+ then Just (unode "link" url)+ else Nothing) e)+ else Nothing) f+ where+ newSelf = (nullLink url){ linkRel=Just (Left "self")+ , linkType=Just "application/atom+xml"+ }++-- | 'withFeedHTML' sets the URL where an HTML version of the+-- feed is published.+withFeedHTML :: FeedSetter URLString+withFeedHTML url fe =+ case fe of+ Feed.Types.AtomFeed f -> Feed.Types.AtomFeed f{feedLinks=newAlt:Atom.feedLinks f}+ Feed.Types.RSSFeed f -> Feed.Types.RSSFeed f{rssChannel=(rssChannel f){rssLink=url}}+ Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed f{feedChannel=(feedChannel f){channelLink=url}}+ Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $+ mapMaybeChildren (\ e ->+ if (elName e == unqual "channel")+ then Just (mapMaybeChildren (\ e2 ->+ if (elName e2 == unqual "link")+ then Just (unode "link" url)+ else Nothing) e)+ else Nothing) f+ where+ newAlt = (nullLink url){ linkRel=Just (Left "alternate")+ , linkType=Just "text/html"+ }++-- | 'withFeedHTML' sets the URL where an HTML version of the+-- feed is published.+withFeedDescription :: FeedSetter String+withFeedDescription desc fe =+ case fe of+ Feed.Types.AtomFeed f -> Feed.Types.AtomFeed+ f{feedSubtitle=Just (TextString desc)}+ Feed.Types.RSSFeed f -> Feed.Types.RSSFeed+ f{rssChannel=(rssChannel f){rssDescription=desc}}+ Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed+ f{feedChannel=(feedChannel f){channelDesc=desc}}+ Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $+ mapMaybeChildren (\ e ->+ if (elName e == unqual "channel")+ then Just (mapMaybeChildren (\ e2 ->+ if (elName e2 == unqual "description")+ then Just (unode "description" desc)+ else Nothing) e)+ else Nothing) f++withFeedPubDate :: FeedSetter String+withFeedPubDate dateStr fe =+ case fe of+ Feed.Types.AtomFeed f -> Feed.Types.AtomFeed+ f{feedUpdated=dateStr}+ Feed.Types.RSSFeed f -> Feed.Types.RSSFeed+ f{rssChannel=(rssChannel f){rssPubDate=Just dateStr}}+ Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed $+ case break isDate $ RSS1.channelDC (RSS1.feedChannel f) of+ (as,(dci:bs)) ->+ f{RSS1.feedChannel=+ (RSS1.feedChannel f)+ {RSS1.channelDC=as++dci{dcText=dateStr}:bs}}+ (_,[]) ->+ f{RSS1.feedChannel=+ (RSS1.feedChannel f)+ {RSS1.channelDC=+ DCItem{dcElt=DC_Date,dcText=dateStr}:+ RSS1.channelDC (RSS1.feedChannel f)}}+ Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $+ mapMaybeChildren (\ e ->+ if (elName e == unqual "channel")+ then Just (mapMaybeChildren (\ e2 ->+ if (elName e2 == unqual "pubDate")+ then Just (unode "pubDate" dateStr)+ else Nothing) e)+ else Nothing) f+ where+ isDate dc = dcElt dc == DC_Date++withFeedLastUpdate :: FeedSetter DateString+withFeedLastUpdate dateStr fe =+ case fe of+ Feed.Types.AtomFeed f -> Feed.Types.AtomFeed+ f{feedUpdated=dateStr}+ Feed.Types.RSSFeed f -> Feed.Types.RSSFeed+ f{rssChannel=(rssChannel f){rssLastUpdate=Just dateStr}}+ Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed $+ case break isDate $ RSS1.channelDC (RSS1.feedChannel f) of+ (as,(dci:bs)) ->+ f{RSS1.feedChannel=+ (RSS1.feedChannel f)+ {RSS1.channelDC=as++dci{dcText=dateStr}:bs}}+ (_,[]) ->+ f{RSS1.feedChannel=+ (RSS1.feedChannel f)+ {RSS1.channelDC=+ DCItem{dcElt=DC_Date,dcText=dateStr}:+ RSS1.channelDC (RSS1.feedChannel f)}}+ Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $+ mapMaybeChildren (\ e ->+ if (elName e == unqual "channel")+ then Just (mapMaybeChildren (\ e2 ->+ if (elName e2 == unqual "lastUpdate")+ then Just (unode "lastUpdate" dateStr)+ else Nothing) e)+ else Nothing) f+ where+ isDate dc = dcElt dc == DC_Date+++-- | 'withFeedDate dt' is the composition of 'withFeedPubDate'+-- and 'withFeedLastUpdate', setting both publication date and+-- last update date to 'dt'. Notice that RSS2.0 is the only format+-- supporting both pub and last-update.+withFeedDate :: FeedSetter DateString+withFeedDate dt f = withFeedPubDate dt(withFeedLastUpdate dt f)+++withFeedLogoLink :: URLString -> FeedSetter URLString+withFeedLogoLink imgURL lnk fe =+ case fe of+ Feed.Types.AtomFeed f -> Feed.Types.AtomFeed+ f{ feedLogo = Just imgURL+ , feedLinks = newSelf:Atom.feedLinks f+ }+ Feed.Types.RSSFeed f -> Feed.Types.RSSFeed+ f{ rssChannel=(rssChannel f)+ {rssImage=Just $+ RSS.nullImage imgURL (rssTitle (rssChannel f)) lnk}}+ Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed $+ f{ feedImage = Just $+ RSS1.nullImage imgURL (RSS1.channelTitle (RSS1.feedChannel f)) lnk+ , feedChannel =+ (feedChannel f){channelImageURI=Just imgURL}+ }+ Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $+ mapMaybeChildren (\ e ->+ if (elName e == unqual "channel")+ then Just (mapMaybeChildren (\ e2 ->+ if (elName e2 == unqual "image")+ then Just (unode "image" [ unode "url" imgURL+ , unode "title" title+ , unode "link" lnk+ ])+ else Nothing) e)+ else Nothing) f+ where+ title =+ case fmap (findChild (unqual "title"))+ (findChild (unqual "channel") f) of+ Just (Just e1) -> strContent e1+ _ -> "feed_title" -- shouldn't happen..++ where+ newSelf = (nullLink lnk){ linkRel=Just (Left "self")+ , linkType=Just "application/atom+xml"+ }+++withFeedLanguage :: FeedSetter String+withFeedLanguage lang fe =+ case fe of+ Feed.Types.AtomFeed f -> Feed.Types.AtomFeed $+ f{Atom.feedAttrs=(XML.Attr (unqual "lang"){qPrefix=Just "xml"} lang):Atom.feedAttrs f}+ Feed.Types.RSSFeed f -> Feed.Types.RSSFeed+ f{rssChannel=(rssChannel f){rssLanguage=Just lang}}+ Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed $+ case break isLang $ RSS1.channelDC (RSS1.feedChannel f) of+ (as,(dci:bs)) ->+ f{RSS1.feedChannel=+ (RSS1.feedChannel f)+ {RSS1.channelDC=as++dci{dcText=lang}:bs}}+ (_,[]) ->+ f{RSS1.feedChannel=+ (RSS1.feedChannel f)+ {RSS1.channelDC=+ DCItem{dcElt=DC_Language,dcText=lang}:+ RSS1.channelDC (RSS1.feedChannel f)}}+ Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $+ mapMaybeChildren (\ e ->+ if (elName e == unqual "channel")+ then Just (mapMaybeChildren (\ e2 ->+ if (elName e2 == unqual "language")+ then Just (unode "language" lang)+ else Nothing) e)+ else Nothing) f+ where+ isLang dc = dcElt dc == DC_Language++withFeedCategories :: FeedSetter [(String,Maybe String)]+withFeedCategories cats fe =+ case fe of+ Feed.Types.AtomFeed f -> Feed.Types.AtomFeed+ f{ Atom.feedCategories =+ map ( \ (t,mb) -> (Atom.newCategory t){Atom.catScheme=mb})+ cats ++ feedCategories f}+ Feed.Types.RSSFeed f -> Feed.Types.RSSFeed+ f{rssChannel=(rssChannel f){+ RSS.rssCategories=+ map (\ (t,mb) -> (RSS.newCategory t){RSS.rssCategoryDomain=mb})+ cats ++ RSS.rssCategories (rssChannel f)}}+ Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed+ f{feedChannel=(feedChannel f){+ RSS1.channelDC=+ map (\ (t,_) -> DCItem{dcElt=DC_Subject,dcText=t})+ cats ++ RSS1.channelDC (feedChannel f)}}+ Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $+ mapMaybeChildren (\ e ->+ if (elName e == unqual "channel")+ then Just (+ foldr+ (\ (t,mb) acc ->+ addChild (unode "category"+ (fromMaybe (\x -> [x])+ (fmap (\v -> (\ x -> [Attr (unqual "domain") v,x])) mb) $+ (Attr (unqual "term") t))+ ) acc)+ e+ cats)+ else Nothing) f+++withFeedGenerator :: FeedSetter (String,Maybe URLString)+withFeedGenerator (gen,mbURI) fe =+ case fe of+ Feed.Types.AtomFeed f -> Feed.Types.AtomFeed $+ f{Atom.feedGenerator=Just ((Atom.nullGenerator gen){Atom.genURI=mbURI})}+ Feed.Types.RSSFeed f -> Feed.Types.RSSFeed+ f{rssChannel=(rssChannel f){rssGenerator=Just gen}}+ Feed.Types.RSS1Feed f -> Feed.Types.RSS1Feed $+ case break isSource $ RSS1.channelDC (RSS1.feedChannel f) of+ (as,(dci:bs)) ->+ f{RSS1.feedChannel=+ (RSS1.feedChannel f)+ {RSS1.channelDC=as++dci{dcText=gen}:bs}}+ (_,[]) ->+ f{RSS1.feedChannel=+ (RSS1.feedChannel f)+ {RSS1.channelDC=+ DCItem{dcElt=DC_Source,dcText=gen}:+ RSS1.channelDC (RSS1.feedChannel f)}}+ Feed.Types.XMLFeed f -> Feed.Types.XMLFeed $+ mapMaybeChildren (\ e ->+ if (elName e == unqual "channel")+ then Just (mapMaybeChildren (\ e2 ->+ if (elName e2 == unqual "generator")+ then Just (unode "generator" gen)+ else Nothing) e)+ else Nothing) f+ where+ isSource dc = dcElt dc == DC_Source++++-- Item constructors (all the way to the end):++atomEntryToItem :: Atom.Entry -> Feed.Types.Item+atomEntryToItem e = Feed.Types.AtomItem e++rssItemToItem :: RSS.RSSItem -> Feed.Types.Item+rssItemToItem i = Feed.Types.RSSItem i++rdfItemToItem :: RSS1.Item -> Feed.Types.Item+rdfItemToItem i = Feed.Types.RSS1Item i++type ItemSetter a = a -> Feed.Types.Item -> Feed.Types.Item++-- | 'withItemPubDate dt' associates the creation\/ publication date 'dt'+-- with a feed item.+withItemPubDate :: ItemSetter DateString+withItemPubDate dt fi =+ case fi of+ Feed.Types.AtomItem e ->+ Feed.Types.AtomItem e{Atom.entryUpdated=dt}+ Feed.Types.RSSItem i ->+ Feed.Types.RSSItem i{RSS.rssItemPubDate=Just dt}+ Feed.Types.RSS1Item i ->+ case break isDate $ RSS1.itemDC i of+ (as,(dci:bs)) -> Feed.Types.RSS1Item i{RSS1.itemDC=as++dci{dcText=dt}:bs}+ (_,[]) -> Feed.Types.RSS1Item i{RSS1.itemDC=DCItem{dcElt=DC_Date,dcText=dt}:RSS1.itemDC i}+ Feed.Types.XMLItem i ->+ Feed.Types.XMLItem $+ addChild (unode "pubDate" dt) $+ filterChildren (\ e -> elName e /= unqual "pubDate")+ i+ where+ isDate dc = dcElt dc == DC_Date++-- | 'withItemDate' is a synonym for 'withItemPubDate'.+withItemDate :: ItemSetter DateString+withItemDate dt fi = withItemPubDate dt fi++-- | 'withItemTitle myTitle' associates a new title, 'myTitle',+-- with a feed item.+withItemTitle :: ItemSetter String+withItemTitle tit fi =+ case fi of+ Feed.Types.AtomItem e ->+ Feed.Types.AtomItem e{Atom.entryTitle=TextString tit}+ Feed.Types.RSSItem i ->+ Feed.Types.RSSItem i{RSS.rssItemTitle=Just tit}+ Feed.Types.RSS1Item i ->+ Feed.Types.RSS1Item i{RSS1.itemTitle=tit}+ Feed.Types.XMLItem i ->+ Feed.Types.XMLItem $+ addChild (unode "title" tit) $+ filterChildren (\ e -> elName e /= unqual "title")+ i++-- | 'withItemAuthor auStr' associates new author info+-- with a feed item.+withItemAuthor :: ItemSetter String+withItemAuthor au fi =+ case fi of+ Feed.Types.AtomItem e ->+ Feed.Types.AtomItem e{Atom.entryAuthors=[nullPerson{personName=au,personURI=Just au}]}+ Feed.Types.RSSItem i ->+ Feed.Types.RSSItem i{RSS.rssItemAuthor=Just au}+ Feed.Types.RSS1Item i ->+ case break isAuthor $ RSS1.itemDC i of+ (as,(dci:bs)) -> Feed.Types.RSS1Item i{RSS1.itemDC=as++dci{dcText=au}:bs}+ (_,[]) -> Feed.Types.RSS1Item i{RSS1.itemDC=DCItem{dcElt=DC_Creator,dcText=au}:RSS1.itemDC i}+ Feed.Types.XMLItem i ->+ Feed.Types.XMLItem $+ addChild (unode "author" au) $+ filterChildren (\ e -> elName e /= unqual "author")+ i+ where+ isAuthor dc = dcElt dc == DC_Creator++-- | 'withItemFeedLink name myFeed' associates the parent feed URL 'myFeed'+-- with a feed item. It is labelled as 'name'.+withItemFeedLink :: String -> ItemSetter String+withItemFeedLink tit url fi =+ case fi of+ Feed.Types.AtomItem e ->+ Feed.Types.AtomItem e{Atom.entrySource=Just Atom.nullSource{sourceId=Just url,sourceTitle=Just (TextString tit)}}+ Feed.Types.RSSItem i ->+ Feed.Types.RSSItem i{RSS.rssItemSource=Just (RSS.nullSource url tit)}+ Feed.Types.RSS1Item i ->+ Feed.Types.RSS1Item i{RSS1.itemTitle=tit}+ Feed.Types.XMLItem i ->+ Feed.Types.XMLItem $+ addChild (unode "source" (Attr (unqual "url") url,tit)) $+ filterChildren (\ e -> elName e /= unqual "source")+ i++++-- | 'withItemCommentLink url' sets the URL reference to the comment page to 'url'.+withItemCommentLink :: ItemSetter String+withItemCommentLink url fi =+ case fi of+ Feed.Types.AtomItem e ->+ Feed.Types.AtomItem e{Atom.entryLinks=((nullLink url){linkRel=Just (Left "replies")}):Atom.entryLinks e}+ Feed.Types.RSSItem i ->+ Feed.Types.RSSItem i{RSS.rssItemComments=Just url}+ Feed.Types.RSS1Item i ->+ case break isRel $ RSS1.itemDC i of+ (as,(dci:bs)) -> Feed.Types.RSS1Item i{RSS1.itemDC=as++dci{dcText=url}:bs}+ (_,[]) -> Feed.Types.RSS1Item i{RSS1.itemDC=DCItem{dcElt=DC_Relation,dcText=url}:RSS1.itemDC i}+ Feed.Types.XMLItem i ->+ Feed.Types.XMLItem $+ addChild (unode "comments" url) $+ filterChildren (\ e -> elName e /= unqual "comments")+ i+ where+ isRel dc = dcElt dc == DC_Relation++-- | 'withItemEnclosure url mbTy len' sets the URL reference to the comment page to 'url'.+withItemEnclosure :: String -> Maybe String -> ItemSetter (Maybe Integer)+withItemEnclosure url ty mb_len fi =+ case fi of+ Feed.Types.AtomItem e -> Feed.Types.AtomItem+ e{Atom.entryLinks=((nullLink url){linkRel=Just (Left "enclosure")+ ,linkType=ty+ ,linkLength=fmap show mb_len+ }):Atom.entryLinks e}+ Feed.Types.RSSItem i ->+ Feed.Types.RSSItem i{RSS.rssItemEnclosure=Just (nullEnclosure url mb_len (fromMaybe "text/html" ty))}+ Feed.Types.RSS1Item i -> Feed.Types.RSS1Item+ i{RSS1.itemContent=nullContentInfo{ contentURI=Just url+ , contentFormat=ty+ }:RSS1.itemContent i}+ Feed.Types.XMLItem i ->+ Feed.Types.XMLItem $+ addChild ((unode "enclosure" url)+ {elAttribs= [ Attr (unqual "length") "0"+ , Attr (unqual "type") (fromMaybe "text/html" ty)+ ]}) $+ filterChildren (\ e -> elName e /= unqual "enclosure")+ i+++-- | 'withItemId isURL id' associates new unique identifier with a feed item.+-- If 'isURL' is 'True', then the id is assumed to point to a valid web resource.+withItemId :: Bool -> ItemSetter String+withItemId isURL idS fi =+ case fi of+ Feed.Types.AtomItem e ->+ Feed.Types.AtomItem e{Atom.entryId=idS}+ Feed.Types.RSSItem i ->+ Feed.Types.RSSItem i{RSS.rssItemGuid=Just (nullGuid idS){rssGuidPermanentURL=Just isURL}}+ Feed.Types.RSS1Item i ->+ case break isId $ RSS1.itemDC i of+ (as,(dci:bs)) -> Feed.Types.RSS1Item i{RSS1.itemDC=as++dci{dcText=idS}:bs}+ (_,[]) -> Feed.Types.RSS1Item i{RSS1.itemDC=DCItem{dcElt=DC_Identifier,dcText=idS}:RSS1.itemDC i}+ Feed.Types.XMLItem i ->+ Feed.Types.XMLItem $+ addChild (unode "guid" (Attr (unqual "isPermaLink") (showBool isURL),idS)) $+ filterChildren (\ e -> elName e /= unqual "guid")+ i+ where+ showBool x = map toLower (show x)+ isId dc = dcElt dc == DC_Identifier++-- | 'withItemDescription desc' associates a new descriptive string (aka summary)+-- with a feed item.+withItemDescription :: ItemSetter String+withItemDescription desc fi =+ case fi of+ Feed.Types.AtomItem e ->+ Feed.Types.AtomItem e{Atom.entrySummary=Just (TextString desc)}+ Feed.Types.RSSItem i ->+ Feed.Types.RSSItem i{RSS.rssItemDescription=Just desc}+ Feed.Types.RSS1Item i ->+ Feed.Types.RSS1Item i{RSS1.itemDesc=Just desc}+ Feed.Types.XMLItem i ->+ Feed.Types.XMLItem $+ addChild (unode "description" desc) $+ filterChildren (\ e -> elName e /= unqual "description")+ i++-- | 'withItemRights rightStr' associates the rights information 'rightStr'+-- with a feed item.+withItemRights :: ItemSetter String+withItemRights desc fi =+ case fi of+ Feed.Types.AtomItem e ->+ Feed.Types.AtomItem e{Atom.entryRights=Just (TextString desc)}+ -- Note: per-item copyright information isn't supported by RSS2.0 (and earlier editions),+ -- you can only attach this at the feed/channel level. So, there's not much we can do+ -- except dropping the information on the floor here. (Rolling our own attribute or+ -- extension element is an option, but would prefer if someone else had started that+ -- effort already.+ Feed.Types.RSSItem{} -> fi+ Feed.Types.RSS1Item i ->+ case break ((==DC_Rights).dcElt) $ RSS1.itemDC i of+ (as,(dci:bs)) -> Feed.Types.RSS1Item i{RSS1.itemDC=as++dci{dcText=desc}:bs}+ (_,[]) -> Feed.Types.RSS1Item i{RSS1.itemDC=DCItem{dcElt=DC_Rights,dcText=desc}:RSS1.itemDC i}+ -- Since we're so far assuming that a shallow XML rep. of an item+ -- is of RSS2.0 ilk, pinning on the rights info is hard (see above.)+ Feed.Types.XMLItem{} -> fi++-- | 'withItemTitle myLink' associates a new URL, 'myLink',+-- with a feed item.+withItemLink :: ItemSetter URLString+withItemLink url fi =+ case fi of+ Feed.Types.AtomItem e ->+ Feed.Types.AtomItem e{Atom.entryLinks=replaceAlternate url (Atom.entryLinks e)}+ Feed.Types.RSSItem i ->+ Feed.Types.RSSItem i{RSS.rssItemLink=Just url}+ Feed.Types.RSS1Item i ->+ Feed.Types.RSS1Item i{RSS1.itemLink=url}+ Feed.Types.XMLItem i ->+ Feed.Types.XMLItem $+ addChild (unode "link" url) $+ filterChildren (\ e -> elName e /= unqual "link")+ i+ where+ replaceAlternate _ [] = []+ replaceAlternate x (lr:xs)+ | toStr (Atom.linkRel lr) == "alternate" = lr{Atom.linkHref=x} : xs+ | otherwise = lr : replaceAlternate x xs++ toStr Nothing = ""+ toStr (Just (Left x)) = x+ toStr (Just (Right x)) = x++withItemCategories :: ItemSetter [(String,Maybe String)]+withItemCategories cats fi =+ case fi of+ Feed.Types.AtomItem e -> Feed.Types.AtomItem+ e{ Atom.entryCategories =+ map ( \ (t,mb) -> (Atom.newCategory t){Atom.catScheme=mb})+ cats ++ entryCategories e}+ Feed.Types.RSSItem i -> Feed.Types.RSSItem+ i{RSS.rssItemCategories=+ map (\ (t,mb) -> (RSS.newCategory t){RSS.rssCategoryDomain=mb})+ cats ++ rssItemCategories i}+ Feed.Types.RSS1Item i -> Feed.Types.RSS1Item+ i{RSS1.itemDC=+ map (\ (t,_) -> DCItem{dcElt=DC_Subject,dcText=t})+ cats ++ RSS1.itemDC i}+ Feed.Types.XMLItem i -> Feed.Types.XMLItem $+ foldr (\ (t,mb) acc ->+ addChild (unode "category"+ (fromMaybe (\x -> [x])+ (fmap (\v -> (\ x -> [Attr (unqual "domain") v,x])) mb) $+ (Attr (unqual "term") t))+ ) acc)+ i+ cats++-- helpers..++filterChildren :: (XML.Element -> Bool) -> XML.Element -> XML.Element+filterChildren pre e =+ case elContent e of+ [] -> e+ cs -> e { elContent = mapMaybe filterElt cs }+ where+ filterElt xe@(XML.Elem el)+ | pre el = Just xe+ | otherwise = Nothing+ filterElt xe = Just xe++addChild :: XML.Element -> XML.Element -> XML.Element+addChild a b = b { elContent = XML.Elem a : elContent b }++mapMaybeChildren :: (XML.Element -> Maybe XML.Element)+ -> XML.Element+ -> XML.Element+mapMaybeChildren f e =+ case elContent e of+ [] -> e+ cs -> e { elContent = map procElt cs }+ where+ procElt xe@(XML.Elem el) =+ case f el of+ Nothing -> xe+ Just el1 -> XML.Elem el1+ procElt xe = xe
+ src/Text/Feed/Export.hs view
@@ -0,0 +1,36 @@+--------------------------------------------------------------------+-- |+-- Module : Text.Feed.Export+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+--+-- Convert from Feeds to XML.+--+--------------------------------------------------------------------+++module Text.Feed.Export+ ( Text.Feed.Export.xmlFeed -- :: Feed -> XML.Element+ ) where++import Text.Feed.Types++import Text.Atom.Feed.Export as Atom+import Text.RSS.Export as RSS+import Text.RSS1.Export as RSS1++import Text.XML.Light as XML++-- | 'xmlFeed f' serializes a @Feed@ document into a conforming+-- XML toplevel element.+xmlFeed :: Feed -> XML.Element+xmlFeed fe =+ case fe of+ AtomFeed f -> Atom.xmlFeed f+ RSSFeed f -> RSS.xmlRSS f+ RSS1Feed f -> RSS1.xmlFeed f+ XMLFeed e -> e -- that was easy!
+ src/Text/Feed/Import.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE CPP #-}+--------------------------------------------------------------------+-- |+-- Module : Text.Feed.Import+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+--+-- Convert from XML to Feeds.+--+--------------------------------------------------------------------++module Text.Feed.Import+ ( parseFeedFromFile -- :: FilePath -> IO Feed+ , parseFeedString -- :: String -> IO Feed++ -- if you know your format, use these directly:+ , readRSS2 -- :: XML.Element -> Maybe Feed+ , readRSS1 -- :: XML.Element -> Maybe Feed+ , readAtom -- :: XML.Element -> Maybe Feed+ ) where++import Text.Atom.Feed.Import as Atom+import Text.RSS.Import as RSS+import Text.RSS1.Import as RSS1++import Text.Feed.Types+import Text.XML.Light as XML+import Text.XML.Light.Lexer ( XmlSource )++import Control.Monad++#if MIN_VERSION_utf8_string(1,0,0)+import Codec.Binary.UTF8.String (decodeString)+import System.IO (IOMode(..), hGetContents, openBinaryFile )+utf8readFile :: FilePath -> IO String+utf8readFile fp = fmap decodeString (hGetContents =<< openBinaryFile fp ReadMode)+#else+import System.IO.UTF8 as UTF8 ( readFile )+utf8readFile :: FilePath -> IO String+utf8readFile = UTF8.readFile+#endif++++-- | 'parseFeedFromFile fp' reads in the contents of the file at @fp@;+-- the assumed encoding is UTF-8.+parseFeedFromFile :: FilePath -> IO Feed+parseFeedFromFile fp = do+ ls <- utf8readFile fp+ case parseFeedString ls of+ Nothing -> fail ("parseFeedFromFile: not a well-formed XML content in: " ++ fp)+ Just f -> return f++-- | 'parseFeedWithParser tries to parse the string @str@+-- as one of the feed formats. First as Atom, then RSS2 before+-- giving RSS1 a try. @Nothing@ is, rather unhelpfully, returned+-- as an indication of error.+parseFeedWithParser :: XmlSource s => (s -> Maybe Element) -> s -> Maybe Feed+parseFeedWithParser parser str =+ case parser str of+ Nothing -> Nothing+ Just e ->+ readAtom e `mplus`+ readRSS2 e `mplus`+ readRSS1 e `mplus`+ Just (XMLFeed e)+++-- | 'parseFeedString str' tries to parse the string @str@ as+-- one of the feed formats. First as Atom, then RSS2 before+-- giving RSS1 a try. @Nothing@ is, rather unhelpfully, returned+-- as an indication of error.+parseFeedString :: String -> Maybe Feed+parseFeedString = parseFeedWithParser parseXMLDoc++-- | 'readRSS2 elt' tries to derive an RSS2.x, RSS-0.9x feed document+-- from the XML element @e@.+readRSS2 :: XML.Element -> Maybe Feed+readRSS2 e = fmap RSSFeed $ RSS.elementToRSS e++-- | 'readRSS1 elt' tries to derive an RSS1.0 feed document+-- from the XML element @e@.+readRSS1 :: XML.Element -> Maybe Feed+readRSS1 e = fmap RSS1Feed $ RSS1.elementToFeed e++-- | 'readAtom elt' tries to derive an Atom feed document+-- from the XML element @e@.+readAtom :: XML.Element -> Maybe Feed+readAtom e = fmap AtomFeed $ Atom.elementFeed e+
+ src/Text/Feed/Query.hs view
@@ -0,0 +1,427 @@+--------------------------------------------------------------------+-- |+-- Module : Text.Feed.Query+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+--------------------------------------------------------------------+++module Text.Feed.Query+ ( Text.Feed.Query.feedItems -- :: Feed.Feed -> [Feed.Item]++ , FeedGetter -- type _ a = Feed -> a+ , getFeedTitle -- :: FeedGetter String+ , getFeedAuthor -- :: FeedGetter String+ , getFeedHome -- :: FeedGetter URLString+ , getFeedHTML -- :: FeedGetter URLString+ , getFeedDescription -- :: FeedGetter String+ , getFeedPubDate -- :: FeedGetter DateString+ , getFeedLastUpdate -- :: FeedGetter (Maybe String)+ , getFeedDate -- :: FeedGetter DateString+ , getFeedLogoLink -- :: FeedGetter URLString+ , getFeedLanguage -- :: FeedGetter String+ , getFeedCategories -- :: FeedGetter [(String, Maybe String)]+ , getFeedGenerator -- :: FeedGetter String+ , getFeedItems -- :: FeedGetter [Item]++ , ItemGetter -- type _ a = Item -> Maybe a+ , getItemTitle -- :: ItemGetter (String)+ , getItemLink -- :: ItemGetter (String)+ , getItemPublishDate -- :: Data.Time.ParseTime t => ItemGetter (Maybe t)+ , getItemPublishDateString -- :: ItemGetter (DateString)+ , getItemDate -- :: ItemGetter (DateString)+ , getItemAuthor -- :: ItemGetter (String)+ , getItemCommentLink -- :: ItemGetter (URLString)+ , getItemEnclosure -- :: ItemGetter (String,Maybe String,Integer)+ , getItemFeedLink -- :: ItemGetter (URLString)+ , getItemId -- :: ItemGetter (Bool,String)+ , getItemCategories -- :: ItemGetter [String]+ , getItemRights -- :: ItemGetter String+ , getItemSummary -- :: ItemGetter String+ , getItemDescription -- :: ItemGetter String (synonym of previous.)++ ) where++import Text.Feed.Types as Feed++import Text.RSS.Syntax as RSS+import Text.Atom.Feed as Atom+import Text.RSS1.Syntax as RSS1+import Text.XML.Light as XML++import Text.DublinCore.Types++import Control.Monad ( mplus )+import Data.List+import Data.Maybe++-- for getItemPublishDate rfc822 date parsing.+import System.Locale ( rfc822DateFormat, iso8601DateFormat )+import Data.Time.Locale.Compat ( defaultTimeLocale )+import Data.Time.Format ( ParseTime, parseTime )++feedItems :: Feed.Feed -> [Feed.Item]+feedItems fe =+ case fe of+ AtomFeed f -> map Feed.AtomItem (Atom.feedEntries f)+ RSSFeed f -> map Feed.RSSItem (RSS.rssItems $ RSS.rssChannel f)+ RSS1Feed f -> map Feed.RSS1Item (RSS1.feedItems f)+ -- ToDo: look for 'entry' elements if 'items' are missing..+ XMLFeed f -> map Feed.XMLItem $ XML.findElements (XML.unqual "item") f+++getFeedItems :: Feed.Feed -> [Feed.Item]+getFeedItems = Text.Feed.Query.feedItems++type FeedGetter a = Feed.Feed -> Maybe a++getFeedAuthor :: FeedGetter String+getFeedAuthor ft =+ case ft of+ Feed.AtomFeed f -> fmap Atom.personName $ listToMaybe $ Atom.feedAuthors f+ Feed.RSSFeed f -> RSS.rssEditor (RSS.rssChannel f)+ Feed.RSS1Feed f -> fmap dcText $ listToMaybe $ filter isAuthor $ RSS1.channelDC (RSS1.feedChannel f)+ Feed.XMLFeed f ->+ case findElement (unqual "channel") f of+ Just e1 -> fmap XML.strContent $ findElement (unqual "editor") e1+ Nothing -> Nothing+ where+ isAuthor dc = dcElt dc == DC_Creator++getFeedTitle :: Feed.Feed -> String+getFeedTitle ft =+ case ft of+ Feed.AtomFeed f -> contentToStr $ Atom.feedTitle f+ Feed.RSSFeed f -> RSS.rssTitle (RSS.rssChannel f)+ Feed.RSS1Feed f -> RSS1.channelTitle (RSS1.feedChannel f)+ Feed.XMLFeed f ->+ case findElement (unqual "channel") f of+ Just e1 -> fromMaybe "" (fmap XML.strContent $ findElement (unqual "title") e1)+ Nothing -> ""++getFeedHome :: FeedGetter URLString+getFeedHome ft =+ case ft of+ Feed.AtomFeed f -> fmap Atom.linkHref $ listToMaybe $ filter isSelf (Atom.feedLinks f)+ Feed.RSSFeed f -> Just (RSS.rssLink (RSS.rssChannel f))+ Feed.RSS1Feed f -> Just (RSS1.channelURI (RSS1.feedChannel f))+ Feed.XMLFeed f ->+ case findElement (unqual "channel") f of+ Just e1 -> fmap XML.strContent $ findElement (unqual "link") e1+ Nothing -> Nothing+ where+ isSelf lr = toStr (Atom.linkRel lr) == "self"++getFeedHTML :: FeedGetter URLString+getFeedHTML ft =+ case ft of+ Feed.AtomFeed f -> fmap Atom.linkHref $ listToMaybe $ filter isSelf (Atom.feedLinks f)+ Feed.RSSFeed f -> Just (RSS.rssLink (RSS.rssChannel f))+ Feed.RSS1Feed f -> Just (RSS1.channelURI (RSS1.feedChannel f))+ Feed.XMLFeed f ->+ case findElement (unqual "channel") f of+ Just e1 -> fmap XML.strContent $ findElement (unqual "link") e1+ Nothing -> Nothing+ where+ isSelf lr = toStr (Atom.linkRel lr) == "alternate" && isHTMLType (linkType lr)++ isHTMLType (Just str) = "lmth" `isPrefixOf` (reverse str)+ isHTMLType _ = True -- if none given, assume html.++getFeedDescription :: FeedGetter String+getFeedDescription ft =+ case ft of+ Feed.AtomFeed f -> fmap contentToStr (Atom.feedSubtitle f)+ Feed.RSSFeed f -> Just $ RSS.rssDescription (RSS.rssChannel f)+ Feed.RSS1Feed f -> Just (RSS1.channelDesc (RSS1.feedChannel f))+ Feed.XMLFeed f ->+ case findElement (unqual "channel") f of+ Just e1 -> fmap XML.strContent $ findElement (unqual "description") e1+ Nothing -> Nothing++getFeedPubDate :: FeedGetter DateString+getFeedPubDate ft =+ case ft of+ Feed.AtomFeed f -> Just $ Atom.feedUpdated f+ Feed.RSSFeed f -> RSS.rssPubDate (RSS.rssChannel f)+ Feed.RSS1Feed f -> fmap dcText $ listToMaybe $ filter isDate (RSS1.channelDC $ RSS1.feedChannel f)+ Feed.XMLFeed f ->+ case findElement (unqual "channel") f of+ Just e1 -> fmap XML.strContent $ findElement (unqual "pubDate") e1+ Nothing -> Nothing+ where+ isDate dc = dcElt dc == DC_Date++getFeedLastUpdate :: FeedGetter (String)+getFeedLastUpdate ft =+ case ft of+ Feed.AtomFeed f -> Just $ Atom.feedUpdated f+ Feed.RSSFeed f -> RSS.rssPubDate (RSS.rssChannel f)+ Feed.RSS1Feed f -> fmap dcText $ listToMaybe $ filter isDate (RSS1.channelDC $ RSS1.feedChannel f)+ Feed.XMLFeed f ->+ case findElement (unqual "channel") f of+ Just e1 -> fmap XML.strContent $ findElement (unqual "pubDate") e1+ Nothing -> Nothing+ where+ isDate dc = dcElt dc == DC_Date++getFeedDate :: FeedGetter DateString+getFeedDate ft = getFeedPubDate ft++getFeedLogoLink :: FeedGetter URLString+getFeedLogoLink ft =+ case ft of+ Feed.AtomFeed f -> Atom.feedLogo f+ Feed.RSSFeed f -> fmap RSS.rssImageURL (RSS.rssImage $ RSS.rssChannel f)+ Feed.RSS1Feed f -> (fmap RSS1.imageURI $ RSS1.feedImage f)+ Feed.XMLFeed f -> do+ ch <- findElement (unqual "channel") f+ e1 <- findElement (unqual "image") ch+ v <- findElement (unqual "url") e1+ return (XML.strContent v)++getFeedLanguage :: FeedGetter String+getFeedLanguage ft =+ case ft of+ Feed.AtomFeed f ->+ lookupAttr (unqual "lang"){qPrefix=Just "xml"} (Atom.feedAttrs f)+ Feed.RSSFeed f -> RSS.rssLanguage (RSS.rssChannel f)+ Feed.RSS1Feed f -> fmap dcText $ listToMaybe $ filter isLang (RSS1.channelDC $ RSS1.feedChannel f)+ Feed.XMLFeed f -> do+ ch <- findElement (unqual "channel") f+ e1 <- findElement (unqual "language") ch+ return (XML.strContent e1)+ where+ isLang dc = dcElt dc == DC_Language+++getFeedCategories :: Feed.Feed -> [(String, Maybe String)]+getFeedCategories ft =+ case ft of+ Feed.AtomFeed f -> map (\ c -> (Atom.catTerm c, Atom.catScheme c)) (Atom.feedCategories f)+ Feed.RSSFeed f -> map (\ c -> (RSS.rssCategoryValue c, RSS.rssCategoryDomain c)) (RSS.rssCategories (RSS.rssChannel f))+ Feed.RSS1Feed f ->+ case filter isCat (RSS1.channelDC $ RSS1.feedChannel f) of+ ls -> map (\ l -> (dcText l,Nothing)) ls+ Feed.XMLFeed f ->+ case fromMaybe [] $ fmap (XML.findElements (XML.unqual "category")) (findElement (unqual "channel") f) of+ ls -> map (\ l -> (fromMaybe "" (fmap XML.strContent $ findElement (unqual "term") l), findAttr (unqual "domain") l)) ls+ where+ isCat dc = dcElt dc == DC_Subject++getFeedGenerator :: FeedGetter String+getFeedGenerator ft =+ case ft of+ Feed.AtomFeed f -> do+ gen <- Atom.feedGenerator f+ Atom.genURI gen+ Feed.RSSFeed f -> RSS.rssGenerator (RSS.rssChannel f)+ Feed.RSS1Feed f -> fmap dcText $ listToMaybe $ filter isSource (RSS1.channelDC (RSS1.feedChannel f))+ Feed.XMLFeed f -> do+ ch <- findElement (unqual "channel") f+ e1 <- findElement (unqual "generator") ch+ return (XML.strContent e1)+ where+ isSource dc = dcElt dc == DC_Source++type ItemGetter a = Feed.Item -> Maybe a++getItemTitle :: ItemGetter String+getItemTitle it =+ case it of+ Feed.AtomItem i -> Just (contentToStr $ Atom.entryTitle i)+ Feed.RSSItem i -> RSS.rssItemTitle i+ Feed.RSS1Item i -> Just (RSS1.itemTitle i)+ Feed.XMLItem e -> fmap XML.strContent $ findElement (unqual "title") e++getItemLink :: ItemGetter String+getItemLink it =+ case it of+ -- look up the 'alternate' HTML link relation on the entry:+ Feed.AtomItem i -> fmap Atom.linkHref $ listToMaybe $ filter isSelf $ Atom.entryLinks i+ Feed.RSSItem i -> RSS.rssItemLink i+ Feed.RSS1Item i -> Just (RSS1.itemLink i)+ Feed.XMLItem i -> fmap (\ ei -> XML.strContent ei) $ findElement (unqual "link") i+ where+ isSelf lr = toStr (Atom.linkRel lr) == "alternate" && isHTMLType (linkType lr)++ isHTMLType (Just str) = "lmth" `isPrefixOf` (reverse str)+ isHTMLType _ = True -- if none given, assume html.+++-- | 'getItemPublishDate item' returns the publication date of the item,+-- but first parsed per the supported RFC 822 and RFC 3339 formats.+--+-- If the date string cannot be parsed as such, Just Nothing is+-- returned. The caller must then instead fall back to processing the+-- date string from 'getItemPublishDateString'.+--+-- The parsed date representation is one of the ParseTime instances;+-- see 'Data.Time.Format'.+getItemPublishDate :: ParseTime t => ItemGetter (Maybe t)+getItemPublishDate it = do+ ds <- getItemPublishDateString it+ let+ rfc3339DateFormat1 = iso8601DateFormat (Just "%H:%M:%S%Z")+ rfc3339DateFormat2 = iso8601DateFormat (Just "%H:%M:%S%Q%Z")++ formats = [ rfc3339DateFormat1, rfc3339DateFormat2, rfc822DateFormat ]++ date = foldl1 mplus (map (\ fmt -> parseTime defaultTimeLocale fmt ds) formats)+ return date++getItemPublishDateString :: ItemGetter DateString+getItemPublishDateString it =+ case it of+ Feed.AtomItem i -> Just $ Atom.entryUpdated i+ Feed.RSSItem i -> RSS.rssItemPubDate i+ Feed.RSS1Item i -> fmap dcText $ listToMaybe $ filter isDate $ RSS1.itemDC i+ -- ToDo: look for it in Atom \/ RSS1 like-content as well if no 'pubDate' element.+ Feed.XMLItem e -> fmap XML.strContent $ findElement (unqual "pubDate") e+ where+ isDate dc = dcElt dc == DC_Date++getItemDate :: ItemGetter DateString+getItemDate it = getItemPublishDateString it++-- | 'getItemAuthor f' returns the optional author of the item.+getItemAuthor :: ItemGetter String+getItemAuthor it =+ case it of+ Feed.AtomItem i -> fmap Atom.personName $ listToMaybe $ Atom.entryAuthors i+ Feed.RSSItem i -> RSS.rssItemAuthor i+ Feed.RSS1Item i -> fmap dcText $ listToMaybe $ filter isAuthor $ RSS1.itemDC i+ Feed.XMLItem e -> fmap XML.strContent $ findElement (unqual "author") e+ where+ isAuthor dc = dcElt dc == DC_Creator++getItemCommentLink :: ItemGetter URLString+getItemCommentLink it =+ case it of+ -- look up the 'replies' HTML link relation on the entry:+ Feed.AtomItem e -> fmap Atom.linkHref $ listToMaybe $ filter isReplies $ Atom.entryLinks e+ Feed.RSSItem i -> RSS.rssItemComments i+ Feed.RSS1Item i -> fmap dcText $ listToMaybe $ filter isRel $ RSS1.itemDC i+ Feed.XMLItem i -> fmap (\ ei -> XML.strContent ei) $ findElement (unqual "comments") i+ where+ isReplies lr = toStr (Atom.linkRel lr) == "replies"+ isRel dc = dcElt dc == DC_Relation++getItemEnclosure :: ItemGetter (String, Maybe String, Maybe Integer)+getItemEnclosure it =+ case it of+ Feed.AtomItem e ->+ case filter isEnc $ Atom.entryLinks e of+ (l:_) -> Just (Atom.linkHref l,+ Atom.linkType l,+ readLength (Atom.linkLength l))+ _ -> Nothing+ Feed.RSSItem i ->+ fmap (\ e -> (RSS.rssEnclosureURL e, Just (RSS.rssEnclosureType e), RSS.rssEnclosureLength e))+ (RSS.rssItemEnclosure i)+ Feed.RSS1Item i ->+ case RSS1.itemContent i of+ [] -> Nothing+ (c:_) -> Just (fromMaybe "" (RSS1.contentURI c), RSS1.contentFormat c, Nothing)+ Feed.XMLItem e -> fmap xmlToEnclosure (findElement (unqual "enclosure") e)+ where+ isEnc lr = toStr (Atom.linkRel lr) == "enclosure"++ readLength Nothing = Nothing+ readLength (Just str) =+ case reads str of+ [] -> Nothing+ ((v,_):_) -> Just v++ xmlToEnclosure e =+ ( fromMaybe "" (findAttr (unqual "url") e)+ , findAttr (unqual "type") e+ , readLength $ findAttr (unqual "length") e+ )++getItemFeedLink :: ItemGetter URLString+getItemFeedLink it =+ case it of+ Feed.AtomItem e ->+ case (Atom.entrySource e) of+ Nothing -> Nothing+ Just s -> Atom.sourceId s+ Feed.RSSItem i ->+ case (RSS.rssItemSource i) of+ Nothing -> Nothing+ Just s -> Just (RSS.rssSourceURL s)+ Feed.RSS1Item _ -> Nothing+ Feed.XMLItem e ->+ case findElement (unqual "source") e of+ Nothing -> Nothing+ Just s -> fmap XML.strContent (findElement (unqual "url") s)++getItemId :: ItemGetter (Bool,String)+getItemId it =+ case it of+ Feed.AtomItem e -> Just (True, Atom.entryId e)+ Feed.RSSItem i ->+ case RSS.rssItemGuid i of+ Nothing -> Nothing+ Just ig -> Just (fromMaybe True (RSS.rssGuidPermanentURL ig), RSS.rssGuidValue ig)+ Feed.RSS1Item i ->+ case filter isId (RSS1.itemDC i) of+ (l:_) -> Just (True,dcText l)+ _ -> Nothing+ Feed.XMLItem e ->+ fmap (\ e1 -> (True,XML.strContent e1)) (findElement (unqual "guid") e)+ where+ isId dc = dcElt dc == DC_Identifier++getItemCategories :: Feed.Item -> [String]+getItemCategories it =+ case it of+ Feed.AtomItem i -> map Atom.catTerm $ Atom.entryCategories i+ Feed.RSSItem i -> map RSS.rssCategoryValue $ RSS.rssItemCategories i+ Feed.RSS1Item i -> concat $ getCats1 i+ Feed.XMLItem i -> map XML.strContent $ XML.findElements (XML.unqual "category") i+ where+ -- get RSS1 categories; either via DublinCore's subject (or taxonomy topics...not yet.)+ getCats1 i1 =+ map (words.dcText) $ filter (\ dc -> dcElt dc == DC_Subject) $ RSS1.itemDC i1+++getItemRights :: ItemGetter String+getItemRights it =+ case it of+ Feed.AtomItem e -> fmap contentToStr $ Atom.entryRights e+ Feed.RSSItem _ -> Nothing+ Feed.RSS1Item i -> fmap dcText $ listToMaybe $ filter isRights (RSS1.itemDC i)+ Feed.XMLItem _ -> Nothing+ where+ isRights dc = dcElt dc == DC_Rights++getItemSummary :: ItemGetter String+getItemSummary it = getItemDescription it++getItemDescription :: ItemGetter String+getItemDescription it =+ case it of+ Feed.AtomItem e -> fmap contentToStr $ Atom.entrySummary e+ Feed.RSSItem e -> RSS.rssItemDescription e+ Feed.RSS1Item i -> itemDesc i+ Feed.XMLItem _ -> Nothing++ -- strip away+toStr :: Maybe (Either String String) -> String+toStr Nothing = ""+toStr (Just (Left x)) = x+toStr (Just (Right x)) = x++contentToStr :: TextContent -> String+contentToStr x =+ case x of+ Atom.TextString s -> s+ Atom.HTMLString s -> s+ Atom.XHTMLString s -> XML.strContent s
+ src/Text/Feed/Translate.hs view
@@ -0,0 +1,134 @@+--------------------------------------------------------------------+-- |+-- Module : Text.Feed.Translate+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+-- Translating between RSS formats; work in progress.+--+module Text.Feed.Translate+ ( translateItemTo -- :: FeedKind -> Item -> Item+ , withAtomEntry -- :: (Atom.Entry -> Atom.Entry) -> Item -> Item+ , withRSSItem -- :: (RSS.RSSItem -> RSS.RSSItem) -> Item -> Item+ , withRSS1Item -- :: (RSS1.Item -> RSS1.Item) -> Item -> Item+ ) where++import Text.Feed.Types as Feed+import Text.Feed.Constructor++import Text.RSS.Syntax as RSS+import qualified Text.RSS1.Syntax as RSS1+import Text.Atom.Feed as Atom++import Data.Maybe ( fromMaybe )++-- functions for performing format-specific transformations.+-- If the item isn't in the of-interest format, no transformation+-- is performed (i.e., no on-the-fly translation into the requested+-- format is performed; the caller is responsible+--++withAtomEntry :: (Atom.Entry -> Atom.Entry) -> Item -> Item+withAtomEntry f it =+ case it of+ Feed.AtomItem e -> Feed.AtomItem (f e)+ _ -> it++withRSSItem :: (RSS.RSSItem -> RSS.RSSItem) -> Item -> Item+withRSSItem f it =+ case it of+ Feed.RSSItem e -> Feed.RSSItem (f e)+ _ -> it++withRSS1Item :: (RSS1.Item -> RSS1.Item) -> Item -> Item+withRSS1Item f it =+ case it of+ Feed.RSS1Item e -> Feed.RSS1Item (f e)+ _ -> it++translateItemTo :: FeedKind -> Item -> Item+translateItemTo fk it =+ case fk of+ AtomKind -> toAtomItem it+ RSSKind v -> toRSSItem v it+ RDFKind v -> toRDFItem v it++toRSSItem :: Maybe String -> Item -> Item+toRSSItem = error "toRSSItem: unimplemented"++toRDFItem :: Maybe String -> Item -> Item+toRDFItem = error "toRDFItem: unimplemented"++toAtomItem :: Item -> Item+toAtomItem it =+ case it of+ AtomItem{} -> it+ RSS1Item{} -> error "toAtomItem: unimplemented (from RSS1 item rep.)"+ XMLItem{} -> error "toAtomItem: unimplemented (from shallow XML rep.)"+ Feed.RSSItem ri -> foldl (\ oi f -> f oi) outIt pipeline_rss_atom+ where+ outIt =+ (flip withAtomEntry) (newItem AtomKind)+ (\ e -> e{ Atom.entryOther = RSS.rssItemOther ri+ , Atom.entryAttrs = RSS.rssItemAttrs ri+ })++ pipeline_rss_atom =+ [ mb withItemTitle (rssItemTitle ri)+ , mb withItemLink (rssItemLink ri)+ , mb withItemDescription (rssItemDescription ri)+ , mb withItemAuthor (rssItemAuthor ri)+ , ls withItemCategories (rssItemCategories ri)+ , mb withItemId' (rssItemGuid ri)+ , mb withItemCommentLink (rssItemComments ri)+ , mb withItemEnclosure' (rssItemEnclosure ri)+ , mb withItemPubDate (rssItemPubDate ri)+ ]++ withItemEnclosure' e =+ withItemEnclosure (rssEnclosureURL e)+ (Just $ rssEnclosureType e)+ (rssEnclosureLength e)+ withItemId' g = withItemId (fromMaybe True (rssGuidPermanentURL g)) (rssGuidValue g)++ mb _ Nothing = id+ mb f (Just v) = f v++ ls _ [] = id+ -- hack, only used for cats, so specialize:+ ls f xs = f (map (\ c -> (rssCategoryValue c, rssCategoryDomain c)) xs)++{-+ pipeline_rss_atom =+ [ withItemTitle (rssItemTitle ri)+ , withItemLink (rssLink ri)+ , withDescription (rssDescription ri)+ , \ inp -> mb (\ la -> inp{feedLanguage=...}) (rssLanguage ri)+ , \ inp -> mb (\ ed -> inp{feedAuthors=[nullPerson{personName=ed}]})+ (rssEditor ri)+ , \ inp -> mb (\ ed -> inp{feedAuthors=[nullPerson{personName=ed}]})+ (rssWebMaster ri)+ , \ inp -> mb (\ pu -> withPubDate)+ (rssPubDate ri)+ , \ inp -> mb withLastUpdate+ (rssLastUpdate ri)+ , \ inp -> withCategories (map (\c -> (RSS.rssCategoryValue c, RSS.rssCategoryDomain c))+ (rssCategories ri)) inp+ , \ inp -> mb withGenerator+ (rssGenerator ri)+ , rssDocs+ , rssCloud+ , rssTTL+ , rssImage+ , rssRating+ , rssTextInput+ , rssSkipHours+ , rssSkipDays+ }+ in+-}
+ src/Text/Feed/Types.hs view
@@ -0,0 +1,49 @@+--------------------------------------------------------------------+-- |+-- Module : Text.Feed.Types+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+--------------------------------------------------------------------++module Text.Feed.Types where++import Text.RSS.Syntax as RSS+import Text.Atom.Feed as Atom+import Text.RSS1.Syntax as RSS1+import Text.XML.Light as XML++-- | The abstract type of feed documents. The internal representation+-- is as whatever feed variant type the document was either imported or+-- has now been translated to.+data Feed+ = AtomFeed Atom.Feed+ | RSSFeed RSS.RSS+ | RSS1Feed RSS1.Feed+ -- if we're unable to correctly the well-formed XML as a feed,+ -- keep it as an untyped document.+ | XMLFeed XML.Element+ deriving (Show)++-- | The abstract type of feed items. Like the 'Text.Feed.Types.Feed' type, the+-- representation of a value is as one of the different RSS item\/entry+-- variants.+data Item+ = AtomItem Atom.Entry+ | RSSItem RSS.RSSItem+ | RSS1Item RSS1.Item+ | XMLItem XML.Element+ deriving (Show)++-- | The kinds of feed documents supported.+data FeedKind+ = AtomKind+ | RSSKind (Maybe String) -- Nothing => default version (2.0)+ | RDFKind (Maybe String) -- Nothing => default version (1.0)+ deriving (Eq, Show)+
+ src/Text/Feed/Util.hs view
@@ -0,0 +1,26 @@+--------------------------------------------------------------------+-- |+-- Module : Text.Feed.Util+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+--------------------------------------------------------------------+module Text.Feed.Util where++import Text.Feed.Types+import System.Time+import System.Locale++-- | 'toFeedDate' translates a calendar time into+-- the format expected by the feed kind.+toFeedDateString :: FeedKind -> ClockTime -> {-Date-}String+toFeedDateString fk ct =+ case fk of+ AtomKind{} -> formatCalendarTime defaultTimeLocale "%Y-%m-%dT%H:%M:%sZ" (toUTCTime ct)+ RSSKind{} -> formatCalendarTime defaultTimeLocale "%a, %d %b %Y %H:%m:%s GMT" (toUTCTime ct)+ RDFKind{} -> formatCalendarTime defaultTimeLocale "%Y-%m-%dT%H:%M:%sZ" (toUTCTime ct)
+ src/Text/RSS/Export.hs view
@@ -0,0 +1,173 @@+--------------------------------------------------------------------+-- |+-- Module : Text.RSS.Export+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Description: Convert from RSS to XML+--+--------------------------------------------------------------------+++module Text.RSS.Export where++import Text.XML.Light as XML+import Text.RSS.Syntax++import Data.Maybe++qualNode :: String -> [XML.Content] -> XML.Element+qualNode n cs =+ blank_element+ { elName = qualName n+ , elContent = cs+ }++qualName :: String -> QName+qualName n = QName{qName=n,qURI=Nothing,qPrefix=Nothing}++---+xmlRSS :: RSS -> XML.Element+xmlRSS r =+ (qualNode "rss" $ map Elem $+ ( [ xmlChannel (rssChannel r) ]+ ++ rssOther r))+ { elAttribs = (Attr (qualName "version") (rssVersion r)):rssAttrs r }++xmlChannel :: RSSChannel -> XML.Element+xmlChannel ch =+ (qualNode "channel" $ map Elem $+ ( [ xmlLeaf "title" (rssTitle ch)+ , xmlLeaf "link" (rssLink ch)+ , xmlLeaf "description" (rssDescription ch)+ ]+ ++ map xmlItem (rssItems ch)+ ++ mb (xmlLeaf "language") (rssLanguage ch)+ ++ mb (xmlLeaf "copyright") (rssCopyright ch)+ ++ mb (xmlLeaf "managingEditor") (rssEditor ch)+ ++ mb (xmlLeaf "webMaster") (rssWebMaster ch)+ ++ mb (xmlLeaf "pubDate") (rssPubDate ch)+ ++ mb (xmlLeaf "lastBuildDate") (rssLastUpdate ch)+ ++ map xmlCategory (rssCategories ch)+ ++ mb (xmlLeaf "generator") (rssGenerator ch)+ ++ mb (xmlLeaf "docs") (rssDocs ch)+ ++ mb xmlCloud (rssCloud ch)+ ++ mb ((xmlLeaf "ttl") . show) (rssTTL ch)+ ++ mb xmlImage (rssImage ch)+ ++ mb (xmlLeaf "rating") (rssRating ch)+ ++ mb xmlTextInput (rssTextInput ch)+ ++ mb xmlSkipHours (rssSkipHours ch)+ ++ mb xmlSkipDays (rssSkipDays ch)+ ++ rssChannelOther ch))++xmlItem :: RSSItem -> XML.Element+xmlItem it =+ (qualNode "item" $ map Elem $+ ( mb (xmlLeaf "title") (rssItemTitle it)+ ++ mb (xmlLeaf "link") (rssItemLink it)+ ++ mb (xmlLeaf "description") (rssItemDescription it)+ ++ mb (xmlLeaf "author") (rssItemAuthor it)+ ++ map xmlCategory (rssItemCategories it)+ ++ mb (xmlLeaf "comments") (rssItemComments it)+ ++ mb xmlEnclosure (rssItemEnclosure it)+ ++ mb xmlGuid (rssItemGuid it)+ ++ mb (xmlLeaf "pubDate") (rssItemPubDate it)+ ++ mb xmlSource (rssItemSource it)+ ++ rssItemOther it))+ { elAttribs = rssItemAttrs it }++xmlSource :: RSSSource -> XML.Element+xmlSource s =+ (xmlLeaf "source" (rssSourceTitle s))+ { elAttribs = (Attr (qualName "url") (rssSourceURL s)) :+ rssSourceAttrs s }++xmlEnclosure :: RSSEnclosure -> XML.Element+xmlEnclosure e =+ (xmlLeaf "enclosure" "")+ { elAttribs =+ (Attr (qualName "url") (rssEnclosureURL e)) :+ (Attr (qualName "length") (show $ rssEnclosureLength e)) :+ (Attr (qualName "type") (rssEnclosureType e)) :+ rssEnclosureAttrs e }++xmlCategory :: RSSCategory -> XML.Element+xmlCategory c =+ (xmlLeaf "category" (rssCategoryValue c))+ { elAttribs =+ (fromMaybe id (fmap (\ n -> ((Attr (qualName "domain") n):))+ (rssCategoryDomain c))) $+ (rssCategoryAttrs c) }++xmlGuid :: RSSGuid -> XML.Element+xmlGuid g =+ (xmlLeaf "guid" (rssGuidValue g))+ { elAttribs =+ (fromMaybe id (fmap (\ n -> ((Attr (qualName "isPermaLink") (toBool n)):))+ (rssGuidPermanentURL g))) $+ (rssGuidAttrs g) }+ where+ toBool False = "false"+ toBool _ = "true"++xmlImage :: RSSImage -> XML.Element+xmlImage im =+ (qualNode "image" $ map Elem $+ ( [ xmlLeaf "url" (rssImageURL im)+ , xmlLeaf "title" (rssImageTitle im)+ , xmlLeaf "link" (rssImageLink im)+ ]+ ++ mb ((xmlLeaf "width") . show) (rssImageWidth im)+ ++ mb ((xmlLeaf "height") . show) (rssImageHeight im)+ ++ mb (xmlLeaf "description") (rssImageDesc im)+ ++ rssImageOther im))++xmlCloud :: RSSCloud -> XML.Element+xmlCloud cl =+ (xmlLeaf "cloud" "")+ { elAttribs =+ ( mb (Attr (qualName "domain")) (rssCloudDomain cl)+ ++ mb (Attr (qualName "port")) (rssCloudPort cl)+ ++ mb (Attr (qualName "path")) (rssCloudPath cl)+ ++ mb (Attr (qualName "register")) (rssCloudRegister cl)+ ++ mb (Attr (qualName "protocol")) (rssCloudProtocol cl)+ ++ rssCloudAttrs cl) }++xmlTextInput :: RSSTextInput -> XML.Element+xmlTextInput ti =+ (qualNode "textInput" $ map Elem $+ ( [ xmlLeaf "title" (rssTextInputTitle ti)+ , xmlLeaf "description" (rssTextInputDesc ti)+ , xmlLeaf "name" (rssTextInputName ti)+ , xmlLeaf "link" (rssTextInputLink ti)+ ] ++ rssTextInputOther ti))+ { elAttribs = rssTextInputAttrs ti }++xmlSkipHours :: [Integer] -> XML.Element+xmlSkipHours hs =+ (qualNode "skipHours" $ map Elem $+ (map (\ n -> xmlLeaf "hour" (show n)) hs))++xmlSkipDays :: [String] -> XML.Element+xmlSkipDays hs =+ (qualNode "skipDayss" $ map Elem $+ (map (\ n -> xmlLeaf "day" n) hs))++--++xmlAttr :: String -> String -> XML.Attr+xmlAttr k v = Attr (qualName k) v++xmlLeaf :: String -> String -> XML.Element+xmlLeaf tg txt =+ blank_element{ elName = qualName tg+ , elContent = [ Text blank_cdata { cdData = txt } ]+ }++---+mb :: (a -> b) -> Maybe a -> [b]+mb _ Nothing = []+mb f (Just x) = [f x]
+ src/Text/RSS/Import.hs view
@@ -0,0 +1,277 @@+--------------------------------------------------------------------+-- |+-- Module : Text.RSS.Import+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+--+-- Converting from XML to RSS+--+--------------------------------------------------------------------++module Text.RSS.Import where++import Text.RSS.Syntax+import Text.RSS1.Utils ( dcNS, dcPrefix )+import Text.XML.Light as XML++import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)+import Data.Char (isSpace )+import Control.Monad (guard,mplus)++pNodes :: String -> [XML.Element] -> [XML.Element]+pNodes x es = filter ((qualName x ==) . elName) es++pQNodes :: QName -> [XML.Element] -> [XML.Element]+pQNodes x es = filter ((x==) . elName) es++pNode :: String -> [XML.Element] -> Maybe XML.Element+pNode x es = listToMaybe (pNodes x es)++pQNode :: QName -> [XML.Element] -> Maybe XML.Element+pQNode x es = listToMaybe (pQNodes x es)++pLeaf :: String -> [XML.Element] -> Maybe String+pLeaf x es = strContent `fmap` pNode x es++pQLeaf :: QName -> [XML.Element] -> Maybe String+pQLeaf x es = strContent `fmap` (pQNode x es)++pAttr :: String -> XML.Element -> Maybe String+pAttr x e = lookup (qualName x) [ (k,v) | Attr k v <- elAttribs e ]++pMany :: String -> (XML.Element -> Maybe a) -> [XML.Element] -> [a]+pMany p f es = mapMaybe f (pNodes p es)++children :: XML.Element -> [XML.Element]+children e = onlyElems (elContent e)++qualName :: String -> QName+qualName x = QName{qName=x,qURI=Nothing,qPrefix=Nothing}++dcName :: String -> QName+dcName x = blank_name{qName=x,qURI=dcNS,qPrefix=dcPrefix}++elementToRSS :: XML.Element -> Maybe RSS+elementToRSS e = do+ guard (elName e == qualName "rss")+ let es = children e+ let as = elAttribs e+ v <- pAttr "version" e+ ch <- pNode "channel" es >>= elementToChannel+ return RSS+ { rssVersion = v+ , rssAttrs = filter (\ a -> not (qName (attrKey a) `elem` known_attrs)) as+ , rssChannel = ch+ , rssOther = filter (\ e1 -> elName e1 /= qualName "channel") es+ }+ where+ known_attrs = ["version"]++elementToChannel :: XML.Element -> Maybe RSSChannel+elementToChannel e = do+ guard (elName e == qualName "channel")+ let es = children e+ title <- pLeaf "title" es+ link <- pLeaf "link" es+ return RSSChannel+ { rssTitle = title+ , rssLink = link+ -- being liberal, <description/> is a required channel element.+ , rssDescription = fromMaybe title (pLeaf "description" es)+ , rssItems = pMany "item" elementToItem es+ , rssLanguage = pLeaf "language" es `mplus` pQLeaf (dcName "lang") es+ , rssCopyright = pLeaf "copyright" es+ , rssEditor = pLeaf "managingEditor" es `mplus` pQLeaf (dcName "creator") es+ , rssWebMaster = pLeaf "webMaster" es+ , rssPubDate = pLeaf "pubDate" es `mplus` pQLeaf (dcName "date") es+ , rssLastUpdate = pLeaf "lastBuildDate" es `mplus` pQLeaf (dcName "date") es+ , rssCategories = pMany "category" elementToCategory es+ , rssGenerator = pLeaf "generator" es `mplus` pQLeaf (dcName "source") es+ , rssDocs = pLeaf "docs" es+ , rssCloud = pNode "cloud" es >>= elementToCloud+ , rssTTL = pLeaf "ttl" es >>= readInt+ , rssImage = pNode "image" es >>= elementToImage+ , rssRating = pLeaf "rating" es+ , rssTextInput = pNode "textInput" es >>= elementToTextInput+ , rssSkipHours = pNode "skipHours" es >>= elementToSkipHours+ , rssSkipDays = pNode "skipDays" es >>= elementToSkipDays+ , rssChannelOther = filter (\ e1 -> not (elName e1 `elem` known_channel_elts)) es+ }+ where+ known_channel_elts = map qualName+ [ "title", "link", "description"+ , "item", "language", "copyright"+ , "managingEditor", "webMaster"+ , "pubDate", "lastBuildDate"+ , "category", "generator", "docs"+ , "cloud", "ttl", "image"+ , "rating", "textInput"+ , "skipHours", "skipDays"+ ]++elementToImage :: XML.Element -> Maybe RSSImage+elementToImage e = do+ guard (elName e == qualName "image")+ let es = children e+ url <- pLeaf "url" es+ title <- pLeaf "title" es+ link <- pLeaf "link" es+ return RSSImage+ { rssImageURL = url+ , rssImageTitle = title+ , rssImageLink = link+ , rssImageWidth = pLeaf "width" es >>= readInt+ , rssImageHeight = pLeaf "height" es >>= readInt+ , rssImageDesc = pLeaf "description" es+ , rssImageOther = filter (\ e1 -> not (elName e1 `elem` known_image_elts)) es+ }+ where+ known_image_elts = map qualName+ [ "url", "title", "link"+ , "width", "height", "description"+ ]++elementToCategory :: XML.Element -> Maybe RSSCategory+elementToCategory e = do+ guard (elName e == qualName "category")+ let as = elAttribs e+ return RSSCategory+ { rssCategoryDomain = pAttr "domain" e+ , rssCategoryAttrs = filter (\ a -> not (qName (attrKey a) `elem` known_attrs)) as+ , rssCategoryValue = strContent e+ }+ where+ known_attrs = ["domain"]++elementToCloud :: XML.Element -> Maybe RSSCloud+elementToCloud e = do+ guard (elName e == qualName "cloud")+ let as = elAttribs e+ return RSSCloud+ { rssCloudDomain = pAttr "domain" e+ , rssCloudPort = pAttr "port" e+ , rssCloudPath = pAttr "path" e+ , rssCloudRegister = pAttr "register" e+ , rssCloudProtocol = pAttr "protocol" e+ , rssCloudAttrs = filter (\ a -> not (qName (attrKey a) `elem` known_attrs)) as+ }+ where+ known_attrs = [ "domain", "port", "path", "register", "protocol" ]++elementToItem :: XML.Element -> Maybe RSSItem+elementToItem e = do+ guard (elName e == qualName "item")+ let es = children e+ return RSSItem+ { rssItemTitle = pLeaf "title" es+ , rssItemLink = pLeaf "link" es+ , rssItemDescription = pLeaf "description" es+ , rssItemAuthor = pLeaf "author" es `mplus` pQLeaf (dcName "creator") es+ , rssItemCategories = pMany "category" elementToCategory es+ , rssItemComments = pLeaf "comments" es+ , rssItemEnclosure = pNode "enclosure" es >>= elementToEnclosure+ , rssItemGuid = pNode "guid" es >>= elementToGuid+ , rssItemPubDate = pLeaf "pubDate" es `mplus` pQLeaf (dcName "date") es+ , rssItemSource = pNode "source" es >>= elementToSource+ , rssItemAttrs = elAttribs e+ , rssItemOther = filter (\ e1 -> not (elName e1 `elem` known_item_elts)) es+ }+ where+ known_item_elts = map qualName+ [ "title", "link", "description"+ , "author", "category", "comments"+ , "enclosure", "guid", "pubDate"+ , "source"+ ]++elementToSource :: XML.Element -> Maybe RSSSource+elementToSource e = do+ guard (elName e == qualName "source")+ let as = elAttribs e+ url <- pAttr "url" e+ return RSSSource+ { rssSourceURL = url+ , rssSourceAttrs = filter (\ a -> not (qName (attrKey a) `elem` known_attrs)) as+ , rssSourceTitle = strContent e+ }+ where+ known_attrs = [ "url" ]++elementToEnclosure :: XML.Element -> Maybe RSSEnclosure+elementToEnclosure e = do+ guard (elName e == qualName "enclosure")+ let as = elAttribs e+ url <- pAttr "url" e+ ty <- pAttr "type" e+ return RSSEnclosure+ { rssEnclosureURL = url+ , rssEnclosureType = ty+ , rssEnclosureLength = pAttr "length" e >>= readInt+ , rssEnclosureAttrs = filter (\ a -> not (qName (attrKey a) `elem` known_attrs)) as+ }+ where+ known_attrs = [ "url", "type", "length" ]++elementToGuid :: XML.Element -> Maybe RSSGuid+elementToGuid e = do+ guard (elName e == qualName "guid")+ let as = elAttribs e+ return RSSGuid+ { rssGuidPermanentURL = pAttr "isPermaLink" e >>= readBool+ , rssGuidAttrs = filter (\ a -> not (qName (attrKey a) `elem` known_attrs)) as+ , rssGuidValue = strContent e+ }+ where+ known_attrs = ["isPermaLink"]++elementToTextInput :: XML.Element -> Maybe RSSTextInput+elementToTextInput e = do+ guard (elName e == qualName "textInput")+ let es = children e+ title <- pLeaf "title" es+ desc <- pLeaf "description" es+ name <- pLeaf "name" es+ link <- pLeaf "link" es+ return RSSTextInput+ { rssTextInputTitle = title+ , rssTextInputDesc = desc+ , rssTextInputName = name+ , rssTextInputLink = link+ , rssTextInputAttrs = elAttribs e+ , rssTextInputOther = filter (\ e1 -> not (elName e1 `elem` known_ti_elts)) es+ }+ where+ known_ti_elts = map qualName+ ["title", "description", "name", "link"]++elementToSkipHours :: XML.Element -> Maybe [Integer]+elementToSkipHours e = do+ guard (elName e == qualName "skipHours")+ -- don't bother checking that this is below limit ( <= 24)+ return (pMany "hour" (readInt.strContent) (children e))++elementToSkipDays :: XML.Element -> Maybe [String]+elementToSkipDays e = do+ guard (elName e == qualName "skipDays")+ -- don't bother checking that this is below limit ( <= 7)+ return (pMany "day" (return . strContent) (children e))++----++readInt :: String -> Maybe Integer+readInt s =+ case reads s of+ ((x,_):_) -> Just x+ _ -> Nothing++readBool :: String -> Maybe Bool+readBool s =+ case dropWhile isSpace s of+ 't':'r':'u':'e':_ -> Just True+ 'f':'a':'l':'s':'e':_ -> Just False+ _ -> Nothing+
+ src/Text/RSS/Syntax.hs view
@@ -0,0 +1,293 @@+--------------------------------------------------------------------+-- |+-- Module : Text.RSS.Syntax+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+--+-- The basic syntax for putting together feeds.+--+-- For instance, to create a feed with a single item item:+-- (nullRSS \"rss title\" \"link\") {rssChannel=(nullChannel \"channel title\" \"link\") {rssItems=[(nullItem \"item title\")]}}++--------------------------------------------------------------------+++module Text.RSS.Syntax where++import Text.XML.Light as XML++-- * Core Types++-- ^The Radio Userland version of RSS documents\/feeds.+-- (versions 0.9x, 2.x)+data RSS+ = RSS+ { rssVersion :: String+ , rssAttrs :: [XML.Attr]+ , rssChannel :: RSSChannel+ , rssOther :: [XML.Element]+ }+ deriving (Show)++type URLString = String+-- | RFC 822 conforming.+type DateString = String++data RSSChannel+ = RSSChannel+ { rssTitle :: String+ , rssLink :: URLString+ , rssDescription :: String+ , rssItems :: [RSSItem]+ , rssLanguage :: Maybe String+ , rssCopyright :: Maybe String+ , rssEditor :: Maybe String+ , rssWebMaster :: Maybe String+ , rssPubDate :: Maybe DateString -- ^ rfc 822 conforming.+ , rssLastUpdate :: Maybe DateString -- ^ rfc 822 conforming.+ , rssCategories :: [RSSCategory]+ , rssGenerator :: Maybe String+ , rssDocs :: Maybe URLString+ , rssCloud :: Maybe RSSCloud+ , rssTTL :: Maybe Integer+ , rssImage :: Maybe RSSImage+ , rssRating :: Maybe String+ , rssTextInput :: Maybe RSSTextInput+ , rssSkipHours :: Maybe [Integer]+ , rssSkipDays :: Maybe [String]+ , rssChannelOther :: [XML.Element]+ }+ deriving (Show)++data RSSItem+ = RSSItem+ { rssItemTitle :: Maybe String+ , rssItemLink :: Maybe URLString+ , rssItemDescription :: Maybe String -- ^if not present, the title is. (per spec, at least.)+ , rssItemAuthor :: Maybe String+ , rssItemCategories :: [RSSCategory]+ , rssItemComments :: Maybe URLString+ , rssItemEnclosure :: Maybe RSSEnclosure+ , rssItemGuid :: Maybe RSSGuid+ , rssItemPubDate :: Maybe DateString+ , rssItemSource :: Maybe RSSSource+ , rssItemAttrs :: [XML.Attr]+ , rssItemOther :: [XML.Element]+ }+ deriving (Show)++data RSSSource+ = RSSSource+ { rssSourceURL :: URLString+ , rssSourceAttrs :: [XML.Attr]+ , rssSourceTitle :: String+ }+ deriving (Show)++data RSSEnclosure+ = RSSEnclosure+ { rssEnclosureURL :: URLString+ , rssEnclosureLength :: Maybe Integer+ , rssEnclosureType :: String+ , rssEnclosureAttrs :: [XML.Attr]+ }+ deriving (Show)++data RSSCategory+ = RSSCategory+ { rssCategoryDomain :: Maybe String+ , rssCategoryAttrs :: [XML.Attr]+ , rssCategoryValue :: String+ }+ deriving (Show)++data RSSGuid+ = RSSGuid+ { rssGuidPermanentURL :: Maybe Bool+ , rssGuidAttrs :: [XML.Attr]+ , rssGuidValue :: String+ }+ deriving (Show)+++data RSSImage+ = RSSImage+ { rssImageURL :: URLString -- the URL to the image resource.+ , rssImageTitle :: String+ , rssImageLink :: URLString -- URL that the image resource should be an href to.+ , rssImageWidth :: Maybe Integer+ , rssImageHeight :: Maybe Integer+ , rssImageDesc :: Maybe String+ , rssImageOther :: [XML.Element]+ }+ deriving (Show)++data RSSCloud+ = RSSCloud+ { rssCloudDomain :: Maybe String+ , rssCloudPort :: Maybe String -- on purpose (i.e., not an int)+ , rssCloudPath :: Maybe String+ , rssCloudRegister :: Maybe String+ , rssCloudProtocol :: Maybe String+ , rssCloudAttrs :: [XML.Attr]+ }+ deriving (Show)++data RSSTextInput+ = RSSTextInput+ { rssTextInputTitle :: String+ , rssTextInputDesc :: String+ , rssTextInputName :: String+ , rssTextInputLink :: URLString+ , rssTextInputAttrs :: [XML.Attr]+ , rssTextInputOther :: [XML.Element]+ }+ deriving (Show)++-- * Default Constructors:++nullRSS :: String -- ^channel title+ -> URLString -- ^channel link+ -> RSS+nullRSS title link =+ RSS+ { rssVersion = "2.0"+ , rssAttrs = []+ , rssChannel = nullChannel title link+ , rssOther = []+ }++nullChannel :: String -- ^rssTitle+ -> URLString -- ^rssLink+ -> RSSChannel+nullChannel title link =+ RSSChannel+ { rssTitle = title+ , rssLink = link+ , rssDescription = title+ , rssItems = []+ , rssLanguage = Nothing+ , rssCopyright = Nothing+ , rssEditor = Nothing+ , rssWebMaster = Nothing+ , rssPubDate = Nothing+ , rssLastUpdate = Nothing+ , rssCategories = []+ , rssGenerator = Nothing+ , rssDocs = Nothing+ , rssCloud = Nothing+ , rssTTL = Nothing+ , rssImage = Nothing+ , rssRating = Nothing+ , rssTextInput = Nothing+ , rssSkipHours = Nothing+ , rssSkipDays = Nothing+ , rssChannelOther = []+ }++nullItem :: String -- ^title+ -> RSSItem+nullItem title =+ RSSItem+ { rssItemTitle = Just title+ , rssItemLink = Nothing+ , rssItemDescription = Nothing+ , rssItemAuthor = Nothing+ , rssItemCategories = []+ , rssItemComments = Nothing+ , rssItemEnclosure = Nothing+ , rssItemGuid = Nothing+ , rssItemPubDate = Nothing+ , rssItemSource = Nothing+ , rssItemAttrs = []+ , rssItemOther = []+ }++nullSource :: URLString -- ^source URL+ -> String -- ^title+ -> RSSSource+nullSource url title =+ RSSSource+ { rssSourceURL = url+ , rssSourceAttrs = []+ , rssSourceTitle = title+ }++nullEnclosure :: URLString -- ^enclosure URL+ -> Maybe Integer -- ^enclosure length+ -> String -- ^enclosure type+ -> RSSEnclosure+nullEnclosure url mb_len ty =+ RSSEnclosure+ { rssEnclosureURL = url+ , rssEnclosureLength = mb_len+ , rssEnclosureType = ty+ , rssEnclosureAttrs = []+ }++newCategory :: String -- ^category Value+ -> RSSCategory+newCategory nm =+ RSSCategory+ { rssCategoryDomain = Nothing+ , rssCategoryAttrs = []+ , rssCategoryValue = nm+ }++nullGuid :: String -- ^guid value+ -> RSSGuid+nullGuid v =+ RSSGuid+ { rssGuidPermanentURL = Nothing+ , rssGuidAttrs = []+ , rssGuidValue = v+ }++nullPermaGuid :: String -- ^guid value+ -> RSSGuid+nullPermaGuid v = (nullGuid v){rssGuidPermanentURL=Just True}++nullImage :: URLString -- ^imageURL+ -> String -- ^imageTitle+ -> URLString -- ^imageLink+ -> RSSImage+nullImage url title link =+ RSSImage+ { rssImageURL = url+ , rssImageTitle = title+ , rssImageLink = link+ , rssImageWidth = Nothing+ , rssImageHeight = Nothing+ , rssImageDesc = Nothing+ , rssImageOther = []+ }++nullCloud :: RSSCloud+nullCloud =+ RSSCloud+ { rssCloudDomain = Nothing+ , rssCloudPort = Nothing+ , rssCloudPath = Nothing+ , rssCloudRegister = Nothing+ , rssCloudProtocol = Nothing+ , rssCloudAttrs = []+ }++nullTextInput :: String -- ^inputTitle+ -> String -- ^inputName+ -> URLString -- ^inputLink+ -> RSSTextInput+nullTextInput title nm link =+ RSSTextInput+ { rssTextInputTitle = title+ , rssTextInputDesc = title+ , rssTextInputName = nm+ , rssTextInputLink = link+ , rssTextInputAttrs = []+ , rssTextInputOther = []+ }+
+ src/Text/RSS1/Export.hs view
@@ -0,0 +1,194 @@+--------------------------------------------------------------------+-- |+-- Module : Text.RSS1.Export+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+--------------------------------------------------------------------++module Text.RSS1.Export+ ( xmlFeed+ ) where++import Text.XML.Light as XML+import Text.RSS1.Syntax+import Text.RSS1.Utils+import Text.DublinCore.Types++import Data.List+import Data.Maybe++qualNode :: (Maybe String,Maybe String) -> String -> [XML.Content] -> XML.Element+qualNode ns n cs =+ blank_element+ { elName = qualName ns n+ , elContent = cs+ }++---+xmlFeed :: Feed -> XML.Element+xmlFeed f =+ (qualNode (rdfNS,rdfPrefix) "RDF" $ map Elem $+ (concat [ [xmlChannel (feedChannel f)]+ , mb xmlImage (feedImage f)+ , map xmlItem (feedItems f)+ , mb xmlTextInput (feedTextInput f)+ , map xmlTopic (feedTopics f)+ , feedOther f+ ] ))+ -- should we expect these to be derived by the XML pretty printer..?+ { elAttribs = nub $+ Attr (qualName (Nothing,Nothing) "xmlns") (fromJust rss10NS) :+ Attr (qualName (Nothing,Just "xmlns") (fromJust rdfPrefix)) (fromJust rdfNS) :+ Attr (qualName (Nothing,Just "xmlns") (fromJust synPrefix)) (fromJust synNS) :+ Attr (qualName (Nothing,Just "xmlns") (fromJust taxPrefix)) (fromJust taxNS) :+ Attr (qualName (Nothing,Just "xmlns") (fromJust conPrefix)) (fromJust conNS) :+ Attr (qualName (Nothing,Just "xmlns") (fromJust dcPrefix)) (fromJust dcNS) :+ feedAttrs f}++xmlChannel :: Channel -> XML.Element+xmlChannel ch =+ (qualNode (rss10NS,Nothing) "channel" $ map Elem $+ ([ xmlLeaf (rss10NS,Nothing) "title" (channelTitle ch)+ , xmlLeaf (rss10NS,Nothing) "link" (channelLink ch)+ , xmlLeaf (rss10NS,Nothing) "description" (channelDesc ch)+ ] +++ mb xmlTextInputURI (channelTextInputURI ch) +++ mb xmlImageURI (channelImageURI ch) +++ xmlItemURIs (channelItemURIs ch) ++ map xmlDC (channelDC ch) +++ concat [ mb xmlUpdatePeriod (channelUpdatePeriod ch)+ , mb xmlUpdateFreq (channelUpdateFreq ch)+ , mb (xmlLeaf (synNS,synPrefix) "updateBase") (channelUpdateBase ch)+ ] +++ xmlContentItems (channelContent ch) +++ xmlTopics (channelTopics ch) +++ channelOther ch))+ { elAttribs = ( Attr (qualName (rdfNS,rdfPrefix) "about") (channelURI ch) :+ channelAttrs ch)}++xmlImageURI :: URIString -> XML.Element+xmlImageURI u = xmlEmpty (rss10NS,Nothing) "image" [Attr (rdfName "resource") u ]++xmlImage :: Image -> XML.Element+xmlImage i =+ (qualNode (rss10NS,Nothing) "image" $ map Elem $+ ([ xmlLeaf (rss10NS,Nothing) "title" (imageTitle i)+ , xmlLeaf (rss10NS,Nothing) "url" (imageURL i)+ , xmlLeaf (rss10NS,Nothing) "link" (imageLink i)+ ] ++ map xmlDC (imageDC i) +++ imageOther i))+ { elAttribs = ( Attr (qualName (rdfNS,rdfPrefix) "about") (imageURI i) :+ imageAttrs i)}++xmlItemURIs :: [URIString] -> [XML.Element]+xmlItemURIs [] = []+xmlItemURIs xs =+ [qualNode (rss10NS, Nothing) "items" $+ [Elem (qualNode (rdfNS,rdfPrefix) "Seq" (map toRes xs))]]+ where+ toRes u = Elem (xmlEmpty (rdfNS,rdfPrefix) "li" [Attr (rdfName "resource") u])++xmlTextInputURI :: URIString -> XML.Element+xmlTextInputURI u = xmlEmpty (rss10NS,Nothing) "textinput" [Attr (rdfName "resource") u ]++xmlTextInput :: TextInputInfo -> XML.Element+xmlTextInput ti =+ (qualNode (rss10NS, Nothing) "textinput" $ map Elem $+ [ xmlLeaf (rss10NS,Nothing) "title" (textInputTitle ti)+ , xmlLeaf (rss10NS,Nothing) "description" (textInputDesc ti)+ , xmlLeaf (rss10NS,Nothing) "name" (textInputName ti)+ , xmlLeaf (rss10NS,Nothing) "link" (textInputLink ti)+ ] ++ map xmlDC (textInputDC ti) +++ textInputOther ti)+ {elAttribs=Attr (rdfName "about") (textInputURI ti) : textInputAttrs ti}++xmlDC :: DCItem -> XML.Element+xmlDC dc = xmlLeaf (dcNS,dcPrefix) (infoToTag (dcElt dc)) (dcText dc)++xmlUpdatePeriod :: UpdatePeriod -> XML.Element+xmlUpdatePeriod u = xmlLeaf (synNS,synPrefix) "updatePeriod" (toStr u)+ where+ toStr ux =+ case ux of+ Update_Hourly -> "hourly"+ Update_Daily -> "daily"+ Update_Weekly -> "weekly"+ Update_Monthly -> "monthly"+ Update_Yearly -> "yearly"++xmlUpdateFreq :: Integer -> XML.Element+xmlUpdateFreq f = xmlLeaf (synNS,synPrefix) "updateFrequency" (show f)++xmlContentItems :: [ContentInfo] -> [XML.Element]+xmlContentItems [] = []+xmlContentItems xs =+ [qualNode (conNS,conPrefix) "items"+ [Elem $ qualNode (rdfNS,rdfPrefix) "Bag"+ (map (\ e -> Elem (qualNode (rdfNS,rdfPrefix) "li" [Elem (xmlContentInfo e)]))+ xs)]]++xmlContentInfo :: ContentInfo -> XML.Element+xmlContentInfo ci =+ (qualNode (conNS,conPrefix) "item" $ map Elem $+ (concat [ mb (rdfResource (conNS,conPrefix) "format") (contentFormat ci)+ , mb (rdfResource (conNS,conPrefix) "encoding") (contentEncoding ci)+ , mb (rdfValue []) (contentValue ci)+ ]))+ {elAttribs=mb (Attr (rdfName "about")) (contentURI ci)}++rdfResource :: (Maybe String,Maybe String) -> String -> String -> XML.Element+rdfResource ns t v = xmlEmpty ns t [Attr (rdfName "resource") v ]++rdfValue :: [XML.Attr] -> String -> XML.Element+rdfValue as s = (xmlLeaf (rdfNS,rdfPrefix) "value" s){elAttribs=as}++xmlTopics :: [URIString] -> [XML.Element]+xmlTopics [] = []+xmlTopics xs =+ [qualNode (taxNS,taxPrefix) "topics"+ [Elem (qualNode (rdfNS,rdfPrefix) "Bag" $+ (map (Elem . rdfResource (rdfNS,rdfPrefix) "li") xs))]]++xmlTopic :: TaxonomyTopic -> XML.Element+xmlTopic tt =+ (qualNode (taxNS,taxPrefix) "topic" $ map Elem $+ (xmlLeaf (rss10NS,Nothing) "link" (taxonomyLink tt):+ mb (xmlLeaf (rss10NS,Nothing) "title") (taxonomyTitle tt) +++ mb (xmlLeaf (rss10NS,Nothing) "description") (taxonomyDesc tt) +++ xmlTopics (taxonomyTopics tt) +++ map xmlDC (taxonomyDC tt) +++ taxonomyOther tt))+ {elAttribs=[Attr (rdfName "about") (taxonomyURI tt)]}++xmlItem :: Item -> XML.Element+xmlItem i =+ (qualNode (rss10NS,Nothing) "item" $ map Elem $+ ([ xmlLeaf (rss10NS,Nothing) "title" (itemTitle i)+ , xmlLeaf (rss10NS,Nothing) "link" (itemLink i)+ ] +++ mb (xmlLeaf (rss10NS,Nothing) "description") (itemDesc i) +++ map xmlDC (itemDC i) +++ xmlTopics (itemTopics i) +++ map xmlContentInfo (itemContent i) +++ itemOther i))+ { elAttribs = ( Attr (qualName (rdfNS,rdfPrefix) "about") (itemURI i) :+ itemAttrs i)}++xmlLeaf :: (Maybe String,Maybe String) -> String -> String -> XML.Element+xmlLeaf ns tg txt =+ blank_element{ elName = qualName ns tg+ , elContent = [ Text blank_cdata { cdData = txt } ]+ }++xmlEmpty :: (Maybe String,Maybe String) -> String -> [XML.Attr] -> XML.Element+xmlEmpty ns t as = (qualNode ns t []){elAttribs=as}++---+mb :: (a -> b) -> Maybe a -> [b]+mb _ Nothing = []+mb f (Just x) = [f x]
+ src/Text/RSS1/Import.hs view
@@ -0,0 +1,247 @@+--------------------------------------------------------------------+-- |+-- Module : Text.RSS1.Import+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+--------------------------------------------------------------------++module Text.RSS1.Import+ ( elementToFeed+ ) where++import Text.RSS1.Syntax+import Text.RSS1.Utils+import Text.XML.Light as XML+import Text.DublinCore.Types++import Data.Maybe (mapMaybe, fromMaybe)+import Control.Monad (guard,mplus)++---+elementToFeed :: XML.Element -> Maybe Feed+elementToFeed e = do+ guard (elName e == rdfName "RDF")+ ver <- pAttr (Nothing,Nothing) "xmlns" e `mplus` rss10NS+ ch <- pNode "channel" e >>= elementToChannel+ let mbImg = pNode "image" e >>= elementToImage+ let is = fromMaybe [] $ fmap elementToItems $ pNode "items" e+ let mbTI = pNode "textinput" e >>= elementToTextInput+ let ch1 = ch{channelItemURIs = is}+ let its = pMany (rss10NS,Nothing) "item" elementToItem e++ let es_rest = removeKnownElts e+ let as_rest = removeKnownAttrs e+ return Feed+ { feedVersion = ver+ , feedChannel = ch1+ , feedImage = mbImg+ , feedItems = its+ , feedTextInput = mbTI+ , feedTopics = mapMaybe elementToTaxonomyTopic $ pQNodes (qualName (taxNS,taxPrefix) "topic") e+ , feedOther = es_rest+ , feedAttrs = as_rest+ }++elementToItems :: XML.Element -> [URIString]+elementToItems e = seqLeaves e++elementToTextInput :: XML.Element -> Maybe TextInputInfo+elementToTextInput e = do+ let es = children e+ uri <- pAttr (rdfNS,rdfPrefix) "about" e+ ti <- pQLeaf (rss10NS,Nothing) "title" e+ desc <- pQLeaf (rss10NS,Nothing) "description" e+ na <- pQLeaf (rss10NS,Nothing) "name" e+ li <- pQLeaf (rss10NS,Nothing) "link" e+ let dcs = mapMaybe elementToDC es+ return $ TextInputInfo+ { textInputURI = uri+ , textInputTitle = ti+ , textInputDesc = desc+ , textInputName = na+ , textInputLink = li+ , textInputDC = dcs+ , textInputOther = es+ , textInputAttrs = elAttribs e+ }++elementToItem :: XML.Element -> Maybe Item+elementToItem e = do+ guard (elName e == qualName (rss10NS,Nothing) "item")+ let es = children e+ uri <- pAttr (rdfNS,rdfPrefix) "about" e+ ti <- pQLeaf (rss10NS,Nothing) "title" e+ li <- pQLeaf (rss10NS,Nothing) "link" e+ let desc= pQLeaf (rss10NS,Nothing) "description" e+ let dcs = mapMaybe elementToDC es+ let tos = fromMaybe [] (fmap bagLeaves $ pQNode (qualName (taxNS,taxPrefix) "topics") e)+ let cs = mapMaybe elementToContent es+ let es_other = removeKnownElts e+ let as_other = removeKnownAttrs e+ return Item+ { itemURI = uri+ , itemTitle = ti+ , itemLink = li+ , itemDesc = desc+ , itemDC = dcs+ , itemTopics = tos+ , itemContent = cs+ , itemOther = es_other+ , itemAttrs = as_other+ }++elementToImage :: XML.Element -> Maybe Image+elementToImage e = do+ let es = children e+ let as = elAttribs e+ uri <- pAttr (rdfNS,rdfPrefix) "about" e+ ti <- pLeaf "title" e+ ur <- pLeaf "url" e+ li <- pLeaf "link" e+ let dcs = mapMaybe elementToDC es+ return Image+ { imageURI = uri+ , imageTitle = ti+ , imageURL = ur+ , imageLink = li+ , imageDC = dcs+ , imageOther = es+ , imageAttrs = as+ }++elementToChannel :: XML.Element -> Maybe Channel+elementToChannel e = do+ let es = children e+ uri <- pAttr (rdfNS,rdfPrefix) "about" e+ ti <- pLeaf "title" e+ li <- pLeaf "link" e+ de <- pLeaf "description" e+ let mbImg = pLeaf "image" e+ let is =+ case fmap seqLeaves $ pNode "items" e of+ Nothing -> []+ Just ss -> ss+ let tinp = pLeaf "textinput" e+ let dcs = mapMaybe elementToDC es+ let tos = fromMaybe [] (fmap bagLeaves $ pQNode (qualName (taxNS,taxPrefix) "topics") e)+ let cs = mapMaybe elementToContent es+ let es_other = removeKnownElts e+ let as_other = removeKnownAttrs e+ let def_chan =+ Channel+ { channelURI = uri+ , channelTitle = ti+ , channelLink = li+ , channelDesc = de+ , channelImageURI = mbImg+ , channelItemURIs = is+ , channelTextInputURI = tinp+ , channelDC = dcs+ , channelUpdatePeriod = Nothing+ , channelUpdateFreq = Nothing+ , channelUpdateBase = Nothing+ , channelContent = cs+ , channelTopics = tos+ , channelOther = es_other+ , channelAttrs = as_other+ }+ return (addSyndication e def_chan)++addSyndication :: XML.Element -> Channel -> Channel+addSyndication e ch =+ ch{ channelUpdatePeriod = fmap toUpdatePeriod $ pQLeaf (synNS,synPrefix) "updatePeriod" e+ , channelUpdateFreq = fmap read $ pQLeaf (synNS,synPrefix) "updateFrequency" e+ , channelUpdateBase = pQLeaf (synNS,synPrefix) "updateBase" e+ }+ where+ toUpdatePeriod x =+ case x of+ "hourly" -> Update_Hourly+ "daily" -> Update_Daily+ "weekly" -> Update_Weekly+ "monthly" -> Update_Monthly+ "yearly" -> Update_Yearly+ _ -> Update_Hourly -- ToDo: whine+++elementToDC :: XML.Element -> Maybe DCItem+elementToDC e = do+ guard (qURI (elName e) == dcNS)+ let dcItem x = DCItem{dcElt=x,dcText=strContent e}+ return $ dcItem $+ case qName $ elName e of+ "title" -> DC_Title+ "creator" -> DC_Creator+ "subject" -> DC_Subject+ "description" -> DC_Description+ "publisher" -> DC_Publisher+ "contributor" -> DC_Contributor+ "date" -> DC_Date+ "type" -> DC_Type+ "format" -> DC_Format+ "identifier" -> DC_Identifier+ "source" -> DC_Source+ "language" -> DC_Language+ "relation" -> DC_Relation+ "coverage" -> DC_Coverage+ "rights" -> DC_Rights+ oth -> DC_Other oth++elementToTaxonomyTopic :: XML.Element -> Maybe TaxonomyTopic+elementToTaxonomyTopic e = do+ guard (elName e == qualName (taxNS,taxPrefix) "topic")+ let es = children e+ uri <- pAttr (rdfNS,rdfPrefix) "about" e+ li <- pQLeaf (taxNS,taxPrefix) "link" e+ return TaxonomyTopic+ { taxonomyURI = uri+ , taxonomyLink = li+ , taxonomyTitle = pLeaf "title" e+ , taxonomyDesc = pLeaf "description" e+ , taxonomyTopics = fromMaybe [] (fmap bagLeaves $ pQNode (qualName (taxNS,taxPrefix) "topics") e)+ , taxonomyDC = mapMaybe elementToDC es+ , taxonomyOther = es+ }++elementToContent :: XML.Element -> Maybe ContentInfo+elementToContent e = do+ guard (elName e == qualName (conNS,conPrefix) "items")+ return ContentInfo+ { contentURI = pAttr (rdfNS,rdfPrefix) "about" e+ , contentFormat = pQLeaf (conNS,conPrefix) "format" e+ , contentEncoding = pQLeaf (conNS,conPrefix) "encoding" e+ , contentValue = pQLeaf (rdfNS,rdfPrefix) "value" e+ }++bagLeaves :: XML.Element -> [URIString]+bagLeaves be =+ mapMaybe+ (\ e -> do+ guard (elName e == qualName (rdfNS,rdfPrefix) "li")+ pAttr (rdfNS,rdfPrefix) "resource" e `mplus`+ fmap strContent (pQNode (qualName (rdfNS,rdfPrefix) "li") e))+ (fromMaybe [] $ fmap children $ pQNode (qualName (rdfNS,rdfPrefix) "Bag") be)++{-+bagElements :: XML.Element -> [XML.Element]+bagElements be =+ mapMaybe+ (\ e -> do+ guard (elName e == rdfName "li")+ return e)+ (fromMaybe [] $ fmap children $ pQNode (rdfName "Bag") be)+-}++seqLeaves :: XML.Element -> [URIString]+seqLeaves se =+ mapMaybe+ (\ e -> do+ guard (elName e == rdfName "li")+ return (strContent e))+ (fromMaybe [] $ fmap children $ pQNode (rdfName "Seq") se)
+ src/Text/RSS1/Syntax.hs view
@@ -0,0 +1,219 @@+--------------------------------------------------------------------+-- |+-- Module : Text.RSS1.Syntax+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+--------------------------------------------------------------------++module Text.RSS1.Syntax where++import Text.XML.Light.Types as XML+import Text.DublinCore.Types++type URIString = String+type TitleString = String+type TimeString = String+type TextString = String++data Feed+ = Feed { feedVersion :: String+ , feedChannel :: Channel+ , feedImage :: Maybe Image+ , feedItems :: [Item]+ , feedTextInput :: Maybe TextInputInfo+ , feedTopics :: [TaxonomyTopic]+ , feedOther :: [XML.Element]+ , feedAttrs :: [XML.Attr]+ }+ deriving (Show)++data Channel+ = Channel+ { channelURI :: URIString+ , channelTitle :: TitleString+ , channelLink :: URIString+ , channelDesc :: TextString+ -- these are indirect RDF associations to elements declared+ -- outside the channel element in the RDF \/ feed document.+ , channelImageURI :: Maybe URIString+ , channelItemURIs :: [URIString]+ , channelTextInputURI :: Maybe URIString+ , channelDC :: [DCItem]+ , channelUpdatePeriod :: Maybe UpdatePeriod+ , channelUpdateFreq :: Maybe Integer+ , channelUpdateBase :: Maybe TimeString -- format is yyyy-mm-ddThh:mm+ , channelContent :: [ContentInfo]+ , channelTopics :: [URIString]+ , channelOther :: [XML.Element]+ , channelAttrs :: [XML.Attr]+ }+ deriving (Show)++data Image+ = Image+ { imageURI :: URIString -- the image resource, most likely.+ , imageTitle :: TextString -- the "alt"ernative text.+ , imageURL :: URIString+ , imageLink :: URIString -- the href of the rendered img resource.+ , imageDC :: [DCItem]+ , imageOther :: [XML.Element]+ , imageAttrs :: [XML.Attr]+ }+ deriving (Show)++data Item+ = Item+ { itemURI :: URIString+ , itemTitle :: TextString+ , itemLink :: URIString+ , itemDesc :: Maybe TextString+ , itemDC :: [DCItem]+ , itemTopics :: [URIString]+ , itemContent :: [ContentInfo]+ , itemOther :: [XML.Element]+ , itemAttrs :: [XML.Attr]+ }+ deriving (Show)++data TextInputInfo+ = TextInputInfo+ { textInputURI :: URIString+ , textInputTitle :: TextString+ , textInputDesc :: TextString+ , textInputName :: TextString+ , textInputLink :: URIString+ , textInputDC :: [DCItem]+ , textInputOther :: [XML.Element]+ , textInputAttrs :: [XML.Attr]+ }+ deriving (Show)++data TaxonomyTopic+ = TaxonomyTopic+ { taxonomyURI :: URIString+ , taxonomyLink :: URIString+ , taxonomyTitle :: Maybe String+ , taxonomyDesc :: Maybe String+ , taxonomyTopics :: [URIString]+ , taxonomyDC :: [DCItem]+ , taxonomyOther :: [XML.Element]+ }+ deriving (Show)+++data UpdatePeriod+ = Update_Hourly+ | Update_Daily+ | Update_Weekly+ | Update_Monthly+ | Update_Yearly+ deriving (Eq, Show)++data ContentInfo+ = ContentInfo+ { contentURI :: Maybe URIString+ , contentFormat :: Maybe URIString+ , contentEncoding :: Maybe URIString+ , contentValue :: Maybe String -- should be: RDFValue+ }+ deriving (Eq, Show)++--default constructors:+nullFeed :: URIString -> TitleString -> Feed+nullFeed uri title =+ Feed { feedVersion = "1.0"+ , feedChannel = nullChannel uri title+ , feedImage = Nothing+ , feedItems = []+ , feedTextInput = Nothing+ , feedTopics = []+ , feedOther = []+ , feedAttrs = []+ }++nullChannel :: URIString -> TitleString -> Channel+nullChannel uri title =+ Channel+ { channelURI = uri+ , channelTitle = title+ , channelLink = uri+ , channelDesc = title+ , channelImageURI = Nothing+ , channelItemURIs = []+ , channelTextInputURI = Nothing+ , channelDC = []+ , channelUpdatePeriod = Nothing+ , channelUpdateFreq = Nothing+ , channelUpdateBase = Nothing+ , channelContent = []+ , channelTopics = []+ , channelOther = []+ , channelAttrs = []+ }++nullImage :: URIString -> String -> URIString -> Image+nullImage imguri title link =+ Image+ { imageURI = imguri+ , imageTitle = title+ , imageURL = imguri+ , imageLink = link+ , imageDC = []+ , imageOther = []+ , imageAttrs = []+ }++nullItem :: URIString -> TextString -> URIString -> Item+nullItem uri title link =+ Item+ { itemURI = uri+ , itemTitle = title+ , itemLink = link+ , itemDesc = Nothing+ , itemDC = []+ , itemTopics = []+ , itemContent = []+ , itemOther = []+ , itemAttrs = []+ }++nullTextInputInfo :: URIString -> TextString -> TextString -> URIString -> TextInputInfo+nullTextInputInfo uri title nm link =+ TextInputInfo+ { textInputURI = uri+ , textInputTitle = title+ , textInputDesc = title+ , textInputName = nm+ , textInputLink = link+ , textInputDC = []+ , textInputOther = []+ , textInputAttrs = []+ }++nullTaxonomyTopic :: URIString -> URIString -> TaxonomyTopic+nullTaxonomyTopic uri link =+ TaxonomyTopic+ { taxonomyURI = uri+ , taxonomyLink = link+ , taxonomyTitle = Nothing+ , taxonomyDesc = Nothing+ , taxonomyTopics = []+ , taxonomyDC = []+ , taxonomyOther = []+ }++nullContentInfo :: ContentInfo+nullContentInfo =+ ContentInfo+ { contentURI = Nothing+ , contentFormat = Nothing+ , contentEncoding = Nothing+ , contentValue = Nothing+ }+
+ src/Text/RSS1/Utils.hs view
@@ -0,0 +1,113 @@+--------------------------------------------------------------------+-- |+-- Module : Text.RSS1.Utils+-- Copyright : (c) Galois, Inc. 2008,+-- (c) Sigbjorn Finne 2009-+-- License : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+--------------------------------------------------------------------++module Text.RSS1.Utils where++import Text.XML.Light as XML+import Text.DublinCore.Types++import Data.Maybe (listToMaybe, mapMaybe)++pQNodes :: QName -> XML.Element -> [XML.Element]+pQNodes = XML.findChildren++pNode :: String -> XML.Element -> Maybe XML.Element+pNode x e = listToMaybe (pQNodes (qualName (rss10NS,Nothing) x) e)++pQNode :: QName -> XML.Element -> Maybe XML.Element+pQNode x e = listToMaybe (pQNodes x e)++pLeaf :: String -> XML.Element -> Maybe String+pLeaf x e = strContent `fmap` pQNode (qualName (rss10NS,Nothing) x) e++pQLeaf :: (Maybe String,Maybe String) -> String -> XML.Element -> Maybe String+pQLeaf ns x e = strContent `fmap` pQNode (qualName ns x) e++pAttr :: (Maybe String, Maybe String) -> String -> XML.Element -> Maybe String+pAttr ns x e = lookup (qualName ns x) [ (k,v) | Attr k v <- elAttribs e ]++pMany :: (Maybe String,Maybe String) -> String -> (XML.Element -> Maybe a) -> XML.Element -> [a]+pMany ns p f e = mapMaybe f (pQNodes (qualName ns p) e)++children :: XML.Element -> [XML.Element]+children e = onlyElems (elContent e)++qualName :: (Maybe String, Maybe String) -> String -> QName+qualName (ns,pre) x = QName{qName=x,qURI=ns,qPrefix=pre}++rssPrefix, rss10NS :: Maybe String+rss10NS = Just "http://purl.org/rss/1.0/"+rssPrefix = Nothing++rdfPrefix, rdfNS :: Maybe String+rdfNS = Just "http://www.w3.org/1999/02/22-rdf-syntax-ns#"+rdfPrefix = Just "rdf"++synPrefix, synNS :: Maybe String+synNS = Just "http://purl.org/rss/1.0/modules/syndication/"+synPrefix = Just "sy"++taxPrefix, taxNS :: Maybe String+taxNS = Just "http://purl.org/rss/1.0/modules/taxonomy/"+taxPrefix = Just "taxo"++conPrefix, conNS :: Maybe String+conNS = Just "http://purl.org/rss/1.0/modules/content/"+conPrefix = Just "content"++dcPrefix, dcNS :: Maybe String+dcNS = Just "http://purl.org/dc/elements/1.1/"+dcPrefix = Just "dc"++rdfName :: String -> QName+rdfName x = QName{qName=x,qURI=rdfNS,qPrefix=rdfPrefix}++rssName :: String -> QName+rssName x = QName{qName=x,qURI=rss10NS,qPrefix=rssPrefix}++synName :: String -> QName+synName x = QName{qName=x,qURI=synNS,qPrefix=synPrefix}++known_rss_elts :: [QName]+known_rss_elts = map rssName [ "channel", "item", "image", "textinput" ]++known_syn_elts :: [QName]+known_syn_elts = map synName [ "updateBase", "updateFrequency", "updatePeriod" ]++known_dc_elts :: [QName]+known_dc_elts = map (qualName (dcNS,dcPrefix)) dc_element_names++known_tax_elts :: [QName]+known_tax_elts = map (qualName (taxNS,taxPrefix)) [ "topic", "topics" ]++known_con_elts :: [QName]+known_con_elts = map (qualName (conNS,conPrefix)) [ "items", "item", "format", "encoding" ]++removeKnownElts :: XML.Element -> [XML.Element]+removeKnownElts e =+ filter (\ e1 -> not (elName e1 `elem` known_elts)) (children e)+ where+ known_elts =+ concat [ known_rss_elts+ , known_syn_elts+ , known_dc_elts+ , known_con_elts+ , known_tax_elts+ ]++removeKnownAttrs :: XML.Element -> [XML.Attr]+removeKnownAttrs e =+ filter (\ a -> not (attrKey a `elem` known_attrs)) (elAttribs e)+ where+ known_attrs =+ map rdfName [ "about" ]
tests/Main.hs view
@@ -1,13 +1,18 @@-module Main where+module Main (main) where -import Text.XML.Light-import Text.Feed.Import+import Test.Framework (defaultMain)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit (Assertion, assertBool) import Text.Feed.Export+import Text.Feed.Import+import Text.XML.Light -import System.Environment+import Paths_feed main :: IO ()-main = do- (x:_) <- getArgs- feed <- parseFeedFromFile x- putStrLn (ppTopElement $ xmlFeed feed)+main = defaultMain [testCase "rss20" testRss20]++testRss20 :: Assertion+testRss20 = do+ putStrLn . ppTopElement . xmlFeed =<< parseFeedFromFile =<< getDataFileName "tests/files/rss20.xml"+ assertBool "OK" True
+ tests/files/rss20.xml view
@@ -0,0 +1,1153 @@+<?xml version="1.0"?>+<rss version="2.0" xmlns:dc="http://purl.org/dc/elements/1.1/">++<channel>+ <title>Planet Haskell</title>+ <link>http://planet.haskell.org/</link>+ <language>en</language>+ <description>Planet Haskell - http://planet.haskell.org/</description>++<item>+ <title>Brent Yorgey: Brent</title>+ <guid isPermalink="false">http://byorgey.wordpress.com/?p=63</guid>+ <link>http://byorgey.wordpress.com/2008/04/17/collecting-unstructured-information-with-the-monoid-of-partial-knowledge/</link>+ <description><div class="snap_preview"><br /><p>In <a href="http://byorgey.wordpress.com/2008/04/17/an-interesting-monoid/">my last post</a>, I described what I&#8217;m calling the &#8220;monoid of partial knowledge&#8221;, a way of creating a monoid over sets of elements from a preorder, which is a generalization of the familiar monoid <img src="http://l.wordpress.com/latex.php?latex=%28S%2C%5Cmax%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="(S,\max)" title="(S,\max)" class="latex" /> over a set with a total order and a smallest element.</p>+<p>There&#8217;s actually one situation where a special case of this monoid is commonly used in Haskell. Suppose you have a record type which contains several fields, and you would like to parse some input to create a value of this type. The problem is that the input is not very nice: the bits of input which designate values for various fields are not in any particular order; some occur more than once; some might even be missing. How to deal with this?</p>+<p>One common solution is to wrap the type of each field in the record with Maybe, and create a Monoid instance which allows you to combine two partial records into one (hopefully less partial) record. Using this framework, you can just parse each bit of input into a mostly-blank record, with one (or more) fields filled in, then combine all the records (with mconcat) into one summary record. For example:</p>+<pre>+import Data.Monoid+import Control.Monad -- for the MonadPlus instance of Maybe++data Record = R { name :: Maybe String,+ age :: Maybe Int }+ deriving (Eq, Show)++instance Monoid Record where+ mempty = R Nothing Nothing+ mappend r1 r2 = R { name = name r1 `mplus` name r2+ , age = age r1 `mplus` age r2+ }+</pre>+<p>The mplus function, from the MonadPlus instance for Maybe, simply takes the first Just value that it finds. This is nice and simple, and works just great:</p>+<pre>+&gt; mempty :: Record+R {name = Nothing, age = Nothing}+&gt; mconcat [mempty { name = Just "Brent" }]+R {name = Just &#8220;Brent&#8221;, age = Nothing}+&gt; mconcat [mempty { name = Just "Brent" }, mempty { age = Just 26 }]+R {name = Just &#8220;Brent&#8221;, age = Just 26}+&gt; mconcat [mempty { name = Just "Brent" }, mempty { age = Just 26 }, mempty { age = Just 23 }]+R {name = Just &#8220;Brent&#8221;, age = Just 26}+</pre>+<p>Note how the appending is left-biased, because mplus is left-biased: after seeing the first age, all subsequent ages are ignored.</p>+<p>Now, really what we&#8217;re doing here is using the monoid (as in my previous post) induced by the preorder which says that any name is <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" /> any other name, and any age is <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" /> any other age, and names and ages can&#8217;t be compared! </p>+<p>Some code is in order. First, we create a class for preorders, and a newtype to contain sets of elements (there&#8217;s already a Monoid instance for Set, so we need a newtype to give a different semantics). Then we translate the specification from my previous post directly into a Monoid instance.</p>+<pre>+import qualified Data.Set as S++-- laws:+-- if x == y, then x &lt;~ y+-- if x &lt;~ y and y &lt;~ z, then x &lt;~ z+class (Eq p) =&gt; Preorder p where+ (&lt;~) :: p -&gt; p -&gt; Bool++newtype PStar p = PStar { unPStar :: (S.Set p) }+ deriving Show++instance (Preorder p, Ord p) =&gt; Monoid (PStar p) where+ mempty = PStar S.empty+ mappend (PStar ss) (PStar ts) = PStar $+ S.filter (\s -&gt; all (\t -&gt; s == t || t &lt;~ s || not (s &lt;~ t)) $ S.toList ts) ss+ `S.union`+ S.filter (\t -&gt; all (\s -&gt; s == t || not (t &lt;~ s)) $ S.toList ss) ts+</pre>+<p>Pretty straightforward! Of course, there are probably more efficient ways to do this, but I don&#8217;t care about that at the moment: let&#8217;s get some working proof-of-concept code, and worry about efficiency later. Now, one thing you may notice is that our Monoid instance requires an Ord instance for p! &#8220;But I thought we only needed a preorder?&#8221; I hear you cry. Well, the Ord is just there so that we can use an efficient implementation of Set. In particular, note that the Ord instance need have nothing at all to do with the Preorder instance, and won&#8217;t affect the semantics of this Monoid instance in any way. If we wanted, we could do away with the Ord entirely and use lists of unique elements (or something like that) instead of Sets.</p>+<p>So, how do we translate our record example from above into this new framework? Easy, we just create a data type to represent the different kinds of facts we want to represent, along with a convenience method or two, and make it an instance of Preorder:</p>+<pre>+data Fact = Name String | Age Int+ deriving (Eq,Show,Ord)++fact :: Fact -&gt; PStar Fact+fact f = PStar (S.singleton f)++instance Preorder Fact where+ (Name _) &lt;~ (Name _) = True+ (Age _) &lt;~ (Age _) = True+ _ &lt;~ _ = False+</pre>+<p>Let&#8217;s try it!</p>+<pre>+&gt; mempty :: PStar Fact+PStar {unPStar = fromList []}+&gt; mconcat . map fact $ [Name "Brent"]+PStar {unPStar = fromList [Name "Brent"]}+&gt; mconcat . map fact $ [Name "Brent", Age 26]+PStar {unPStar = fromList [Name "Brent",Age 26]}+&gt; mconcat . map fact $ [Name "Brent", Age 26, Age 23]+PStar {unPStar = fromList [Name "Brent",Age 26]}+</pre>+<p>Neato! But the really cool thing is all the extra power we get now: we can easily tweak the semantics of the Monoid instance by altering the Preorder instance. For example, suppose we want the first name that we see, but the <i>oldest</i> age. Easy peasy:</p>+<pre>+instance Preorder Fact where+ (Name _) &lt;~ (Name _) = True+ (Age m) &lt;~ (Age n) = m &lt;= n+ _ &lt;~ _ = False++&gt; mconcat . map fact $ [Age 23, Name "Brent"]+PStar {unPStar = fromList [Name "Brent",Age 23]}+&gt; mconcat . map fact $ [Age 23, Name "Brent", Age 24]+PStar {unPStar = fromList [Name "Brent",Age 24]}+&gt; mconcat . map fact $ [Age 23, Name "Brent", Age 24, Name "Joe", Age 26]+PStar {unPStar = fromList [Name "Brent",Age 26]}+</pre>+<p>Of course, we could have done this with the Record model, but it wouldn&#8217;t be terribly elegant. But we&#8217;re not done: let&#8217;s say we want to remember the oldest age we find, and the first name, unless the age is over 50, in which case we don&#8217;t want to remember the name (I admit this is a bit contrived)? That&#8217;s not too hard either:</p>+<pre>+instance Preorder Fact where+ (Name _) &lt;~ (Name _) = True+ (Age m) &lt;~ (Age n) = m &lt;= n+ (Name _) &lt;~ (Age n) = n &gt; 50+ _ &lt;~ _ = False++&gt; mconcat . map fact $ [Name "Brent", Age 26]+PStar {unPStar = fromList [Name "Brent",Age 26]}+&gt; mconcat . map fact $ [Name "Brent", Age 26, Age 45]+PStar {unPStar = fromList [Name "Brent",Age 45]}+&gt; mconcat . map fact $ [Name "Brent", Age 26, Age 45, Age 53]+PStar {unPStar = fromList [Age 53]}+</pre>+<p>This would have been a huge pain to do with the Record model! Now, this isn&#8217;t an unqualified improvement; there are several things we can&#8217;t do here. One is if we want to be able to combine facts into larger compound facts: we can do that fairly straightforwardly with the Record-of-Maybes model, but not with the preorder-monoid model. We also can&#8217;t easily choose to have some fields be left-biased and some right-biased (the Monoid instance for PStar has left-bias built in!). But it&#8217;s certainly an interesting approach.</p>+<p>Now, one thing we do have to be careful of is that our Preorder instances really do define a preorder! For example, at first I tried using <img src="http://l.wordpress.com/latex.php?latex=n+%3C+18&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="n &lt; 18" title="n &lt; 18" class="latex" /> in the above Preorder instance instead of <img src="http://l.wordpress.com/latex.php?latex=n+%3E+50&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="n &gt; 50" title="n &gt; 50" class="latex" />, and was confused by the weird results I got. But such a Preorder instance violates transitivity, so no wonder I was getting weird semantics. =) It would be interesting to reformulate this in a dependently typed language like <a href="http://appserv.cs.chalmers.se/users/ulfn/wiki/agda.php">Agda</a>, where creating a Preorder could actually require a proof that it satisfied the preorder axioms.</p>+<p>Thanks to <a href="http://conal.net/">Conal Elliott</a> for some suggestions on making the formulation in the previous post more elegant &#8212; we&#8217;ll see what comes of it!</p>+<img alt="" border="0" src="http://feeds.wordpress.com/1.0/categories/byorgey.wordpress.com/63/" /> <img alt="" border="0" src="http://feeds.wordpress.com/1.0/tags/byorgey.wordpress.com/63/" /> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/gocomments/byorgey.wordpress.com/63/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/comments/byorgey.wordpress.com/63/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/godelicious/byorgey.wordpress.com/63/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/delicious/byorgey.wordpress.com/63/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/gostumble/byorgey.wordpress.com/63/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/stumble/byorgey.wordpress.com/63/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/godigg/byorgey.wordpress.com/63/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/digg/byorgey.wordpress.com/63/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/goreddit/byorgey.wordpress.com/63/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/reddit/byorgey.wordpress.com/63/" /></a> <img alt="" border="0" src="http://stats.wordpress.com/b.gif?host=byorgey.wordpress.com&amp;blog=1152889&amp;post=63&amp;subd=byorgey&amp;ref=&amp;feed=1" /></div></description>+ <pubDate>Thu, 17 Apr 2008 21:32:00 +0000</pubDate>+ <dc:creator>Brent</dc:creator>+</item>+<item>+ <title>Brent Yorgey: Brent</title>+ <guid isPermalink="false">http://byorgey.wordpress.com/?p=62</guid>+ <link>http://byorgey.wordpress.com/2008/04/17/an-interesting-monoid/</link>+ <description><div class="snap_preview"><br /><p>The other day I was just sort of letting my mind wander, and I came up with an interesting monoid, which I&#8217;m calling the &#8220;monoid of partial knowledge&#8221;. So I thought I&#8217;d write about it here, partly just because it&#8217;s interesting, and partly to see whether anyone has any pointers to any literature (I&#8217;m sure I&#8217;m not the first to come up with it).</p>+<p>Recall that a <a href="https://secure.wikimedia.org/wikipedia/en/wiki/Monoid"><i>monoid</i></a> is a set with an associative binary operation and a distinguished element which is the identity for the operation.</p>+<p>Now, given a <a href="https://secure.wikimedia.org/wikipedia/en/wiki/Total_order"><i>total order</i></a> on a set <img src="http://l.wordpress.com/latex.php?latex=S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S" title="S" class="latex" /> with a smallest element <img src="http://l.wordpress.com/latex.php?latex=e&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="e" title="e" class="latex" />, we get a monoid <img src="http://l.wordpress.com/latex.php?latex=%28S%2C+%5Cmax%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="(S, \max)" title="(S, \max)" class="latex" />, where <img src="http://l.wordpress.com/latex.php?latex=%5Cmax&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\max" title="\max" class="latex" /> denotes the function which determines the larger of two elements, according to the total order on <img src="http://l.wordpress.com/latex.php?latex=S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S" title="S" class="latex" />. <img src="http://l.wordpress.com/latex.php?latex=%5Cmax&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\max" title="\max" class="latex" /> is clearly associative, and has identity <img src="http://l.wordpress.com/latex.php?latex=e&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="e" title="e" class="latex" />. Taking a list of elements of <img src="http://l.wordpress.com/latex.php?latex=S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S" title="S" class="latex" /> and summarizing it via this monoid corresponds to finding the maximum element in the list. If you think of receiving the elements of the list one by one, and applying <img src="http://l.wordpress.com/latex.php?latex=%5Cmax&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\max" title="\max" class="latex" /> to each new incoming value and the value of an accumulator (storing the result back into the accumulator, which should obviously be initialized to <img src="http://l.wordpress.com/latex.php?latex=e&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="e" title="e" class="latex" />), at any given time the value of the accumulator represents the &#8216;current best&#8217;, i.e. the largest element among those received so far.</p>+<p>The idea I had was to generalize this from a total order to a preorder. Recall that a <a href="https://secure.wikimedia.org/wikipedia/en/wiki/Preorder"><i>preorder</i></a> is a set <img src="http://l.wordpress.com/latex.php?latex=S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S" title="S" class="latex" /> equipped with a reflexive, transitive binary relation, often denoted <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" />. That is, for any <img src="http://l.wordpress.com/latex.php?latex=x%2Cy%2Cz+%5Cin+S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x,y,z \in S" title="x,y,z \in S" class="latex" />, we have <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim x" title="x \lesssim x" class="latex" />; and <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+y+%5Cland+y+%5Clesssim+z&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim y \land y \lesssim z" title="x \lesssim y \land y \lesssim z" class="latex" /> implies <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+z&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim z" title="x \lesssim z" class="latex" />. If <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" /> is also antisymmetric, that is, <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+y+%5Cland+y+%5Clesssim+x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim y \land y \lesssim x" title="x \lesssim y \land y \lesssim x" class="latex" /> implies <img src="http://l.wordpress.com/latex.php?latex=x+%3D+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x = y" title="x = y" class="latex" />, it is called a <i>partial order</i>, or <i>poset</i>. Then if <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim y" title="x \lesssim y" class="latex" /> or <img src="http://l.wordpress.com/latex.php?latex=y+%5Clesssim+x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="y \lesssim x" title="y \lesssim x" class="latex" /> for any two elements <img src="http://l.wordpress.com/latex.php?latex=x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x" title="x" class="latex" /> and <img src="http://l.wordpress.com/latex.php?latex=y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="y" title="y" class="latex" />, we get a total order, but for a general preorder some pairs of elements may not be comparable &#8212; that is, there may be elements <img src="http://l.wordpress.com/latex.php?latex=x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x" title="x" class="latex" /> and <img src="http://l.wordpress.com/latex.php?latex=y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="y" title="y" class="latex" /> for which neither <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim y" title="x \lesssim y" class="latex" /> nor <img src="http://l.wordpress.com/latex.php?latex=y+%5Clesssim+x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="y \lesssim x" title="y \lesssim x" class="latex" /> holds.</p>+<p>Let&#8217;s think about this. Suppose we are given a preorder <img src="http://l.wordpress.com/latex.php?latex=%28P%2C%5Clesssim%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="(P,\lesssim)" title="(P,\lesssim)" class="latex" /> with an <i>initial object</i> <img src="http://l.wordpress.com/latex.php?latex=e&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="e" title="e" class="latex" /> (an initial object in this context is an element which is <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" /> all other elements). We&#8217;ll initialize an accumulator to <img src="http://l.wordpress.com/latex.php?latex=e&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="e" title="e" class="latex" />, and imagine receiving elements of <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> one at a time. For a concrete example, suppose we are dealing with the preorder (actually also a poset) of positive integers under the divisibility relation, so our accumulator is initialized to 1. Let&#8217;s say we receive the integer 4. Clearly, 1 divides 4, so we should replace the 1 in our accumulator with 4. But now suppose we next receive the integer 5. 4 does not divide 5 or vice versa, so what should we do? We would be justified in neither throwing the 5 away nor replacing the 4, since 4 and 5 are not related to each other under the divisibility relation. Somehow we need to keep the 4 <i>and</i> the 5 around.</p>+<p>The solution is that instead of creating a monoid over <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> itself, as we can for sets with a total order, we create a monoid over <i>subsets</i> of <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" />. In particular, consider the set <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> of subsets of <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> which do not contain two distinct elements <img src="http://l.wordpress.com/latex.php?latex=x%2Cy&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x,y" title="x,y" class="latex" /> for which <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim y" title="x \lesssim y" class="latex" />. Since we are dealing with subsets of <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" />, we can actually drop the restriction that <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> contain an initial object; the empty set will serve as the identity for the monoid.</p>+<p>We then define the monoid operation <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" /> on two such subsets as</p>+<p><img src="http://l.wordpress.com/latex.php?latex=S+%5Coplus+T+%3D+%28S+%5Ctriangleleft+T%29+%5Ccup+%28S+%5Ctriangleright+T%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \oplus T = (S \triangleleft T) \cup (S \triangleright T)" title="S \oplus T = (S \triangleleft T) \cup (S \triangleright T)" class="latex" /></p>+<p>where</p>+<p><img src="http://l.wordpress.com/latex.php?latex=S+%5Ctriangleleft+T+%3D+%5C%7B+s+%5Cin+S+%5Cmid+%5Cforall+t+%5Cin+T%2C+s+%3D+t+%5Cmbox%7B+or+%7D+t+%5Clesssim+s+%5Cmbox%7B+or+%7D+s+%5Cnot+%5Clesssim+t+%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \triangleleft T = \{ s \in S \mid \forall t \in T, s = t \mbox{ or } t \lesssim s \mbox{ or } s \not \lesssim t \}" title="S \triangleleft T = \{ s \in S \mid \forall t \in T, s = t \mbox{ or } t \lesssim s \mbox{ or } s \not \lesssim t \}" class="latex" /></p>+<p>and</p>+<p><img src="http://l.wordpress.com/latex.php?latex=S+%5Ctriangleright+T+%3D+%5C%7B+t+%5Cin+T+%5Cmid+%5Cforall+s+%5Cin+S%2C+s+%3D+t+%5Cmbox%7B+or+%7D+t+%5Cnot+%5Clesssim+s+%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \triangleright T = \{ t \in T \mid \forall s \in S, s = t \mbox{ or } t \not \lesssim s \}" title="S \triangleright T = \{ t \in T \mid \forall s \in S, s = t \mbox{ or } t \not \lesssim s \}" class="latex" />.</p>+<p>In words, we combine subsets <img src="http://l.wordpress.com/latex.php?latex=S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S" title="S" class="latex" /> and <img src="http://l.wordpress.com/latex.php?latex=T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="T" title="T" class="latex" /> by forming the set of objects from <img src="http://l.wordpress.com/latex.php?latex=S+%5Ccup+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \cup T" title="S \cup T" class="latex" /> which are not <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" /> any others, with the exception of objects <img src="http://l.wordpress.com/latex.php?latex=s+%5Cin+S%2C+t+%5Cin+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="s \in S, t \in T" title="s \in S, t \in T" class="latex" /> where both <img src="http://l.wordpress.com/latex.php?latex=s+%5Clesssim+t&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="s \lesssim t" title="s \lesssim t" class="latex" /> and <img src="http://l.wordpress.com/latex.php?latex=t+%5Clesssim+s&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="t \lesssim s" title="t \lesssim s" class="latex" />; in this case we keep <img src="http://l.wordpress.com/latex.php?latex=s&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="s" title="s" class="latex" /> but not <img src="http://l.wordpress.com/latex.php?latex=t&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="t" title="t" class="latex" />. This introduces a &#8220;left bias&#8221; to <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" />; there is also an equally valid version with right bias (in particular, <img src="http://l.wordpress.com/latex.php?latex=S+%5Coplus%27+T+%3D+%28T+%5Ctriangleleft+S%29+%5Ccup+%28T+%5Ctriangleright+S%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \oplus&#039; T = (T \triangleleft S) \cup (T \triangleright S)" title="S \oplus&#039; T = (T \triangleleft S) \cup (T \triangleright S)" class="latex" />).</p>+<p>Now, let&#8217;s show that this really does define a valid monoid. First, we need to show that <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" /> is closed over <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" />. Suppose <img src="http://l.wordpress.com/latex.php?latex=S%2C+T+%5Cin+P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S, T \in P_*" title="S, T \in P_*" class="latex" />. Suppose also that <img src="http://l.wordpress.com/latex.php?latex=x%2Cy+%5Cin+S+%5Coplus+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x,y \in S \oplus T" title="x,y \in S \oplus T" class="latex" /> are distinct elements of <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> with <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim y" title="x \lesssim y" class="latex" />; we&#8217;ll derive a contradiction. First, we cannot have <img src="http://l.wordpress.com/latex.php?latex=x%2Cy+%5Cin+S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x,y \in S" title="x,y \in S" class="latex" /> or <img src="http://l.wordpress.com/latex.php?latex=x%2Cy+%5Cin+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x,y \in T" title="x,y \in T" class="latex" /> by definition of <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" />. Now suppose <img src="http://l.wordpress.com/latex.php?latex=x+%5Cin+T%2C+y+%5Cin+S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \in T, y \in S" title="x \in T, y \in S" class="latex" />. The fact that <img src="http://l.wordpress.com/latex.php?latex=x+%5Cin+S+%5Coplus+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \in S \oplus T" title="x \in S \oplus T" class="latex" /> together with the definition of <img src="http://l.wordpress.com/latex.php?latex=S+%5Ctriangleright+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \triangleright T" title="S \triangleright T" class="latex" /> imply that we must have <img src="http://l.wordpress.com/latex.php?latex=x+%5Cnot+%5Clesssim+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \not \lesssim y" title="x \not \lesssim y" class="latex" />, a contradiction. Finally, suppose <img src="http://l.wordpress.com/latex.php?latex=x+%5Cin+S%2C+y+%5Cin+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \in S, y \in T" title="x \in S, y \in T" class="latex" />. Again, by the definition of <img src="http://l.wordpress.com/latex.php?latex=S+%5Ctriangleright+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \triangleright T" title="S \triangleright T" class="latex" /> we must have <img src="http://l.wordpress.com/latex.php?latex=y+%5Cnot+%5Clesssim+x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="y \not \lesssim x" title="y \not \lesssim x" class="latex" />. But then the fact that <img src="http://l.wordpress.com/latex.php?latex=x+%5Cin+S+%5Coplus+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \in S \oplus T" title="x \in S \oplus T" class="latex" />, together with the definition of <img src="http://l.wordpress.com/latex.php?latex=S+%5Ctriangleleft+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \triangleleft T" title="S \triangleleft T" class="latex" /> and the facts that <img src="http://l.wordpress.com/latex.php?latex=x+%5Cneq+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \neq y" title="x \neq y" class="latex" /> and <img src="http://l.wordpress.com/latex.php?latex=y+%5Cnot+%5Clesssim+x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="y \not \lesssim x" title="y \not \lesssim x" class="latex" /> imply that <img src="http://l.wordpress.com/latex.php?latex=x+%5Cnot+%5Clesssim+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \not \lesssim y" title="x \not \lesssim y" class="latex" />, a contradiction again. Hence <img src="http://l.wordpress.com/latex.php?latex=S+%5Coplus+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \oplus T" title="S \oplus T" class="latex" /> contains no such pair of elements.</p>+<p>The fact that the empty set <img src="http://l.wordpress.com/latex.php?latex=%5Cvarnothing&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\varnothing" title="\varnothing" class="latex" /> is the identity for <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" /> is clear. (Incidentally, this is why we require that none of the sets in <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> contain two distinct elements with one <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" /> the other: if <img src="http://l.wordpress.com/latex.php?latex=S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S" title="S" class="latex" /> were such a set, we would have <img src="http://l.wordpress.com/latex.php?latex=%5Cvarnothing+%5Coplus+S+%5Cneq+S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\varnothing \oplus S \neq S" title="\varnothing \oplus S \neq S" class="latex" />.) I leave the associativity of <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" /> as an exercise for the reader (translation: this post is already getting long, the associativity of <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" /> seems intuitively obvious to me, and I don&#8217;t feel like formalizing it at the moment &#8212; perhaps I&#8217;ll try writing it up later). I also leave as an interesting exercise the following theorem: if <img src="http://l.wordpress.com/latex.php?latex=S%2C+T+%5Cin+P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S, T \in P_*" title="S, T \in P_*" class="latex" /> are both finite and nonempty, then <img src="http://l.wordpress.com/latex.php?latex=S+%5Coplus+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \oplus T" title="S \oplus T" class="latex" /> is also finite and nonempty.</p>+<p>In our example from before, we could now begin with <img src="http://l.wordpress.com/latex.php?latex=%5C%7B1%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{1\}" title="\{1\}" class="latex" /> in our accumulator. After receiving the singleton set <img src="http://l.wordpress.com/latex.php?latex=%5C%7B4%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{4\}" title="\{4\}" class="latex" />, our accumulator would have that singleton set as its new value. Upon receiving <img src="http://l.wordpress.com/latex.php?latex=%5C%7B5%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{5\}" title="\{5\}" class="latex" />, our accumulator would become <img src="http://l.wordpress.com/latex.php?latex=%5C%7B4%2C5%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{4,5\}" title="\{4,5\}" class="latex" />. Receiving <img src="http://l.wordpress.com/latex.php?latex=%5C%7B10%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{10\}" title="\{10\}" class="latex" /> would result in <img src="http://l.wordpress.com/latex.php?latex=%5C%7B4%2C10%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{4,10\}" title="\{4,10\}" class="latex" /> (5 divides 10, so the 5 is discarded); if we later received <img src="http://l.wordpress.com/latex.php?latex=%5C%7B20%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{20\}" title="\{20\}" class="latex" />, we would simply have <img src="http://l.wordpress.com/latex.php?latex=%5C%7B20%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{20\}" title="\{20\}" class="latex" /> in our accumulator (both 4 and 10 divide 20).</p>+<p>I like to think of this as the monoid of <i>partial knowledge</i>. If we consider <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> to be a set of facts or beliefs, some better (more reliable, useful, correct, complete, etc.) than others, then elements of <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> correspond to possible sets of beliefs. <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" /> describes how a set of beliefs changes upon encountering a new set of facts; some of the new facts may supersede and replace old ones, some may not impart any new information, and some may be completely new facts that aren&#8217;t related to any currently known.</p>+<p>Now, why can this be thought of as a generalization of the monoid <img src="http://l.wordpress.com/latex.php?latex=%28P%2C+%5Cmax%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="(P, \max)" title="(P, \max)" class="latex" /> on a totally ordered set? Well, look what happens when we replace <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> in the definitions above with a totally ordered set with relation <img src="http://l.wordpress.com/latex.php?latex=%5Cleq&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\leq" title="\leq" class="latex" />: first of all, the restriction on <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> (no two elements of a set in <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> should be related by <img src="http://l.wordpress.com/latex.php?latex=%5Cleq&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\leq" title="\leq" class="latex" />) means that <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> contains only the empty set and singleton sets, so (ignoring the empty set) <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> is isomorphic to <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" />. Now look at the definition of <img src="http://l.wordpress.com/latex.php?latex=S+%5Ctriangleleft+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \triangleleft T" title="S \triangleleft T" class="latex" />, with <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" /> replaced by <img src="http://l.wordpress.com/latex.php?latex=%5Cleq&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\leq" title="\leq" class="latex" /> (and <img src="http://l.wordpress.com/latex.php?latex=%5Cnot+%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\not \lesssim" title="\not \lesssim" class="latex" /> replaced by <img src="http://l.wordpress.com/latex.php?latex=%3E&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="&gt;" title="&gt;" class="latex" />):</p>+<p><img src="http://l.wordpress.com/latex.php?latex=S+%5Ctriangleleft+T+%3D+%5C%7B+s+%5Cin+S+%5Cmid+%5Cforall+t+%5Cin+T%2C+s+%3D+t+%5Cmbox%7B+or+%7D+t+%5Cleq+s+%5Cmbox%7B+or+%7D+s+%3E+t+%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \triangleleft T = \{ s \in S \mid \forall t \in T, s = t \mbox{ or } t \leq s \mbox{ or } s &gt; t \}" title="S \triangleleft T = \{ s \in S \mid \forall t \in T, s = t \mbox{ or } t \leq s \mbox{ or } s &gt; t \}" class="latex" /></p>+<p>But <img src="http://l.wordpress.com/latex.php?latex=s+%3D+t&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="s = t" title="s = t" class="latex" /> and <img src="http://l.wordpress.com/latex.php?latex=s+%3E+t&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="s &gt; t" title="s &gt; t" class="latex" /> are both subsumed by <img src="http://l.wordpress.com/latex.php?latex=t+%5Cleq+s&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="t \leq s" title="t \leq s" class="latex" />, so we can rewrite this as</p>+<p><img src="http://l.wordpress.com/latex.php?latex=%5C%7Bs%5C%7D+%5Ctriangleleft+%5C%7Bt%5C%7D+%3D+%5C%7Bs%5C%7D+%5Cmbox%7B+if+%7D+s+%5Cgeq+t%2C+%5Cmbox%7B+or+%7D+%5Cvarnothing+%5Cmbox%7B+otherwise+%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{s\} \triangleleft \{t\} = \{s\} \mbox{ if } s \geq t, \mbox{ or } \varnothing \mbox{ otherwise }" title="\{s\} \triangleleft \{t\} = \{s\} \mbox{ if } s \geq t, \mbox{ or } \varnothing \mbox{ otherwise }" class="latex" />.</p>+<p>An analysis of <img src="http://l.wordpress.com/latex.php?latex=%5Ctriangleright&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\triangleright" title="\triangleright" class="latex" /> is similar, and it is clear that <img src="http://l.wordpress.com/latex.php?latex=%5C%7Bs%5C%7D+%5Coplus+%5C%7Bt%5C%7D+%3D+%5C%7B%5Cmax%28s%2Ct%29%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{s\} \oplus \{t\} = \{\max(s,t)\}" title="\{s\} \oplus \{t\} = \{\max(s,t)\}" class="latex" />.</p>+<p>I note in passing that although it might appear shady that I swept that &#8220;ignoring the empty set&#8221; bit under the rug, everything really does check out: technically, to see a direct generalization of <img src="http://l.wordpress.com/latex.php?latex=%28P%2C%5Cmax%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="(P,\max)" title="(P,\max)" class="latex" /> to <img src="http://l.wordpress.com/latex.php?latex=%28P_%2A%2C+%5Coplus%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="(P_*, \oplus)" title="(P_*, \oplus)" class="latex" />, we can require that <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> have an initial object and that <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> contains only finite, nonempty sets. Then it requires a bit more work to prove that <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" /> is closed, but it still goes through. I used the formulation I did since it seems more general and requires less proving.</p>+<p>Anyway, this ended up being longer than I originally anticipated (why does that always happen!? =), so I&#8217;ll stop here for now, but next time I&#8217;ll give some actual Haskell code (which I think ends up being pretty neat!), and talk about one relatively common design pattern which is actually a special case of this monoid.</p>+<img alt="" border="0" src="http://feeds.wordpress.com/1.0/categories/byorgey.wordpress.com/62/" /> <img alt="" border="0" src="http://feeds.wordpress.com/1.0/tags/byorgey.wordpress.com/62/" /> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/gocomments/byorgey.wordpress.com/62/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/comments/byorgey.wordpress.com/62/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/godelicious/byorgey.wordpress.com/62/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/delicious/byorgey.wordpress.com/62/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/gostumble/byorgey.wordpress.com/62/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/stumble/byorgey.wordpress.com/62/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/godigg/byorgey.wordpress.com/62/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/digg/byorgey.wordpress.com/62/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/goreddit/byorgey.wordpress.com/62/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/reddit/byorgey.wordpress.com/62/" /></a> <img alt="" border="0" src="http://stats.wordpress.com/b.gif?host=byorgey.wordpress.com&amp;blog=1152889&amp;post=62&amp;subd=byorgey&amp;ref=&amp;feed=1" /></div></description>+ <pubDate>Thu, 17 Apr 2008 19:37:24 +0000</pubDate>+ <dc:creator>Brent</dc:creator>+</item>+<item>+ <title>Joachim Breitner: Announcing DarcsWatch</title>+ <guid isPermalink="false">http://www.joachim-breitner.de/blog/archives/290-guid.html</guid>+ <link>http://www.joachim-breitner.de/blog/archives/290-Announcing-DarcsWatch.html</link>+ <description><p>A lot of haskell-related projects use the <a href="http://darcs.net/">darcs</a> version control system. Darcs has the nice feature that you can easily submit a patch by e-mail, usually sent to the project maintainer or a mailing list. What has bothered me in the past was that I had to manually check whether my patch was applied yet.</p><p>So this week, I wrote <a href="http://darcs.nomeata.de/">DarcsWatch</a>. DarcsWatch receives submitted patches and compares them to the repositories it knows about, whether the patch is missing there or not. You either send your patches to DarcsWeb directly when submitting them, using CC, or DarcsWatch is subscribed to the project mailing list itself, which is the case for the <a href="http://lists.osuosl.org/mailman/listinfo/darcs-devel">darcs-devel</a> and <a href="http://www.haskell.org/mailman/listinfo/xmonad">xmonad</a> lists. Other than that, not much is to do, and you’ll find a nice overview of your patches, like this <a href="http://darcswatch.nomeata.de/user_mail@joachim-breitner.de.html">overview of my patches</a>, with diffs and download links.</p><p>If you want to use DarcsWatch for your contributions to other projects, or for your own projects, have a look the <a href="http://darcs.nomeata.de/darcswatch/documentation.html">documentation</a>. There are probably still bugs around, and the problem of marking patches as obsolete is not really solved yet, so if you have ideas about it, mail me, comment here, or come to #darcs on freenode. Patches are always welcome, you can get the source from <a href="http://darcs.nomeata.de/darcswatch/">DarcsWatch’s repository</a>.</p></description>+ <pubDate>Thu, 17 Apr 2008 17:25:15 +0000</pubDate>+ <dc:creator>mail@joachim-breitner.de (nomeata)</dc:creator>+</item>+<item>+ <title>Mark Jason Dominus: Is blood a transitive relation?</title>+ <guid isPermalink="false">tag:blog.plover.com,2008:/oops/blood-relatives</guid>+ <link>http://blog.plover.com/oops/blood-relatives.html</link>+ <description>When you're first teaching high school students about the idea of a+relation, you give examples of the important properties of relations.+Relations can be some, none, or all of reflexive, symmetric,+antisymmetric, or transitive. You start with examples that everyone+is already familiar with, such as the identity relation, which is+reflexive, symmetric, and transitive, and the &le; relation, which is+antisymmetric and transitive. Other good examples include familial+relations: "sister-in-law of" is symmetric on the set of women, but+not on the larger set of people; "ancestor of" is transitive but not+symmetric.<p>++It might seem at first glance that "is related to" is transitive, but,+at least under conventional definitions, it isn't, because my wife is+not related to my cousins.<p>++(I was once invited to speak at Haverford College, and,+since I have no obvious qualifications in <a href="http://perl.plover.com/yak/cftalk/">the topic on which I was speaking</a>, I was asked how I+had come to be there. I explained that it was because <a href="http://www.haverford.edu/math/lbutler.html">my wife's mother's+younger brother's daughter's husband's older brother's wife was the+chair of the mathematics department</a>. Remember, it's not what you+know, it's who you know.)<p>++I think I had sometimes tried to turn "related to" into a transitive+relation by restricting it to "is related to by blood". This rules+out the example above of my wife being unrelated to my cousins,+because my relationship with my wife is not one of blood. I don't+quite remember using "related by blood" as an example of a transitive+relation, but I think I might have, because I was quite surprised when+I realized that it didn't work. I spent a lot of time that morning+going over my counterexample in detail, writing it up in my head, as+it were. I was waiting around in Trevose for the mechanic to finish+examining my car, and had nothing better to do that morning. If I had+had a blog then, I would probably have posted it. But it is a good+thing that I didn't, because in spite of all my thought about it, I+missed something important.<p>++The example is as follows. <i>A</i> and <i>B</i> have a child,+<i>X</i>. (You may suppose that they marry beforehand, and divorce+afterward, if your morality requires it.) Similarly, <i>C</i> and+<i>D</i> have a child, <i>Z</i>. Then <i>B</i> and <i>C</i> have a+child <i>Y</i>. <i>Y</i> is now the half-sibling of both <i>X</i> and+<i>Z</i>, and so is unquestionably a blood relative of both, but+<i>X</i> and <i>Z</i> are entirely unrelated. They are not even+step-siblings.<p>++Well, this is all very well, but the reason I have filed it under <a href="http://blog.plover.com/oops/">oops/</a>, and the reason it's a good thing I+didn't post it on my (then nonexistent) blog is that this elaborate+counterexample contains a much simpler one: <i>X</i> is the child and+hence the blood relative of+both <i>A</i> and <i>B</i>, who are not in general related to+each other. <i>C</i>, <i>D</i>, <i>Y</i>, and <i>Z</i> are wholly+unnecessary.<p>++I wish I had some nice conclusion to draw here, but if there's+something I could learn from it I can't think would it might be.<p>++<!--++That is all I meant to write about, but I am in the waiting room at+the Parking Authority, waiting to protest a ticket, so I have lots of+time, and I may as well go on for a while.<p>++At my last regular job, one of my co-workers observed that everyone on+the corridor was part-Asian. Her mother was Japanese; another+colleague's was Thai. One colleague was Bengali. "I am on this+corridor," I said, "and I am not Asian." "You have blood relatives+who are Asian," she pointed out, which I had not really though of+before. Iris had recently been born, and she is half-Korean.<p>++When Iris was still <i>in utero</i>, Lorrie and I visited a genetic+counselor whose job was to judge the chance that Iris might come out+with some hereditary disorder. She asked me many questions about my+forebears, which I answered in my characteristically guarded way: "Is+there any history of Tay-Sachs disease in your family?" "Not so far+as I know." "I am not aware of any." "I believe not." And so on.<p>++But then she got to a more general question: "Is there any possibility+that you and Lorrie might be related?" And I laughed, and said+heartily, "None whatsoever!". <p>++--></p></p></p></p></p></p></p></description>+ <pubDate>Thu, 17 Apr 2008 17:05:00 +0000</pubDate>+ <dc:creator>Mark Dominus</dc:creator>+</item>+<item>+ <title>Conrad Parker: :rikaichan for Vimperator</title>+ <guid isPermalink="false">tag:blogger.com,1999:blog-9101292118679422945.post-8373941523429907668</guid>+ <link>http://blog.kfish.org/2008/04/rikaichan-for-vimperator.html</link>+ <description><p>+Some of my favourite Firefox plugins are:+<ul>+<li><a href="http://www.polarcloud.com/rikaichan/">Rikaichan</a>, a Japanese dictionary, which adds instant translation popups when you mouse over a word;</li>+<li><a href="http://vimperator.mozdev.org/">Vimperator</a>, which provides <tt>vi</tt>-like user interface;</li>+<li>and <a href="https://addons.mozilla.org/en-US/firefox/addon/1337">Hide Tab Bar</a>, because Vimperator's buffer list is more useful.</li>+</ul>+<p>+Vimperator hides the menu bar by default. <b>Tools->Toggle Rikaichan</b> has no default keybinding, and the keybindings to navigate the menubar are not available if the menubar is not visible, so Rikaichan can no longer be activated.+</p>+<p>+The following adds a vimperator command <tt>:rikaichan</tt>; save it to <tt>.vimperator/plugin/toggleRikaichan.js</tt>:++<blockquote><pre>+(function(){+ vimperator.commands.add(new vimperator.Command(+ ['rikaichan', 'rikai'],+ function(){+ rcxMain.inlineToggle();+ }+ ))+}) ();+</pre></blockquote>+</p>+<p>+It is aliased to <tt>:rikai</tt> for short, but unfortunately vimperator won't recognize <tt>:理解</tt>.+Thanks to ktsukagoshi for the explanation of how to write a vimperator plugin (<a href="http://d.hatena.ne.jp/ktsukagoshi/20080305/1204730962">vimperatorのプラグインの作成</a>).+</p>+<p>+<i>Remember, <a href="http://www.vergenet.net/~conrad/syre/">the interface is inside your mind</a>.</i>+</p></p></description>+ <pubDate>Thu, 17 Apr 2008 16:01:22 +0000</pubDate>+ <dc:creator>Conrad Parker</dc:creator>+</item>+<item>+ <title>Philip Wadler: Fun with correlation and citations</title>+ <guid isPermalink="false">tag:blogger.com,1999:blog-9757377.post-9088874984566084902</guid>+ <link>http://wadler.blogspot.com/2008/04/fun-with-correllation-and-citations.html</link>+ <description>I'm sure I'll want to cite this someday, possibly in class but perhaps in the pub. What I'll be citing it as an example of, I'm not yet sure. Thanks to Leonid Libkin for spotting this.</description>+ <pubDate>Thu, 17 Apr 2008 10:00:50 +0000</pubDate>+ <dc:creator>Philip Wadler</dc:creator>+</item>+<item>+ <title>Kenn Knowles: Drawing fractals in Haskell with a cursor graphics DSEL and a cute list representation</title>+ <guid isPermalink="false">http://www.kennknowles.com/blog/2008/04/16/drawing-fractals-in-haskell-with-a-cursor-graphics-dsel-and-a-cute-list-representation/</guid>+ <link>http://www.kennknowles.com/blog/2008/04/16/drawing-fractals-in-haskell-with-a-cursor-graphics-dsel-and-a-cute-list-representation/</link>+ <description><p>I'm reading the very fun <em>Measure, Topology, and Fractal Geometry</em> by GA Edgar, and thought I'd hack up some of the examples in Haskell. So this post implements cursor graphics in OpenGL in (I think) DSEL style, demonstrating the <code>StateT</code> and <code>Writer</code> monad gadgets from the+standard library and a cool "novel representation of lists" due to R Hughes. On the fractal side, the examples will hopefully convince you that fractals are not just cute pictures, but extremely important illustrations that the real numbers are weird. As usual, you can save this post to <code>Fractals.lhs</code> and compile it with <code>ghc --make Fractals</code>+ <a href="http://www.kennknowles.com/blog/2008/04/16/drawing-fractals-in-haskell-with-a-cursor-graphics-dsel-and-a-cute-list-representation/#more-42" class="more-link">(more&#8230;)</a></p></description>+ <pubDate>Wed, 16 Apr 2008 18:02:52 +0000</pubDate>+ <dc:creator>Kenn</dc:creator>+</item>+<item>+ <title>Luke Palmer: Symphonic Poem no. 1</title>+ <guid isPermalink="false">http://luqui.org/blog?p=517</guid>+ <link>http://luqui.org/blog/archives/2008/04/16/symphonic-poem-no-1/</link>+ <description><p>I just finished, in some sense, <a href="http://luqui.org/music/progress/symphonic_poems/01.mp3">the first</a> of a series (hopefully) of symphonic poems. I took a long break in the middle of writing this, so I could be mistaken, but I think it took about 20 hours total. It still needs a little tweaking; in particular some of the harmonies on the climaxes are drowned out by the percussion and poor instrument balancing, and I&#8217;m not sure if I&#8217;m happy with the ending (it&#8217;s meant to be a little unsettling&#8230;). But the idea is there.</p></description>+ <pubDate>Wed, 16 Apr 2008 11:21:47 +0000</pubDate>+ <dc:creator>Luke</dc:creator>+</item>+<item>+ <title>John Goerzen (CosmicRay): datapacker</title>+ <guid isPermalink="false">http://changelog.complete.org/posts/707-guid.html</guid>+ <link>http://changelog.complete.org/posts/707-datapacker.html</link>+ <description>Every so often, I come across some utility that need. I think it <b>must</b> have been written before, but I can't find it.<br />+<br />+Today I needed a tool to take a set of files and split them up into directories in a size that will fit on DVDs. I wanted a tool that could either produce the minimum number of DVDs, or keep the files in order. I couldn't find one. So I wrote <a href="http://software.complete.org/datapacker">datapacker</a>.<br />+<br />+datapacker is a tool to group files by size. It is perhaps most often used to fit a set of files onto the minimum number of CDs or DVDs.<br />+<br />+datapacker is designed to group files such that they fill fixed-size containers (called "bins") using the minimum number of containers. This is useful, for instance, if you want to archive a number of files to CD or DVD, and want to organize them such that you use the minimum possible number of CDs or DVDs.<br />+<br />+In many cases, datapacker executes almost instantaneously. Of particular note, the hardlink action can be used to effectively copy data into bins without having to actually copy the data at all.<br />+<br />+datapacker is a tool in the traditional Unix style; it can be used in pipes and call other tools.<br />+<br />+I have, of course, uploaded it to sid. But while it sits in NEW, you can download the source tarball (with debian/ directory) from the project homepage at <a href="http://software.complete.org/datapacker">http://software.complete.org/datapacker</a>. I've also got an <a href="http://software.complete.org/datapacker/static/doc/datapacker.html">HTML version of the manpage</a> online, so you can see all the cool features of datapacker. It works nicely with find, xargs, mkisofs, and any other Unixy pipe-friendly program.<br />+<br />+Those of you that know me will not be surprised that I wrote datapacker in Haskell. For this project, I added a <a href="http://en.wikipedia.org/wiki/Bin_packing_problem">bin-packing</a> module and support for parsing inputs like <tt>1.5g</tt> to <a href="http://software.complete.org/missingh">MissingH</a>. So everyone else that needs to do that sort of thing can now use library functions for it.<br />+<br />+<b>Update...</b> I should have mentioned the <b>really cool thing</b> about this. After datapacker compiled and ran, I had only <b>one mistake</b> that was not caught by the Haskell compiler: I said &lt; where I should have said &lt;= one place. This is one of the very nice things about Haskell: the language lends itself to compilers that can catch so much. It's not that I'm a perfect programmer, just that my compiler is pretty crafty.</description>+ <pubDate>Wed, 16 Apr 2008 04:09:53 +0000</pubDate>+ <dc:creator>nospam@example.com (John Goerzen)</dc:creator>+</item>+<item>+ <title>Nick Mudge: Inelegance of Combining HTML and Code</title>+ <guid isPermalink="false">http://nickmudge.info?post=92</guid>+ <link>http://nickmudge.info?post=92</link>+ <description><p>+I thought I’d shoot off an idea about programming webpages.+</p>+<p>+To me writing a script to generate HTML has always been a problem. It’s a problem because you have to mix a bunch of code with HTML. No matter how you mix more than a little bit of code and HTML the result is inelegance, ugly code, hard to read code. It’s not very good because you’re mixing two different syntaxes together in a jumbled fashion. Code that is just code without HTML in it so much nicer and easy to follow and read. And gosh, I’m always perturbed about how to indent code and HTML together so that structure and things can be made clearer. The elegance, clarity and structure provided by indentation is reduced a lot by the combination of programming logic and HTML intermingled, at least from my experience.+</p>+<p>+There’s been various ways to help make this better. For instance in PHP you can move in and out of HTML and PHP modes which makes the transitions nicer sometimes. The <a href="http://www.smarty.net/">Smarty templating system</a> is largely a system to make this easier. The Smarty language syntax and tools integrate nicer with HTML and help keep programming away from HTML. This also has a nice benefit of being nice to designers that need to work with HTML and CSS but don’t want to hassle with programming.+</p>+<p>+Smarty is a nice improvement and the best solution I’ve used so far but the problem is still there. Sometimes you want to add quite a bit of logic to your Smarty templates, adding loops, and inner loops, adding lots of if conditions, making function calls etc. You might want to do this because the display of the webpage you are making is complex and requires lots of if conditions and loops or because you want to reuse the same templates for different webpages (this cuts down the amount of work you need to do and manage – reuse is good) and so need to add additional logic that runs depending on which page the template is being used to generate. Too much logic in Smarty templates quickly gets inelegant and hard.+</p>+<p>+Things get inelegant and harder to follow when you start adding a bunch of logic to HTML pages. It’s like HTML wasn’t meant to have logic in it.+</p>+<p>+A related problem that is also a big problem with HTML is that it does not scale. The bigger an HTML file gets the harder it is to follow and work with. With a zillion div tags and table tags it gets harder and harder to know what exactly is happening anywhere in a document. It just doesn’t scale. This combined with logic makes for general ickyness. +</p>+<p>+I wonder if there is another way.+</p>+<p>+I’ve looked into Lisp a little in the past and what I’ve seen is that in Common Lisp the combination of programming and HTML are handled in a completely different way. I wonder if something here could be a real solution to this inelegance pest, and actually really bring about an elegance and smoothness in the combination of programming logic and HTML.+</p>+<p>+From what I've seen in Common Lisp when you program webpages you don’t really mix HTML and programming. Instead you make it all programming. I’m thinking it might be something along these lines: You have a library of functions and/or macors. Each function or macro or arguement corresponds to an HTML tag. For instance you have the div function that is used to generate the HTML for a div tag etc. You just use all these functions that generate all the HTML for you. And it’s easy and natural to add logic because it’s all consistent programming code. You keep the consistency, elegance and scalability of a programming language by only programming in the programming language.+</p>+<p>+The main problem I see with this approach of using functions to generate HTML is that HTML is highly flexible -- some tags can have certain attributes and can be nestled within some tags but not others and there’s a ton of variance and things you can do in HTML. In lots of programming languages I think functions are probably not flexible enough to cope with all the possibilities. I think these functions would limit what you could do with HTML and cut your flexibility of how you want the HTML to be. It really might not be very workable. I certainly don’t like to code with constraints on me.+</p>+<p>+But maybe it’s possible with something like Lisp. You’d need finely grained functions/macros that had the same flexibility and limitations as the HTML tags. And I think that’s something Lisp might be able to provide. In Lisp you have finely grained control on what your functions are and how they work – more than I’ve seen anywhere. In addition Lisp has powerful macro abilities that enable you to mold the syntax and semantics of the language to your will. This fine grainess of control on the syntax and semantics of the language might enable you to write a library of HTML functions that you could use to write pure elegant code that generates all the HTML you need and with as much flexibility as you need. Perhaps this already exists.+</p>+<p>+I think something like this would make it much easier and faster to work with webpages because pure well written code is much easier to write and read than a mess of HTML and code together. With code you have one consistent syntax and it scales better than HTML does. In addition if your functions are perfect (have no bugs in their implementation), then any HTML you generate with them should automatically be perfect too – that’s real scalability power when talking about HTML correctness.+</p>+<p>+Of course this pure programming way of handling HTML might not be so good for designers. So I was thinking that there could be some kind of separate interface for designers – like CSS is a separate interface into the display of HTML and a webpage. One idea is that a designer could design stuff in pure HTML and CSS and then feed it into a program that analyses it and if it is correct HTML and CSS generates or modifies the programming code to generate that HTML and CSS and if it is wrong spits the HTML and CSS back to the designer to fix.+</p>+<hr />+<p>+From Chris Minnick:+</p>+<p>+Good thoughts, Nick.+</p>+<p>+I see what you’re getting at, but I’m skeptical of solutions to make code or HTML more 'pure'. It seems like no matter what you do, someone is going to start slipping some HTML in where it doesn’t belong, or is going to put something that should be in the CSS into the HTML, or is going to use tables for layout, or what-have-you. Usually, people resist doing things the 'right' way because the right way is more difficult or doesn't work right.+</p>+<p>+CSS positioning is a perfect example: purists insist that all Web page layout should be done with divs and CSS, and that tables should only be used for tabular data. This makes perfect sense, of course, but the reality is that you just can’t do some of the things you can do with tables using divs, or it’s very difficult—especially considering browser differences. +</p>+<p>+So, what usually ends up happening as a result of this is that the people who were insisting on purity start backing off … so, now RSS 2.0 is popular, while the strict RDF version (RSS 1.1) was a big flop, and HTML 5 is going to be the successor to XHTML because people continued to use the much more flexible HTML 4.01 years and years after the stricter XHTML 1.0 came out.+</p>+<p>+My question is: would the benefits of writing HTML using functions outweigh the added complexity and inconvenience to people who design webpages?+</p>+<hr />+<p>+From Nick Mudge:+</p>+<p>+Hey Chris,+</p>+<p>+I totally agree and excellent point. Your email made me realize that ideally the functions should be flexible enough to allow people to be as non-standard and/or hacky as they want. I think people should have the freedom to do things how they want. I think the functions should prevent obvious errors like a &lt;div&gt; without a &lt;/div&gt; and things that will obviously break webpages in web browsers. It would be nice if it could also help people be as standard as they want by letting them set some global setting or something so that functions enforce more strictness to a standard or whatever they want.+</p>+<p>+I think the goal of a library like this would be to enable programmers to combine programming and HTML in way that is syntactically consistent, easier to read, write and maintain without loosing the flexibility that they want. Or to achieve a scalable elegance with the combination of logic and HTML. Perhaps a secondary goal would be to help people create HTML as correct or as standard/unstandard as they want.+</p>+<p>+Any system around the functions/macro library such as a program that translates HTML into code that generates the same HTML should be as flexible to the user as the functions.+</p>+<p>+I think a designer who does HTML and CSS work would use some program that does an HTML to code translation and the designer should have a way to specify how loose the translator is in accepting HTML and CSS. And I think programmers would just work in the code. +</p></description>+ <pubDate>Tue, 15 Apr 2008 00:00:00 +0000</pubDate>+</item>+<item>+ <title>Luke Palmer: SNW Backlogging</title>+ <guid isPermalink="false">http://luqui.org/blog?p=516</guid>+ <link>http://luqui.org/blog/archives/2008/04/14/snw-backlogging/</link>+ <description><p>SNW is dead <tt>:-(</tt>. But I still have some recordings lying around that I&#8217;m gradually editing. Here&#8217;s the first batch, from March 20:</p>+<ul>+ <li><a href="http://luqui.org/music/improv/2008-03-20_01.mp3">01</a></li>+ <li><a href="http://luqui.org/music/improv/2008-03-20_02.mp3">02</a> - a minimalist (in the classical sense) exercise</li>+ <li><a href="http://luqui.org/music/improv/2008-03-20_03.mp3">03</a></li>+ <li><a href="http://luqui.org/music/improv/2008-03-20_04.mp3">04</a> - fun and funky</li>+ <li><a href="http://luqui.org/music/improv/2008-03-20_05.mp3">05</a> - a long piece with many sections, pretty upbeat</li>+</ul>+<p>#01 and #03 are included for completeness; they suck <tt>:-p</tt>. The rest are pretty good.</p></description>+ <pubDate>Mon, 14 Apr 2008 21:28:13 +0000</pubDate>+ <dc:creator>Luke</dc:creator>+</item>+<item>+ <title>Conrad Parker: Continuation Fest 2008: Continuations for video decoding and scrubbing</title>+ <guid isPermalink="false">tag:blogger.com,1999:blog-9101292118679422945.post-8478267578838678327</guid>+ <link>http://blog.kfish.org/2008/04/continuation-fest-2008-continuations.html</link>+ <description><p>+Yesterday was <a href="http://logic.cs.tsukuba.ac.jp/Continuation/">Continuation Fest 2008</a>,+at the University of Tokyo's campus in Akihabara (a very nice venue!).+It was very well attended; latecomers overflowed to a second room and participated by video conference. It was a little strange to see so many people interested in such an+<strike>obscure, troublesome and malignant</strike> expressively powerful+programming construct; the breadth of talks made for a very inspiring and practical introduction to the theory, applications and implementation of continuations in many different languages.+</p>+<p>+I recommend reading+<a href="http://pllab.is.ocha.ac.jp/~asai/">Kenichi Asai</a>'s+introduction to delimited continuations+(<a href="http://pllab.is.ocha.ac.jp/~asai/papers/contfest08slide.pdf">slides</a> [PDF]).+He introduced the <tt>shift</tt> and <tt>reset</tt> operators+through the problem of expressing exceptional control flow, and+then explained how to use these to type (ie. determine a concrete type for)+<tt>printf</tt>. The main point was that+<tt>shift/reset</tt> provide a high-level abstraction over control flow, with minimal impact+on the implementation of your existing functions.+</p>+<p>+<a href="http://okmij.org/ftp/">Oleg Kiselyov</a> demonstrated some new code for transactional+web applications, using delimited continuations for explicit state sharing between parallel connections. The result is that the user has a consistent view across multiple tabs are open on the same site, and the state is transactional so that there is no need for warnings like "Do not press the BUY button more than once!". He said that everyone already understands delimited continuations, they just don't realize it.+</p>+<p>+The topic of my presentation at Continuation Fest was+<b>Continuations for video decoding and scrubbing</b>:+</p>+<blockquote><p>+Playback of encoded video involves scheduling the decoding of audio and video frames and synchronizing their playback. "Scrubbing" is the ability to quickly seek to and display an arbitrary frame, and is a common user interface requirement for a video editor. The implementation of playback and scrubbing is complicated by data dependencies in compressed video formats, which require setup and manipulation of decoder state.+</p><p>+We present the preliminary design of a continuation-based system for video decoding, reified as a cursor into a stream of decoded video frames. Frames are decoded lazily, and decoder states are recreated or restored when seeking. To reduce space requirements, a sequence of decoded frames can be replaced after use by the continuation which created them.+<strike>We outline implementations in Haskell and C.</strike>+</p></blockquote>+<p>+<ul>+<li><a href="http://seq.kfish.org/~conrad/static/continuation-fest-2008/continuations-for-video.pdf">Slides</a> [383KB PDF]</li>+<li><a href="http://seq.kfish.org/~conrad/static/continuation-fest-2008/continuations-for-video.article.pdf">Article</a> [215KB PDF]</li>+</ul>+</p>++<p>I'll be introducing the code for this over the next few months.+Whereas in my presentation about+<a href="http://blog.kfish.org/2008/03/bossa-2008-video-player-internals.html">video player internals</a> at BOSSA I outlined the problem space in designing a multimedia architecture,+at Continuation Fest I tried to break it down into subproblems and considered+useful data structures and programming techniques for dealing with them.+</p>+<p>+I got a lot of great feedback, and I think I succeeded in my mission to introduce this problem space to some really smart people.+Thanks particularly to+<a href="http://www.cs.rutgers.edu/~ccshan">Chung-chieh Shan</a> for some insightful ideas+about how to deal with existing stateful codec implementations. It was also very interesting to+talk with+<a href="http://www.ie.u-ryukyu.ac.jp/~kono/index-e.html">Shinji Kono</a> about+<a href="http://sourceforge.jp/projects/cbc/">Continuation-based C (cBc)</a>+(<a href="http://www.ie.u-ryukyu.ac.jp/~kono/tmp/cf08-kono.tgz">slides</a> [HTML tarball]),+a C-like language capable of expressing continuations, non-local jumps, multiple function entry-points, and assorted other ways to shoot yourself in the foot. He suggested that it was designed for exactly the kind of thing I'm doing, and I'll be interested to try it+out. It is implemented in a modifed GCC 4.x as an RTL code generator, so should now be (fairly)+architecture-independent.+</p>+<p>+Thanks to the organizers of Continuation Fest 2008 for putting together such a useful and interesting event. I look forward to implementing just some of the things I learned :-)+</p></description>+ <pubDate>Mon, 14 Apr 2008 18:10:56 +0000</pubDate>+ <dc:creator>Conrad Parker</dc:creator>+</item>+<item>+ <title>John Goerzen (CosmicRay): Backup Software</title>+ <guid isPermalink="false">http://changelog.complete.org/posts/706-guid.html</guid>+ <link>http://changelog.complete.org/posts/706-Backup-Software.html</link>+ <description><p>I think most people reading my blog would agree that backups are extremely important. So much important data is on computers these days: family photos, emails, financial records. So I take backups seriously.+</p><br />+<p>+A little while back, I purchased two identical 400GB external hard disks. One is kept at home, and the other at a safe deposit box in a bank in a different town. Every week or two, I swap drives, so that neither one ever becomes too dated. This process is relatively inexpensive (safe deposit boxes big enough to hold the drive go for $25/year), and works well.+</p><br />+<p>+I have been using <a href="http://www.nongnu.org/rdiff-backup/">rdiff-backup</a> to make these backups for several years now. (Since at least 2004, when I submitted a patch to make it record all metadata on MacOS X). rdiff-backup is quite nice. It is designed for storage to a hard disk. It stores on the disk a current filesystem mirror along with some metadata files that include permissions information. History is achieved by storing compressed rdiff (rsync) deltas going backwards in time. So restoring "most recent" files is a simple copy plus application of metadata, and restoring older files means reversing history. rdiff-backup does both automatically.+</p><br />+<p>+This is a nice system and has served me well for quite some time. But it has its drawbacks. One is that you always have to have the current image, uncompressed, which uses up lots of space. Another is that you can't encrypt these backups with something like gpg for storage on a potentially untrusted hosting service (say, rsync.net). Also, when your backup disk fills up, it takes forever to figure out what to delete, since rdiff-backup --list-increment-sizes must stat tens of thousands of files. So I went looking for alternatives.+</p><br />+<p>+The author of rdiff-backup actually wrote one, called <a href="http://duplicity.nongnu.org/">duplicity</a>. Duplicity works by, essentially, storing a tarball full backup with its rdiff signature, then storing tarballs of rdiff deltas going forward in time. The reason rdiff-backup must have the full mirror is that it must generate rdiff deltas "backwards", which requires the full prior file available. Duplicity works around this.+</p><br />+<p>+However, the problem with duplicity is that if the full backup gets lost or corrupted, nothing newer than it can be restored. You must make new full backups periodically so that you can remove the old history. The other big problem with duplicity is that it doesn't grok hard links at all. That makes it unsuitable for backing up /sbin, /bin, /usr, and my /home, in which I frequently use hard links for preparing CD images, linking DVCS branches, etc.+</p><br />+<p>+So I went off searching out other projects and thinking about the problem myself.+</p><br />+<p>+One potential solution is to simply store tarballs and rdiff deltas going forward. That would require performing an entire full backup every day, which probably isn't a problem for me now, but I worry about the load that will place on my hard disks and the additional power it would consume to process all that data.+</p><br />+<p>+So what other projects are out there? Two caught my attention. The first is <a href="http://www.boxbackup.org/">Box Backup</a>. It is similar in concept to rdiff-backup. It has its own archive format, and otherwise operates on a similar principle to rdiff-backup. It stores the most recent data in its archive format, compressed, along with the signatures for it. Then it generates reverse deltas similar to rdiff-backup. It supports encryption out of the box, too. It sounded like a perfect solution. Then I realized it <a href="http://lists.warhead.org.uk/pipermail/boxbackup/2008-April/004338.html">doesn't store hard links</a>, device entries, etc., and has a design flaw that causes it to miss some changes to config files in /etc on Gentoo. That's a real bummer, because it sounded so nice otherwise. But I just can't trust my system to a program where I have to be careful not to use certain OS features because they won't be backed up right.+</p><br />+<p>+The other interesting one is <a href="http://dar.linux.free.fr/">dar</a>, the Disk ARchive tool, described by its author as the great grandson of tar -- and a pretty legitimate claim at that. Traditionally, if you are going to back up a Unix box, you have to choose between two not-quite-perfect options. You could use something like tar, which backs up all your permissions, special files, hard links, etc, but doesn't support random access. So to extract just one file, tar will read through the 5GB before it in the archive. Or you could use zip, which doesn't handle all the special stuff, but does support random access. Over the years, many backup systems have improved upon this in various ways. Bacula, for instance, is incredibly fast for tapes as it creates new tape "files" every so often and stores the precise tape location of each file in its database.+</p><br />+<p>+But none seem quite as nice as dar for disk backups. In addition to supporting all the special stuff out there, dar sports built-in compression and encryption. Unlike tar, compression is applied per-file, and encryption is applied per 10K block, which is really slick. This allows you to extract one file without having to decrypt and decompress the entire archive. dar also maintains a catalog which permits random access, has built-in support for splitting archives across removable media like CD-Rs, has a nice incremental backup feature, and sports a host of tools for tweaking archives -- removing files from them, changing compression schemes, etc.+</p><br />+<p>+But dar does not use binary deltas. I thought this would be quite space-inefficient, so I decided I would put it to the test, against a real-world scenario that would probably be pretty much a worst case scenario for it and a best case for rdiff-backup.+</p><br />+<p>+I track Debian sid and haven't updated my home box in quite some time. I have over 1GB of .debs downloaded which represent updates. Many of these updates are going to touch tons of files in /usr, though often making small changes, or even none at all. Sounds like rdiff-backup heaven, right?+</p><br />+<p>+I ran rdiff-backup to a clean area before applying any updates, and used dar to create a full backup file of the same data. Then I ran apt-get upgrade, and made incrementals with both rdiff-backup and dar. Finally I ran apt-get dist-upgrade, and did the same thing. So I have three backups with each system.+</p><br />+<p>+Let's look at how rdiff-backup did first.+</p><br />+<p>+According to rdiff-backup --list-increment-sizes, my /usr backup looks like this:+</p><br />+<pre>+ Time Size Cumulative size+-----------------------------------------------------------------------------+Sun Apr 13 18:37:56 2008 5.15 GB 5.15 GB (current mirror)+Sun Apr 13 08:51:30 2008 405 MB 5.54 GB+Sun Apr 13 03:08:07 2008 471 MB 6.00 GB+</pre><br />++<p>+So what we see here is that we're using 5.15GB for the mirror of the current state of /usr. The delta between the old state of /usr and the state after apt-get upgrade was 471MB, and the delta representing dist-upgrade was 405MB, for total disk consumption of 6GB.+</p><br />+<p>+But if I run du -s over the /usr storage area in rdiff, it says that 7.0GB was used. du -s --apparent-size shows 6.1GB. The difference is that all the tens of thousands of files each waste some space at the end of their blocks, and that adds up to an entire gigabyte. rdiff-backup effectively consumed 7.0GB of space.+</p><br />+<p>+Now, for dar:+</p><br />+<pre>+-rw-r--r-- 1 root root 2.3G Apr 12 22:47 usr-l00.1.dar+-rw-r--r-- 1 root root 826M Apr 13 11:34 usr-l01.1.dar+-rw-r--r-- 1 root root 411M Apr 13 19:05 usr-l02.1.dar+</pre><br />+<p>+This was using bzip2 compression, and backed up the exact same files and data that rdiff-backup did. The initial mirror was 2.3GB, much smaller than the 5.1GB that rdiff-backup consumes. The apt-get upgrade differential was 826MB compared to the 471MB in rdiff-backup -- not really a surprise. But the dist-upgrade differential -- still a pathologically bad case for dar, but less so -- was only 6MB larger than the 405MB rdiff-backup case. And the total actual disk consumption of dar was only 3.5GB -- half the 7.0GB rdiff-backup claimed!+</p><br />+<p>+I still expect that, over an extended time, rdiff-backup could chip away at dar's lead... or maybe not, if lots of small files change.+</p><br />+<p>+But this was a completely unexpected result. I am definitely going to give dar a closer look.+</p><br />+<p>+Also, before I started all this, I converted my external hard disk from ext3 to XFS because of ext3's terrible performance with rdiff-backup.+</p></description>+ <pubDate>Mon, 14 Apr 2008 00:35:00 +0000</pubDate>+ <dc:creator>nospam@example.com (John Goerzen)</dc:creator>+</item>+<item>+ <title>"FP Lunch": The shortest beta-normalizer</title>+ <guid isPermalink="false">http://sneezy.cs.nott.ac.uk/fplunch/weblog/?p=95</guid>+ <link>http://sneezy.cs.nott.ac.uk/fplunch/weblog/?p=95</link>+ <description><p>I presented the shortest implementation of a normalizer for beta equality for untyped lambda calculus which is based on Normalisation by Evaluation. </p>+<p>We start with the definition of lambda terms using de Bruijn levels:<br />+<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/6b2c3e05c957460fa08ae20bdfeb1753.png" title="&#10;\begin{code}&#10;data T = Var Int | Lam T | App T T deriving Show&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;data T = Var Int | Lam T | App T T deriving Show&#10;\end{code}&#10;" /></p>+<p>The reason for using de Bruijn levels is that weakening comes for free. The other side of the coin is that one has to reindex bound variables when substituting. However, this is not an issue because we never do that.</p>+<p>We define values by solving a negative domain equation:<br />+<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/8025c23de1c08f7c265a350cb637a688.png" title="&#10;\begin{code}&#10;data V = Fun (V -&gt; V)&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;data V = Fun (V -&gt; V)&#10;\end{code}&#10;" /></p>+<p>It is easy to define application:<br />+<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/4c3e28203bdc418b9bb3483ee2e3f79d.png" title="&#10;\begin{code}&#10;app :: V -&gt; V -&gt; V&#10;app (Fun f) v = f v&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;app :: V -&gt; V -&gt; V&#10;app (Fun f) v = f v&#10;\end{code}&#10;" /></p>+<p>We can evaluate lambda terms in the Value domain using a list of values as the environment:<br />+<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/2e59405e96890b4c97292547d66c775d.png" title="&#10;\begin{code}&#10;eval :: T -&gt; [V] -&gt; V&#10;eval (Var x) e = e !! x&#10;eval (Lam t) e = Fun (\ v -&gt; eval t (e++[v]))&#10;eval (App t u) e = app (eval t e) (eval u e)&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;eval :: T -&gt; [V] -&gt; V&#10;eval (Var x) e = e !! x&#10;eval (Lam t) e = Fun (\ v -&gt; eval t (e++[v]))&#10;eval (App t u) e = app (eval t e) (eval u e)&#10;\end{code}&#10;" /></p>+<p>All we have to do now is to invert evaluation, i.e. to define a function<br />+<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/5742dab51f5ea1b7a4673a4a7ef21e5e.png" title="&#10;\begin{code}&#10;quote :: V -&gt; T&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;quote :: V -&gt; T&#10;\end{code}&#10;" /></p>+<p>To be able to do this we have first to extend values with variables. Then to be able to extend app, we also have to represent stuck applications, or neutral values:<br />+<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/232e1b86c01bdb2e1330d22055bbace9.png" title="&#10;\begin{code}&#10;data V = Fun (V -&gt; V) | NVar Int | NApp V V&#10;&#10;app :: V -&gt; V -&gt; V&#10;app (Fun f) v = f v&#10;app n v = NApp n v&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;data V = Fun (V -&gt; V) | NVar Int | NApp V V&#10;&#10;app :: V -&gt; V -&gt; V&#10;app (Fun f) v = f v&#10;app n v = NApp n v&#10;\end{code}&#10;" /><br />+The code for eval remains unchanged. Now we can implement quote, though we need an extra parameter to keep track of the free variables:<br />+<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/4d9eaf056742b7d605ac1ad380045eee.png" title="&#10;\begin{code}&#10;quote :: Int -&gt; V -&gt; T&#10;quote x (Fun f) = Lam (quote (x+1) (f (NVar x)))&#10;quote x (NVar y) = Var y&#10;quote x (NApp n v) = App (quote x n) (quote x v)&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;quote :: Int -&gt; V -&gt; T&#10;quote x (Fun f) = Lam (quote (x+1) (f (NVar x)))&#10;quote x (NVar y) = Var y&#10;quote x (NApp n v) = App (quote x n) (quote x v)&#10;\end{code}&#10;" /><br />+Now nf just evaluates and quotes the result:<br />+<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/36c4c25141994c1cf3af73da66418a49.png" title="&#10;\begin{code}&#10;nf :: T -&gt; T&#10;nf t = quote 0 (eval t [])&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;nf :: T -&gt; T&#10;nf t = quote 0 (eval t [])&#10;\end{code}&#10;" /></p>+<p>We discussed how to verify such a normalisation function - I suggested to use the partiality monad.</p></description>+ <pubDate>Sun, 13 Apr 2008 08:16:37 +0000</pubDate>+ <dc:creator>Thorsten</dc:creator>+</item>+<item>+ <title>Ulisses Costa: Lexical Analysis - Wikipedia</title>+ <guid isPermalink="false">http://caos.di.uminho.pt/~ulisses/blog/2008/04/13/lexical-analysis-wikipedia/</guid>+ <link>http://caos.di.uminho.pt/~ulisses/blog/2008/04/13/lexical-analysis-wikipedia/</link>+ <description><h2 id="58_intro_1">Intro</h2>+<p>This year I started to learn processing languages. I started by regular expressions and past few days I began to study the <a href="http://flex.sourceforge.net/">Flex</a>, as with regular expressions we can&#8217;t create text filters.<br />+The first job I did was a kind of a dictionary. Getting a source of words and a faithful translation, add all the information in one document.</p>+<p>The problem was finding a good document with many Portuguese words and their translations into English.</p>+<p>With this post I want to teach what I learned from this work.</p>+<h2 id="58_wikipedia-xml-struct_1">Wikipedia XML structure</h2>+<p>I started by picking up the last dump of Wikipedia-PT and &#8220;decipher&#8221; the XML where it is stored. The structure is something like that:</p>++<div class="wp_syntax"><div class="code"><pre class="xml"><span><span>&lt;page<span>&gt;</span></span></span>+ ...+<span><span>&lt;/page<span>&gt;</span></span></span>+<span><span>&lt;page<span>&gt;</span></span></span>+ ...+<span><span>&lt;/page<span>&gt;</span></span></span></pre></div></div>++<p>And each <strong>page</strong> tag, expanded, have this structure:</p>++<div class="wp_syntax"><div class="code"><pre class="xml"><span><span>&lt;page<span>&gt;</span></span></span>+ <span><span>&lt;title<span>&gt;</span></span></span>TITLE<span><span>&lt;/title<span>&gt;</span></span></span>+ <span><span>&lt;id<span>&gt;</span></span></span>PAGE_ID_NUMBER<span><span>&lt;/id<span>&gt;</span></span></span>+ <span><span>&lt;revision<span>&gt;</span></span></span>+ <span><span>&lt;id<span>&gt;</span></span></span>ID_REVISION_NUMBER<span><span>&lt;/id<span>&gt;</span></span></span>+ <span><span>&lt;timestamp<span>&gt;</span></span></span>TIMESTAMP<span><span>&lt;/timestamp<span>&gt;</span></span></span>+ <span><span>&lt;contributor<span>&gt;</span></span></span>+ <span><span>&lt;username<span>&gt;</span></span></span>USERNAME<span><span>&lt;/username<span>&gt;</span></span></span>+ <span><span>&lt;id<span>&gt;</span></span></span>ID_CONTRIBUTOR<span><span>&lt;/id<span>&gt;</span></span></span>+ <span><span>&lt;/contributor<span>&gt;</span></span></span>+ <span><span>&lt;comment<span>&gt;</span></span></span>COMMENT<span><span>&lt;/comment<span>&gt;</span></span></span>+ <span><span>&lt;text</span> <span>xml:space</span>=<span>&quot;preserve&quot;</span><span>&gt;</span></span>WIKIPEDIA_ENTRY<span><span>&lt;/text<span>&gt;</span></span></span>+ <span><span>&lt;/revision<span>&gt;</span></span></span>+ <span><span>&lt;/page<span>&gt;</span></span></span></pre></div></div>++<p>So, here we have the variables: TITLE, PAGE_ID_NUMBER, ID_REVISION_NUMBER, TIMESTAMP, USERNAME, ID_CONTRIBUTOR, COMMENT and WIKIPEDIA_ENTRY.</p>+<p>TITLE is the Portuguese word, because the Wikipedia I&#8217;ve downloaded is in Portuguese.<br />+But so far, no English word.</p>+<p>Lets expand WIKIPEDIA_ENTRY:</p>++<div class="wp_syntax"><div class="code"><pre class="xml"><span><span>&lt;text</span> <span>xml:space</span>=<span>&quot;preserve&quot;</span><span>&gt;</span></span>+ ...+ [[categoria:CATEGORY]]+ ...+ [[en:ENGLISH]]+ ...+<span><span>&lt;/text<span>&gt;</span></span></span></pre></div></div>++<p>Here we have the ENGLISH variable that is the corresponding word in English to TITLE. I also want the CATEGORY variable that indicates from what category this entry belong.</p>+<p>As some entries in the Wikipedia have multiple categories lines I am also interested in keep them all.<br />+I want that the output of my program became something like that:</p>+<pre>+PT - TITLE1+EN - ENGLISH1+Categoria - CATEGORY11+ CATEGORY12+ ...+ CATEGORY1j+...+PT - TITLEi+EN - ENGLISHi+Categoria - CATEGORYi1+ CATEGORYi2+ ...+ CATEGORYij+...</pre>+<p>Some entries in the Portuguese Wikipedia do not have the English correspondent version so I will not want those entries.</p>+<h2 id="58_lexing_1"><em>Lexing</em></h2>+<p>A Lex file have this aspect:</p>+<pre>+definitions+%%+rules+%%+user code+</pre>+<p>Let&#8217;s focus in <strong>rules</strong> part:</p>+<p>Rules have the following structure;</p>+<pre>+%%+REGEX code+REGEX code+%%+</pre>+<p>I know Regular Expressions (REGEX) now, so let&#8217;s start to build that thing!</p>+<p>I got me to realize that the part of the TITLE may have not only the entries name, also has the Wikipedia contributors pages, among other things that do not interest me to save.<br />+I start to do a list of all those pages:<br />+{Wikipedia,Usuário,Discussão,Ajuda,Anexo,MediaWiki,Categoria}</p>+<p>So, I have to, somehow, throw away all the pages with the following structure:</p>++<div class="wp_syntax"><div class="code"><pre class="xml"> <span><span>&lt;page<span>&gt;</span></span></span>+ <span><span>&lt;title<span>&gt;</span></span></span>[&quot;Wikipedia&quot;&quot;Usuario&quot;&quot;Discussao&quot;&quot;Ajuda&quot;&quot;Anexo&quot;&quot;MediaWiki&quot;&quot;Categoria&quot;]:TITLE<span><span>&lt;/title<span>&gt;</span></span></span>+ <span><span>&lt;id<span>&gt;</span></span></span>ID_PAGE<span><span>&lt;/id<span>&gt;</span></span></span>+ <span><span>&lt;revision<span>&gt;</span></span></span>+ <span><span>&lt;id<span>&gt;</span></span></span>ID_REVISION<span><span>&lt;/id<span>&gt;</span></span></span>+ <span><span>&lt;timestamp<span>&gt;</span></span></span>TIMESTAMP<span><span>&lt;/timestamp<span>&gt;</span></span></span>+ <span><span>&lt;contributor<span>&gt;</span></span></span>+ <span><span>&lt;username<span>&gt;</span></span></span>USERNAME<span><span>&lt;/username<span>&gt;</span></span></span>+ <span><span>&lt;id<span>&gt;</span></span></span>ID_CONTRIBUTOR<span><span>&lt;/id<span>&gt;</span></span></span>+ <span><span>&lt;/contributor<span>&gt;</span></span></span>+ <span><span>&lt;comment<span>&gt;</span></span></span>COMMENT<span><span>&lt;/comment<span>&gt;</span></span></span>+ <span><span>&lt;text</span> <span>xml:space</span>=<span>&quot;preserve&quot;</span><span>&gt;</span></span>ENTRY<span><span>&lt;/text<span>&gt;</span></span></span>+ <span><span>&lt;/revision<span>&gt;</span></span></span>+ <span><span>&lt;/page<span>&gt;</span></span></span></pre></div></div>++<p>After a dozen of lines I start to understand that I have to some how &#8220;explain&#8221; Lex the structure of the Wikipedia XML file. That way will be easier.</p>+<p>I start to read the <a href="http://flex.sourceforge.net/manual/">Flex manual</a> and I find the <a href="http://flex.sourceforge.net/manual/Start-Conditions.html#Start-Conditions">Start Conditions</a>, a very clever way to treat a block of information.</p>+<p>Languages like C, HTML and XML are structured by blocks, so Start Conditions may be the way to easily get the information from those.</p>+<h2 id="58_start-conditions_1">Start Conditions</h2>+<p>If you have a block of code that have this aspect:</p>++<div class="wp_syntax"><div class="code"><pre class="xml"><span><span>&lt;title<span>&gt;</span></span></span>TITLE<span><span>&lt;/title<span>&gt;</span></span></span></pre></div></div>++<p>Our block start with &#8220;&#8221; string.</p>+<p>So in Lex, we must use Start Conditions and produce the following code:</p>++<div class="wp_syntax"><div class="code"><pre class="c">%x title_sc+anything .|<span>&#91;</span>\n\t\r<span>&#93;</span>+%%+<span>&quot;&lt;title&gt;&quot;</span> BEGIN<span>&#40;</span>title_sc<span>&#41;</span>;+&lt;title_sc&gt;<span>&#91;</span>^&gt;<span>&#93;</span>+ <span>&#123;</span><span>printf</span><span>&#40;</span><span>&quot;title=%s<span>\n</span>&quot;</span>,yytext<span>&#41;</span>;<span>&#125;</span>+&lt;title_sc&gt;<span>&quot;&lt;/title&gt;&quot;</span> BEGIN<span>&#40;</span>INITIAL<span>&#41;</span>;+<span>&#123;</span>anything<span>&#125;</span> <span>&#123;</span>;<span>&#125;</span> <span>/* do nothing*/</span>+%%+main<span>&#40;</span><span>&#41;</span> <span>&#123;</span>+ yylex<span>&#40;</span><span>&#41;</span>;+<span>&#125;</span></pre></div></div>++<p>The <code>%x title_sc</code> declaration is to declare a state exclusive, that means; while we are inside <code>code_sc</code> Flex won&#8217;t look rules outside of that, until <code>BEGIN(INITAIL)</code>.</p>+<p>In <strong>definitions</strong> part we can declare variables <code>anything .|[\n\t\r]</code> to use in <strong>rules</strong> part as <code>{anything}</code>.</p>+<p>The <code>BEGIN(title_sc)</code> statement makes Lex jump to the first line of rule and it start to match the rules that finds there.</p>+<p>We can rewrite the above code like that:</p>++<div class="wp_syntax"><div class="code"><pre class="c">%x title_sc+anything .|<span>&#91;</span>\n\t\r<span>&#93;</span>+%%+<span>&quot;&lt;title&gt;&quot;</span> BEGIN<span>&#40;</span>title_sc<span>&#41;</span>;+&lt;title_sc&gt;<span>&#123;</span>+ <span>&#91;</span>^&gt;<span>&#93;</span>+ <span>&#123;</span><span>printf</span><span>&#40;</span><span>&quot;title=%s<span>\n</span>&quot;</span>,yytext<span>&#41;</span>;<span>&#125;</span>+ <span>&quot;&lt;/title&gt;&quot;</span> BEGIN<span>&#40;</span>INITIAL<span>&#41;</span>;+<span>&#125;</span>+<span>&#123;</span>anything<span>&#125;</span> <span>&#123;</span>;<span>&#125;</span> <span>/* do nothing*/</span>+%%+main<span>&#40;</span><span>&#41;</span> <span>&#123;</span>+ yylex<span>&#40;</span><span>&#41;</span>;+<span>&#125;</span></pre></div></div>++<p>When Lex find <code>BEGIN(INITIAL)</code> statement it jumps to the first <code>BEGIN(XXX)</code>, so we can never be able to use block&#8217;s inside other block&#8217;s (like XML does).</p>+<p>Of course that&#8217;s not true.</p>+<h2 id="58_start-conditions-ins_1">Start Conditions inside Start Conditions</h2>+<p>Lex have a brilliant way to deal with that. It uses Stack&#8217;s to store the state were we are!</p>+<p>The idea is something like that, imagine a mathematical expression:</p>+<p><img src="http://caos.di.uminho.pt/~ulisses/blog/wp-content/latex/87e/87e6b04da406d2885e69188f49514a2b-FFFFFF000000.png" alt="(1+2)-(3*(4/5))" title="(1+2)-(3*(4/5))" class="latex" /></p>+<p>I can say:</p>+<ul>+<li>2 or [1,2]</li>+<li>3 or [2,1]</li>+<li>5 or [2,2,2]</li>+<li>and so on&#8230;</li>+</ul>+<p>That&#8217;s all about keeping the path, our actual position in the tree.</p>+<p>So, now we replace the <code>BEGIN(state)</code> to <code>yy_push_state(state)</code>, and to go to the previously block I say <code>yy_pop_state()</code>.</p>+<p>With that now I can read structures like that one:</p>++<div class="wp_syntax"><div class="code"><pre class="xml"> <span><span>&lt;page<span>&gt;</span></span></span>+ <span><span>&lt;title<span>&gt;</span></span></span>TITLE<span><span>&lt;/title<span>&gt;</span></span></span>+ ...+ <span><span>&lt;text</span> <span>xml:space</span>=<span>&quot;preserve&quot;</span><span>&gt;</span></span>+ ...+ [[Categoria:CATEGORY]]+ ...+ [[en:ENGLISH]]+ ...+ <span><span>&lt;/text<span>&gt;</span></span></span>+ <span><span>&lt;/page<span>&gt;</span></span></span></pre></div></div>++<p>And to do so, I write that Lex code:</p>++<div class="wp_syntax"><div class="code"><pre class="c">%x PAGE TITLE TEXT CATEGORIA EN+%option stack+anything .|<span>&#91;</span>\n\t\r<span>&#93;</span>+notPage <span>&#91;</span><span>&quot;Wikipedia&quot;</span><span>&quot;Usuário&quot;</span><span>&quot;Discussão&quot;</span><span>&quot;Ajuda&quot;</span><span>&quot;Anexo&quot;</span><span>&quot;MediaWiki&quot;</span><span>&quot;Categoria&quot;</span><span>&#93;</span>+%%+<span>&quot;&lt;page&gt;&quot;</span> yy_push_state<span>&#40;</span>PAGE<span>&#41;</span>;+&lt;PAGE&gt;<span>&#123;</span>+ <span>&quot;&lt;title&gt;&quot;</span><span>&#123;</span>notPagina<span>&#125;</span> yy_pop_state<span>&#40;</span><span>&#41;</span>; <span>// not a valid page</span>+ <span>&quot;&lt;title&gt;&quot;</span> yy_push_state<span>&#40;</span>TITLE<span>&#41;</span>;+ <span>&quot;&lt;text&quot;</span><span>&#91;</span>^&gt;<span>&#93;</span>+<span>&quot;&gt;&quot;</span> yy_push_state<span>&#40;</span>TEXT<span>&#41;</span>;+ <span>&quot;&lt;/page&gt;&quot;</span> yy_pop_state<span>&#40;</span><span>&#41;</span>;+ <span>&#123;</span>anything<span>&#125;</span> <span>/* do nothing */</span>+<span>&#125;</span>+&nbsp;+&lt;TEXT&gt;<span>&#123;</span>+ <span>&quot;[[&quot;</span><span>&#91;</span>cC<span>&#93;</span><span>&quot;ategoria:&quot;</span> yy_push_state<span>&#40;</span>CATEGORIA<span>&#41;</span>;+ <span>&quot;[[en:&quot;</span> yy_push_state<span>&#40;</span>EN<span>&#41;</span>;+ <span>&quot;&lt;/text&gt;&quot;</span> yy_pop_state<span>&#40;</span><span>&#41;</span>;+ <span>&#123;</span>anything<span>&#125;</span> <span>/* do nothing */</span>+<span>&#125;</span>+&nbsp;+&lt;TITLE&gt;<span>&#123;</span>+ <span>&#91;</span>^&lt;<span>&#93;</span>+ <span>&#123;</span>+ i=<span>0</span>;+ imprime<span>&#40;</span>cat, pt, en<span>&#41;</span>;+ limpa<span>&#40;</span>cat<span>&#41;</span>;+ pt=<span>NULL</span>; en=<span>NULL</span>;+ pt=strdup<span>&#40;</span>yytext<span>&#41;</span>;+ <span>&#125;</span>+ <span>&quot;&lt;/title&gt;&quot;</span> yy_pop_state<span>&#40;</span><span>&#41;</span>;+ <span>&#123;</span>anything<span>&#125;</span> <span>/* do nothing */</span>+<span>&#125;</span>+&nbsp;+&lt;EN&gt;<span>&#123;</span>+ <span>&#91;</span>^\<span>&#93;</span><span>&#93;</span>+ en=strdup<span>&#40;</span>yytext<span>&#41;</span>;+ <span>&#91;</span>\<span>&#93;</span><span>&#93;</span>+ yy_pop_state<span>&#40;</span><span>&#41;</span>;+ <span>&quot;]&quot;</span>\n<span>&#123;</span>anything<span>&#125;</span> <span>/* do nothing */</span>+<span>&#125;</span>+&nbsp;+&lt;CATEGORIA&gt;<span>&#123;</span>+ <span>&#91;</span> \<span>#\!\*\|]+ yy_pop_state();</span>+ <span>&#91;</span>^\<span>&#93;</span>\|\n<span>&#93;</span>+ <span>&#123;</span>+ cat<span>&#91;</span>i<span>&#93;</span>=strdup<span>&#40;</span>yytext<span>&#41;</span>;+ i++;+ <span>&#125;</span>+ <span>&#91;</span>\<span>&#93;</span><span>&#93;</span>+ yy_pop_state<span>&#40;</span><span>&#41;</span>;+ <span>&quot;]&quot;</span>\n<span>&#123;</span>anything<span>&#125;</span> <span>/* do nothing */</span>+<span>&#125;</span>+<span>&#123;</span>anything<span>&#125;</span> <span>/* do nothing */</span>+%%+<span>int</span> main<span>&#40;</span><span>&#41;</span> <span>&#123;</span>+ yylex<span>&#40;</span><span>&#41;</span>;+ <span>return</span> <span>0</span>;+<span>&#125;</span></pre></div></div>++<p>As you can see we are all the time matching a rule that makes lex jump to another state until one terminal rule (in this case variables affectations) or until pop.</p>+<p>To see all the code <a href="http://caos.di.uminho.pt/~ulisses/code/pl/trab1/trab.lex">go here</a>(.lex).</p>+<p>If you understand Portuguese and feel interested in more information you can <a href="http://caos.di.uminho.pt/~ulisses/code/pl/trab1/rel/online/index.html">go here</a>(.html).</p>+<h3 id="58_references_1">References</h3>+<p><a href="http://flex.sourceforge.net/">flex: The Fast Lexical Analyzer</a></p>+ <span class="post2pdf_span"><a href="http://caos.di.uminho.pt/~ulisses/blog/wp-content/plugins/post2pdf/generate.php?post=58" rel="nofollow"><img src="http://caos.di.uminho.pt/~ulisses/blog/wp-content/plugins/post2pdf/icon/pdf.png" width="16px" height="16px" />convert this post to pdf.</a></span></description>+ <pubDate>Sun, 13 Apr 2008 06:50:50 +0000</pubDate>+ <dc:creator>ulisses</dc:creator>+</item>+<item>+ <title>David R. MacIver: Blog move</title>+ <guid isPermalink="false">tag:blogger.com,1999:blog-2789077809400086800.post-2114636340936909669</guid>+ <link>http://unenterprise.blogspot.com/2008/04/blog-move.html</link>+ <description><p>Well, I've been meaning to set up a site of my own for ages. I finally got around to it. I can now be found at <a href="http://www.drmaciver.com/">http://www.drmaciver.com</a>/ </p>++<p>This blog will be moving to the "programming" category there. I'll update the various aggregator sites that have it on to point there instead.</p></description>+ <pubDate>Sun, 13 Apr 2008 06:50:09 +0000</pubDate>+ <dc:creator>David R. MacIver</dc:creator>+</item>+<item>+ <title>Nick Mudge: A New Operating System</title>+ <guid isPermalink="false">http://nickmudge.info?post=91</guid>+ <link>http://nickmudge.info?post=91</link>+ <description><p>+I've decided to attempt to write an operating system.+</p>+<p>+Basically I want to be able to understand a whole system as much as I can and I want to make it as easy as possible for others to understand it as well. This is the main reason I want to write an operating system.+</p>+<p>+The reason I'm not just studying an existing operating system like <a href="http://www.kernel.org/">Linux</a> or <a href="http://www.minix3.org/">Minix</a> or <a href="http://mikeos.berlios.de/">MikeOS</a> is because I think I will understand a system better if I write it myself and it seems more fun to me. I am of course studying those operating systems to learn to write my own.+</p>+<p>+<strong>Goals and Guides</strong>+</p>+<p>+The design of the system is pretty loose so far but I do have some general guides and goals for the system.+</p>+<ol>+<li> +Designed to explicitly take advantage of 64 bit processors.+</li>+<li>+Designed to explicitly take advantage of multi-core or multi-cpu processors.+</li>+<li>+Designed to take advantage of and provide virtualization i.e. operating system virtualization etc.+</li>+<li>+It's a server operating system. Not designed to be a desktop operating system or anything else.+</li>+<li>+It needs to be designed so that the system can be understood as easily as possible. It must be simple. The code base must be as small as possible.+</li>+<li>+It must be good.+</li>+</ol>+<p>+I'm not sure if the kernel will be a microkernel or monolithic or something else. +</p></description>+ <pubDate>Sun, 13 Apr 2008 00:00:00 +0000</pubDate>+</item>+<item>+ <title>Dan Piponi (sigfpe): Negative Probabilities</title>+ <guid isPermalink="false">tag:blogger.com,1999:blog-11295132.post-5498552306554187806</guid>+ <link>http://sigfpe.blogspot.com/2008/04/negative-probabilities.html</link>+ <description>I'm always interested in new ways to present the ideas of quantum mechanics to a wider audience. Unfortunately the conventional description of quantum mechanics requires knowledge of complex numbers and vector spaces making it difficult to avoid falling back on misleading analogies and metaphors. But there's another approach to quantum mechanics, due to Feynman, that I have never seen mentioned in the popular science literature. It assumes only basic knowledge of <a href="http://simple.wikipedia.org/wiki/Probability">probability theory</a> and <a href="http://simple.wikipedia.org/wiki/Negative_number">negative numbers</a> to get a foot on the ladder.<br /><br />We start with tweaking probability theory a bit. One of the axioms of probability theory says that all probabilities must lie in the range zero to one. However, we could imagine relaxing this rule even though on the face of it it seems meaningless. For example, suppose we have a coin that has a 3/2 chance of landing heads and a -1/2 chance of landing tails. We can still reason that the chance of getting two heads in a row is 3/2&times;3/2=9/4 by the usual multiplication rule. But obviously no situation like this could ever arise in the real world because after tossing such a coin 10 times we'd expect to see -5 tails on average.<br /><br />But what if we could contrive a system with some kind of internal state governed by negative probabilities even though we couldn't observe it directly? So consider this case: a machine produces boxes with (ordererd) pairs of bits in them, each bit viewable through its own door. Let's suppose the probability of each possible combination of two bits is given by the following table:<br /><table><br /><tr><td>First bit</td><td>Second bit</td><td>Probability</td></tr><br /><tr><td>0</td><td>0</td><td>-1/2</td></tr><br /><tr><td>0</td><td>1</td><td>1/2</td></tr><br /><tr><td>1</td><td>0</td><td>1/2</td></tr><br /><tr><td>1</td><td>1</td><td>1/2</td></tr><br /></table><br />Obviously if we were able to look through both doors we'd end up with the meaningless prediction that we'd expect to see 00 a negative number of times. But suppose that things are arranged so that we can only look through one door. Maybe the boxes self-destruct if one or other door is opened but you still get enough time to see what was behind the door. Now what happens?<br /><br />If you look through the first door the probability of seeing 1 is P(10)+P(11)=1. We get the same result if we look through the second door. We only get probabilities in the range zero to one. As long as we're restricted to one door we get meaningful results.<br /><br />If we were to perform this experiment repeatedly with different runs of the machine, each time picking a random door to look through, we'd eventually become very confident that every box contained 11. After all, if we freely choose which door to look through, and we always see 1, there's no place 0's could be 'hiding'.<br /><br />But now suppose a new feature is added to the box that allows us to compare the two bits to see if they are equal. It reveals nothing about what the bits are, just their state of equality. And of course, after telling us, it self-destructs. We now find that the probability of the two bits being different is P(01)+P(10)=1. So if we randomly chose one of the three possible observations each time the machine produced the box we'd quickly run into the strange situation that the two bits both appear to be 1, and yet are different. But note that although the situation is weird, it's not meaningless. As long as we never get to see both bits at the same time we never directly observe a paradox. If we met such boxes in the real world we'd be forced to conclude that maybe the boxes knew which bit you were going to look at and changed value as a result, or that maybe you didn't have the free will to choose door that you thought you had, or maybe, even more radically, you'd conclude that the bits generated by the machine were described by negative probabilities.<br /><br />That's all very well, but obviously the world doesn't really work like this and we never see boxes like this. Except that actually it does! The <a href="http://en.wikipedia.org/wiki/EPR_Paradox">EPR</a> experiment has many similarities to the scenario I described above. The numbers aren't quite the same, and we're not talking about bits in boxes, but we do end up with a scenario involving observations of bits that simply don't add up. If we do try to explain what's going on using probability theory, we either conclude there's something weird about our assumptions of locality or causality or we end up assigning negative probabilities to the internal states of our systems. In fact, you can read the details in an article by <a href="http://www.drchinese.com/David/Bell_Theorem_Negative_Probabilities.htm">David Schneider</a>. Being forced to conclude that we have negative probabilities in a physical system is usually taken as a sign that we have a contradiction. In the case of <a href="http://en.wikipedia.org/wiki/Bell's_theorem">Bell's theorem</a> it shows that we can't interpret what we see in terms of probability theory and hence that the weirdness of quantum mechanics can't be explained in terms of some hidden random variable that we can't see. QM simply doesn't obey the rules you'd expect of hidden variables we can't see.<br /><br />But in a paper called <a href="http://en.wikipedia.org/wiki/Negative_probability">Negative Probability</a>, Feynman tried taking the idea of negative probabilities seriously. He showed that you could reformulate quantum mechanics completely in terms of them so that you no longer needed to think in terms of the complex number valued 'amplitudes' that physicists normally use. This means the above isn't just an analogy, it's actually a formal system within which you can do QM, although I haven't touched on the bit that refers to the dynamics of quantum systems. So if you can get your head around the ideas I've talked about above you're well on your way to understanding some reasons why quantum mechanics seems so paradoxical.<br /><br />At this point you may be wondering how nature contrives to hide these negative probabilities from direct observation. Her trick is that making one kind of observation disturbs up the state of what you've observed so that you can't make the other kind of observation on a pristine state. You have to pick one kind of observation or the other. Electrons and photons really are a lot like the boxes I just described.<br /><br />So why don't physicists use this formulation? Despite the fact that negative numbers seem simpler to most people than imaginary numbers, the negative number formulation of QM is much more complicated. What's more, because it makes exactly the same predictions as regular QM there's no compelling reason to switch to it. And anyway, it's not as if directly observing negative probabilities is any more intuitive or meaningful than imaginary ones. Once you've introduced negative ones, you might as well go all the way!<br /><br />This all ties in with what I said a <a href="http://sigfpe.blogspot.com/2006/05/quantum-mechanics-and-probability.html">while back</a>. The important thing about QM is that having two ways to do something can make it <em>less</em> likely to happen, not more.<br /><br />For a different perspective <a href="http://www.lns.cornell.edu/spr/2002-03/msg0040195.html">this</a> is an interesting comment.<br /><br />Footnote: We can embed QM in negative probability theory. But can we do the converse? Can every negative probability distribution be physically realised in a quantum system? I've a hunch the answer is obvious but I'm too stupid to see it.</description>+ <pubDate>Sat, 12 Apr 2008 17:02:00 +0000</pubDate>+ <dc:creator>sigfpe</dc:creator>+</item>+<item>+ <title>Shin-Cheng Mu: Terminating Unfolds (2)</title>+ <guid isPermalink="false">http://www.iis.sinica.edu.tw/~scm/?p=49</guid>+ <link>http://www.iis.sinica.edu.tw/~scm/2008/terminating-unfolds-2/</link>+ <description><p>After seeing <a href="http://www.iis.sinica.edu.tw/~scm/2008/terminating-unfolds-1/">our code</a>, <a href="http://www.cs.nott.ac.uk/~nad/">Nils Anders Danielsson</a> suggested two improvements. Firstly, to wrap the bound in the seed. The terminating <code>unfoldr↓</code> would thus have a simpler type as well as a simpler implemenation:</p>+<blockquote><p><code>unfoldr↓ : {a : Set}(b : ℕ -> Set){n : ℕ} -><br />+&nbsp;&nbsp;&nbsp;&nbsp;(f : forall {i} -> b (suc i) -> ⊤ ⊎ (a × b i)) -><br />+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;b n -> [ a ]<br />+unfoldr↓ b {zero} f y = []<br />+unfoldr↓ b {suc i} f y with f y<br />+... | inj₁ _ = []<br />+... | inj₂ (x , y') = unfoldr↓ b {i} f y'</code></p></blockquote>+<p>The definition passes the termination check, apparently, because <code>unfoldr↓</code> is defined inductively on <code>n</code>.</p>+<p>To generate a descending a list, one may invent a datatype <code>Wrap</code> that wraps the seed, whose bound is simply the seed itself:</p>+<blockquote><p><code>data Wrap : ℕ -> Set where<br />+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;W : (n : ℕ) -> Wrap n</code></p></blockquote>+<p>The list may then be generated by an unfold:</p>+<blockquote><p><code>dec : forall {i} -> Wrap (suc i) -> ⊤ ⊎ (ℕ × Wrap i)<br />+dec {i} (W .(suc i)) = inj₂ (i , W i)</code></p>+<p>down↓ : ℕ -> [ ℕ ]<br />+down↓ n = unfoldr↓ Wrap dec (W n)<br />+</p></blockquote>+<p>Of course, this would defeat my original goal of reusing the non-dependently typed <code>dec</code>, which is probably a bad idea anyway.</p>+<p>To show that the bound need not be exact, let&#8217;s try to generate a descending list whose elements are decremented by 2 in each step. We may use this slightly generalised wrapper:</p>+<blockquote><p><code>data Wrap2 : ℕ -> Set where<br />+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;W2 : (x : ℕ) -> (bnd : ℕ) -> x ≤ bnd -> Wrap2 bnd</code></p></blockquote>+<p>and a function <code>dec2</code> that decrements a <code>suc i</code>-bounded seed by 2 but showing that the new seed is bounded by <code>i</code>:</p>+<blockquote><p><code>dec2 : forall {i} -> Wrap2 (suc i) -> ⊤ ⊎ (ℕ × WAlt i)<br />+dec2 {i} (W2 0 .(1 + i) _) = inj₁ tt<br />+dec2 {i} (W2 1 .(1 + i) _) = inj₁ tt<br />+dec2 {i} (W2 (suc (suc n)) .(1 + i) 2+n≤1+i) =<br />+&nbsp;&nbsp;&nbsp; inj₂ (n , W2 n i (suc-≤-weaken-l (≤-pred 2+n≤1+i)))<br />+</code></p></blockquote>+<p>The list can then be unfolded by:</p>+<blockquote><p><code>down↓2 : ℕ -> [ ℕ ]<br />+down↓2 n = unfoldr↓ Wrap2 dec2 (W2 n n ≤-refl)</code></p></blockquote>+<p>where <code>suc-≤-weaken-l</code> is a proof of <code>forall {m n} -> suc m ≤ n -> m ≤ n</code>.</p>+<h3>Unfolding a Tree</h3>+<p>It is an easy exercise to come up with a tree version of the unfold above:</p>+<blockquote><p><code>unfoldT↓ : {a : Set}(b : ℕ -> Set){n : ℕ} -><br />+&nbsp;&nbsp;(f : forall {i} -> b (suc i) -> a ⊎ (b i × b i)) -><br />+&nbsp;&nbsp;&nbsp;&nbsp;B n -> Tree a<br />+unfoldT↓ b {0} f y = Nul<br />+unfoldT↓ b {suc i} f y with f y<br />+... | inj₁ x = Tip x<br />+... | inj₂ (y₁ , y₂) =<br />+&nbsp;&nbsp;&nbsp;&nbsp;Bin (unfoldT↓ b {i} f y₁) (unfoldT↓ b {i} f y₂)</code></p></blockquote>+<p>To deal with the second task of building a roughly balanced binary tree, one may try this wrapper:</p>+<blockquote><p><code>data Split (a : Set): ℕ -> Set where<br />+&nbsp;&nbsp;Sp : (xs : [ a ]) -> (bnd : ℕ) -><br />+&nbsp;&nbsp;&nbsp;&nbsp;length xs bnd -> Split a bnd</code></p></blockquote>+<p>and try to code up a generator function <code>split↓</code> having this type:</p>+<blockquote><p><code>split↓ : forall {a i} -> Split a (suc i) -> a ⊎ (Split a i × Split a i)<br />+</code></p></blockquote>+<p>The function <code>split↓</code> I eventually come up with, however, is much more complicated than I had wished. Even worse, it is now <code>split↓</code> that fails to pass the termination check.</p>+<p><a href="http://www.cs.chalmers.se/~ulfn/">Ulf Norell</a> suggested some possible fixes. The difficulties, however, is probably a hint that there is something wrong in my approach in the first place. Rather than trying to fix it, Nils showed me how he would tackle the problem from the beginning.</p>+<h3>Using Well-Founded Recursion</h3>+<p>Nils showed me how to define <code>unfoldT↓</code> using <em>well-founded recursion</em>. For a simplified explanation, the <a href="http://appserv.cs.chalmers.se/users/ulfn/wiki/agda.php?n=Libraries.StandardLibrary">Standard Library</a> provides a function <code>-rec</code> having type (after normalisation):</p>+<blockquote><p><code>-rec : (P : ℕ -> Set) -><br />+&nbsp;&nbsp;(f : (i : ℕ) -> (rec : (j : ℕ) -> j ′ i -> P j) -> P i) -><br />+&nbsp;&nbsp;&nbsp;&nbsp;(x : ℕ) -> P x </code></p></blockquote>+<p>With <code>-rec</code> one can define functions on natural numbers by recursion, provided that the argument strictly decreases in each recursive call. <code>P</code> is the type of the result, parameterised by the input. The function <code>f</code> is a template that specifies the body of the recursion which, given <code>i</code>, computes some result of type <code>P i</code>. The functional argument <code>rec</code> is supposed to be the recursive call. The constraint <code>j ′ i</code>, however, guarantees that it accepts only inputs strictly smaller than <code>i</code> (the ordering <code>′ </code> is a variation of <code>&lt;</code> that is more suitable for this purpose). One may perhaps think of <code>-rec</code> as a fixed-point operator computing the fixed-point of <code>f</code>, only that <code>f</code> has to take <code>i</code> before <code>rec</code> because the latter depends on the former.</p>+<p>Let us try to define an unfold on trees using <code>-rec</code>. The &#8220;base-functor&#8221; of the datatype <code>Tree⁺ a</code> is <code>F b = a ⊎ b × b</code>. One of the lessons we have learnt is that it would be more convenient for the generating function to return the bound information. We could use a type like this:</p>+<blockquote><p><code>F a b k = a ⊎ ∃ (ℕ × ℕ) (\(i , j) -> b i × b j × i ′ k × j ′ k)</code>+</p></blockquote>+<p>But it is perhaps more reader-friendly to define the base functor as a datatype:</p>+<blockquote><p><code>data Tree⁺F (a : Set) (b : ℕ -> Set) : ℕ -> Set where<br />+&nbsp;&nbsp;tip : forall {k} -> a -> Tree⁺F a b k<br />+&nbsp;&nbsp;bin : forall {i j k} -><br />+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;b i -> b j -> i ′ k -> j ′ k -> Tree⁺F a b k<br />+</code></p></blockquote>+<p>The generating function for the unfold should thus have type <code>forall {a b i} -> b i -> Tree⁺F a b i</code>.</p>+<p>The function <code>unfoldT↓F</code> is the template for <code>unfoldT↓</code>:</p>+<blockquote><p><code>unfoldT↓F : {a : Set} {b : ℕ -> Set} -><br />+&nbsp;&nbsp;(f : forall {i} -> b i -> Tree⁺F a b i) -><br />+&nbsp;&nbsp;&nbsp;(n : ℕ) -> ((i : ℕ) -> i ′ n -> b i -> Tree⁺ a) -><br />+&nbsp;&nbsp;&nbsp;&nbsp;b n -> Tree⁺ a<br />+unfoldT↓F f n rec y with f y<br />+&#8230; | tip a = Tip⁺ a<br />+&#8230; | bin {i} {j} y₁ y₂ i&lt;n j&lt;n =<br />+&nbsp;&nbsp;&nbsp;&nbsp;Bin⁺ (rec i i&lt;n y₁) (rec j j&lt;n y₂)<br />+</code></p></blockquote>+<p>Now <code>unfoldT↓</code> can be defined by:</p>+<blockquote><p><code>unfoldT↓ : {a : Set} {b : ℕ -> Set} -><br />+&nbsp;&nbsp;(f : forall {i} -> b i -> Tree⁺F a b i) -><br />+&nbsp;&nbsp;&nbsp;&nbsp;forall {n} -> b n -> Tree⁺ a<br />+unfoldT↓ {a}{b} f {n} y =<br />+&nbsp;&nbsp;&nbsp;&nbsp;-rec (\n -> b n -> Tree⁺ a) (unfoldT↓F f) n y </code></p></blockquote>+<p>All the definition above makes no recursive calls. All the tricks getting us through the termination check are hidden in <code>-rec</code>. How is it defined?</p>+<h3>Well-Founded Recursion Defined on ′</h3>+<p>Currently, well-founded recursion are defined in <code>Logic.Induction</code> and its sub-modules. They are very interesting modules to study. The definitions there, however, are very abstract. To understand how <code>-rec</code> works, let&#8217;s try to implement our own.</p>+<p>This is the definition of <code>′</code> from <code>Data.Nat</code>:</p>+<blockquote><p><code>data _≤′_ : Rel ℕ where<br />+ ≤′-refl : forall {n} -> n ≤′ n<br />+ ≤′-step : forall {m n} -> m ≤′ n -> m ≤′ suc n</code></p>+<p>_′_ : Rel ℕ<br />+m ′ n = suc m ≤′ n</p></blockquote>+<p>Recall that the recursion template <code>f</code> has type <code>forall i -> (forall j -> j ′ i -> P j) -> P i</code>. That is, given <code>i</code>, <code>f</code> computes <code>P i</code>, provided that we know of a method to compute <code>P j</code> for all <code>j ′ i</code>. Let us try to construct such a method using <code>f</code>. The function <code> guard f i</code> computes <code>f</code>, provided that the input is strictly smaller than <code>i</code>:</p>+<blockquote><p><code>guard : {P : ℕ -> Set} -><br />+&nbsp;&nbsp;&nbsp;(forall i -> (forall j -> j ′ i -> P j) -> P i) -><br />+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;forall i -> forall j -> j ′ i -> P j<br />+guard f zero _ ()<br />+guard f .(suc j) j ≤′-refl = f j (guard f j)<br />+guard f (suc i) j (≤′-step j&lt;i) = guard f i j j&lt;i </code></p></blockquote>+<p>Observe that <code>guard</code> terminates because it is defined inductively on <code>i</code>. If we discard the type information, all what <code>guard f i j</code> is to make a call to <code>f j</code>. Before doing so, however, it checks through the proof to make sure that <code>j</code> is strictly smaller than <code>i</code>. In <code>f j (guard f j)</code>, the call to <code>guard f j</code> ensures that subsequent calls to <code>f</code> are given arguments smaller than <code>j</code>.</p>+<p>Now <code>-rec</code> can be defined by:</p>+<blockquote><p><code>-rec : (P : ℕ -> Set) -><br />+&nbsp;&nbsp;&nbsp;(forall i -> (forall j -> j ′ i -> P j) -> P i) -><br />+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;forall n -> P n<br />+-rec P f n = f n (guard f n)</code></p></blockquote>+<p>In <code>Logic.Induction.Nat</code>, <code>-rec</code> is an instance of well-founded recursion defined using the concept of <em>accessibility</em>, defined in <code>Logic.Induction.WellFounded</code>. I find them very interesting modules which I hope to understand more.</p>+<p><strong>To be continued&#8230;</strong></p></description>+ <pubDate>Sat, 12 Apr 2008 16:22:42 +0000</pubDate>+ <dc:creator>Shin</dc:creator>+</item>+<item>+ <title>Joel Reymont: Cross-platform bytecode anyone?</title>+ <guid isPermalink="false">tag:typepad.com,2003:post-48340944</guid>+ <link>http://feeds.feedburner.com/~r/TenerifeSkunkworks/~3/268946453/cross-platform.html</link>+ <description><p>Suppose I want to generate bytecode or executable code on Mac OSX or Linux and run it on Windows. Assume that I want to do that in a web application and that I only target x86.</p>++<p>What are my options?</p>+<p>The other qualifier is that the generated code should be .NET or should run in a VM that would, in turn, talk to .NET.</p>++<p>I could try Mono but I read someplace that generated assemblies cannot be used on Windows due to signing issues. I'm not sure this is the case, can someone correct me?</p>++<p>I could try Factor and write the COM interface on the Windows side. The Factor VM is reasonably small and the bytecode should run without change.</p>++<p>What else?</p>+<div class="feedflare">+<a href="http://feeds.feedburner.com/~f/TenerifeSkunkworks?a=8YdbBgG"><img src="http://feeds.feedburner.com/~f/TenerifeSkunkworks?i=8YdbBgG" border="0" /></a> <a href="http://feeds.feedburner.com/~f/TenerifeSkunkworks?a=NvKO8Mg"><img src="http://feeds.feedburner.com/~f/TenerifeSkunkworks?i=NvKO8Mg" border="0" /></a> <a href="http://feeds.feedburner.com/~f/TenerifeSkunkworks?a=9FRJRPg"><img src="http://feeds.feedburner.com/~f/TenerifeSkunkworks?i=9FRJRPg" border="0" /></a> <a href="http://feeds.feedburner.com/~f/TenerifeSkunkworks?a=vDRgsTG"><img src="http://feeds.feedburner.com/~f/TenerifeSkunkworks?i=vDRgsTG" border="0" /></a> <a href="http://feeds.feedburner.com/~f/TenerifeSkunkworks?a=5I1ReAg"><img src="http://feeds.feedburner.com/~f/TenerifeSkunkworks?i=5I1ReAg" border="0" /></a>+</div><img src="http://feeds.feedburner.com/~r/TenerifeSkunkworks/~4/268946453" height="1" width="1" /></description>+ <pubDate>Sat, 12 Apr 2008 13:09:35 +0000</pubDate>+ <dc:creator>Joel Reymont</dc:creator>+</item>+<item>+ <title>Neil Mitchell: darcs Feature Request (Part II)</title>+ <guid isPermalink="false">tag:blogger.com,1999:blog-7094652.post-3201719101251968153</guid>+ <link>http://neilmitchell.blogspot.com/2008/04/darcs-feature-request-part-ii.html</link>+ <description>I <a href="http://neilmitchell.blogspot.com/2008/01/darcs-feature-request.html">previously requested</a> a feature for darcs. I always pull from an http repo, and push over SSH. I have to push using <tt>--no-set-default</tt> and typing the ssh repo in full, which I automate with a <a href="http://darcs.haskell.org/packages/filepath/push.bat">.bat file</a> in each repo.<br /><br />Today I noticed that darcs has <tt>_darcs/prefs/repos</tt>, which seems to list the repo's that darcs has used. In one of my typical repo files, I have an http entry and an SSH entry. To get darcs to behave the way I want, all I need to do is push using the first non-http repo in that list.<br /><br />I have implemented my version of the darcs push command inside my paper tool, the code is all <a href="http://www.cs.york.ac.uk/fp/darcs/paper/Paper/Push.hs">online here</a>. Now I can delete all my push.bat scripts, and just type <tt>paper push</tt> from any darcs repo. As an added bonus, I now don't need to change to the root directory to perform a push.<br /><br />It would be really nice if someone could incorporate this feature into the main darcs codebase. However, I'm quite happy using my paper tool for now. I certainly don't have time to patch, or even build darcs :-)</description>+ <pubDate>Sat, 12 Apr 2008 11:20:00 +0000</pubDate>+ <dc:creator>Neil Mitchell</dc:creator>+</item>+<item>+ <title>Conrad Parker: Release: Sweep 0.9.3</title>+ <guid isPermalink="false">tag:blogger.com,1999:blog-9101292118679422945.post-6484626782594667327</guid>+ <link>http://blog.kfish.org/2008/04/release-sweep-093.html</link>+ <description>This is a bugfix release of <a href="http://www.metadecks.org/software/sweep/">Sweep</a>,+addressing <a href="http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2008-1686">CVE-2008-1686</a>.+For details, see my earlier post about+<a href="http://blog.kfish.org/2008/04/release-libfishsound-091.html">libfishsound 0.9.1</a>.+Thanks to Peter Shorthose for managing this release.</description>+ <pubDate>Sat, 12 Apr 2008 07:50:09 +0000</pubDate>+ <dc:creator>Conrad Parker</dc:creator>+</item>+<item>+ <title>Ulisses Costa: Life After People, Documentary</title>+ <guid isPermalink="false">http://caos.di.uminho.pt/~ulisses/blog/2008/04/12/life-after-people-documentary/</guid>+ <link>http://caos.di.uminho.pt/~ulisses/blog/2008/04/12/life-after-people-documentary/</link>+ <description><p><!--post2pdf_exclude-->Last week, after making a work for the university, I was stumbling around and found an excellent documentary to see. Life after people is a documentary from History channel that try to respond the question:</p>+<blockquote>+<p id="result_box" dir="ltr"><em> What would happen to planet earth if the human race were to suddenly disappear forever?</em></p>+</blockquote>+<p>The idea is just great! Probably everyone at some point thought about that, and maybe didn&#8217;t have the imagination or the knowledge to get a clear picture like those in this documentary.</p>+<p><img src="http://caos.di.uminho.pt/~ulisses/blog/img/buildings_decomposing.jpg" align="left" height="164" width="297" /></p>+<p>The documentary have a lot of speculative facts, just a little bit americanized, but the idea of see all the things that we created being destroyed by the land there we live is fascinating.</p>+<p>Remember us that our planet is alive, and live by it self, and in some aspects needs help. We are small but at the same time we can do a lot of changes in our planet.</p>+<p>Well, I really liked this imaginative documentary, here is the &#8220;trailer&#8221;:</p>+<p>++</p>+<p><a href="http://www.history.com/minisites/life_after_people">Here</a> the oficial site of <a href="http://video.google.com/videoplay?docid=4939078184096254535">the documentary</a>.</p></description>+ <pubDate>Sat, 12 Apr 2008 04:42:04 +0000</pubDate>+ <dc:creator>ulisses</dc:creator>+</item>+<item>+ <title>Eric Kow (kowey): darcs 2 at last!</title>+ <guid isPermalink="false">tag:blogger.com,1999:blog-21123659.post-737614930474400956</guid>+ <link>http://koweycode.blogspot.com/2008/04/darcs-2-at-last.html</link>+ <description>I'm sure you've all seen David's <a href="http://thread.gmane.org/gmane.comp.version-control.darcs.devel/7809">announcement</a>: darcs 2.0.0 is out!<br /><h3>what's good</h3>In short, darcs 2.0 is safer and faster.<br /><br />Particularly, the dreaded exponential-time merge bug has now been largely resolved. Let me say it more carefully: while it may still be possible to run into exponential time merges, our improvements to conflict-handling should make it considerably less common. We hope that nobody ever runs into such a situation in practice.<br /><br />Other key points are improved the hashed inventory and pristine cache which darcs more robust (you no longer have to worry about third party tools like Eclipse or Unison messing things up by mucking around with darcs internals), the ssh-connection mode which speeds up SSH-issues a lot and kills the typing-your-password-ten-million-times issue dead (at most you'll have to type it in twice).<br /><br /><h3>what's bad</h3>On the one hand, darcs 2.0.0 should be much smoother and faster for most users. On the other hand, people with large repositories (e.g. GHC-sized) might find certain operations to be somewhat slower. David does not (yet) have ideas on how to make things better for such users, and is even recommending them to switch to something else. If you've got a repository of darcs' size (over 5000 patches, 6 years, 131 contributors) or smaller, you should continue using darcs, because we still think it works better: we're still the only ones around to offer <em>deep</em> cherry picking... something which we think would be hard to do without radically changing the way other VCSes work. If you would like to prove us wrong, please do so and we would be most grateful!<br /><br />Also, taking advantage of darcs 2 will require you to upgrade your repository to the <code>darcs-2</code> format (see <code>darcs convert</code>), which unfortunately, is not compatible with older versions of darcs. People with new repositories should definitely start using this format. People with old repositories should probably do so at the earliest convenient moment, although this means your users will have to upgrade. Please switch to the new format. It will make everybody's lives easier.<br /><br />The final piece of bad news: we're going to have to shift to a lighter weight development model, something which puts less strain on David and the rest of the contributors. The consequences are that patches might get less review [one maintainer and not two], and that you'll be seeing less of David on the mailing lists. The good news in the bad news is that our lighter weight development model is now being supported by increased automation of the administrative stuff. For example, our bug tracker is now integrated with the darcs repository so that it automatically knows when a ticket has been resolved by a patch. This increased automation gives us extra rigour and more time to think about making darcs better. The only thing we need is more of us. If you want a place to hone your Haskell, Perl or C... or if you think you know a thing or two about user interfaces, please spend some time with us.<br /><h3>to sum up...</h3>Have you been hesitating to try darcs out? Well, now is a good time to do so, as our killer bugs have been fixed as well as the kind of minor nuisances that get most of us. Or... are you looking for something to work on? Uncle David needs you!<br /><br />[note: Thanks to David Roundy for comments on a draft of this post]</description>+ <pubDate>Fri, 11 Apr 2008 17:56:54 +0000</pubDate>+ <dc:creator>kowey</dc:creator>+</item>+<item>+ <title>Tom Moertel: That looks about right</title>+ <guid isPermalink="false">urn:uuid:8c556b83-dcaa-4044-9f0f-7af434f6f3f7</guid>+ <link>http://blog.moertel.com/articles/2008/04/11/that-looks-about-right</link>+ <description><p>Via <a href="http://www.cwinters.com/news/display/3624">Chris</a>:</p>+++<pre>$ history | awk '{print $2}' | sort | uniq -c | sort -rn | head+ 196 git+ 110 l+ 102 cd+ 70 make+ 34 darcs+ 30 pushd+ 23 ssh+ 23 m+ 23 ls+ 20 rm+</pre>++ <p>The <em>l</em> and <em>m</em> commands are aliases:</p>+++ <ul>+ <li><em>l</em> = <em>ls &#8211;CF</em></li>+ <li><em>m</em> = <em>less</em></li>+ </ul></description>+ <pubDate>Fri, 11 Apr 2008 16:04:49 +0000</pubDate>+ <dc:creator>Tom Moertel</dc:creator>+</item>+<item>+ <title>Bryan O'Sullivan: Hoisted from someone else&#8217;s comments</title>+ <guid isPermalink="false">http://www.serpentine.com/blog/2008/04/10/hoisted-from-someone-elses-comments/</guid>+ <link>http://www.serpentine.com/blog/2008/04/10/hoisted-from-someone-elses-comments/</link>+ <description>Marc Ambinder comments on the <a href="http://marcambinder.theatlantic.com/archives/2008/04/advance_praise_for_war_and_dec.php">peculiar cadence of the jacket blurbs</a> for Douglas Feith&#8217;s new book, to which some wag responds with a suggestion for a similar endorsement.++<blockquote>Feith&#8217;s book is perfectly rectangular. Its page numbers progress in a pleasing upward sequence. Its evident shortcomings in terms of accuracy are offset by its usefulness in balancing wobbly furniture.</blockquote></description>+ <pubDate>Fri, 11 Apr 2008 06:11:47 +0000</pubDate>+ <dc:creator>Bryan O'Sullivan (bos@serpentine.com)</dc:creator>+</item>++</channel>+</rss>
− tests/rss20.xml
@@ -1,1153 +0,0 @@-<?xml version="1.0"?>-<rss version="2.0" xmlns:dc="http://purl.org/dc/elements/1.1/">--<channel>- <title>Planet Haskell</title>- <link>http://planet.haskell.org/</link>- <language>en</language>- <description>Planet Haskell - http://planet.haskell.org/</description>--<item>- <title>Brent Yorgey: Brent</title>- <guid isPermalink="false">http://byorgey.wordpress.com/?p=63</guid>- <link>http://byorgey.wordpress.com/2008/04/17/collecting-unstructured-information-with-the-monoid-of-partial-knowledge/</link>- <description><div class="snap_preview"><br /><p>In <a href="http://byorgey.wordpress.com/2008/04/17/an-interesting-monoid/">my last post</a>, I described what I&#8217;m calling the &#8220;monoid of partial knowledge&#8221;, a way of creating a monoid over sets of elements from a preorder, which is a generalization of the familiar monoid <img src="http://l.wordpress.com/latex.php?latex=%28S%2C%5Cmax%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="(S,\max)" title="(S,\max)" class="latex" /> over a set with a total order and a smallest element.</p>-<p>There&#8217;s actually one situation where a special case of this monoid is commonly used in Haskell. Suppose you have a record type which contains several fields, and you would like to parse some input to create a value of this type. The problem is that the input is not very nice: the bits of input which designate values for various fields are not in any particular order; some occur more than once; some might even be missing. How to deal with this?</p>-<p>One common solution is to wrap the type of each field in the record with Maybe, and create a Monoid instance which allows you to combine two partial records into one (hopefully less partial) record. Using this framework, you can just parse each bit of input into a mostly-blank record, with one (or more) fields filled in, then combine all the records (with mconcat) into one summary record. For example:</p>-<pre>-import Data.Monoid-import Control.Monad -- for the MonadPlus instance of Maybe--data Record = R { name :: Maybe String,- age :: Maybe Int }- deriving (Eq, Show)--instance Monoid Record where- mempty = R Nothing Nothing- mappend r1 r2 = R { name = name r1 `mplus` name r2- , age = age r1 `mplus` age r2- }-</pre>-<p>The mplus function, from the MonadPlus instance for Maybe, simply takes the first Just value that it finds. This is nice and simple, and works just great:</p>-<pre>-&gt; mempty :: Record-R {name = Nothing, age = Nothing}-&gt; mconcat [mempty { name = Just "Brent" }]-R {name = Just &#8220;Brent&#8221;, age = Nothing}-&gt; mconcat [mempty { name = Just "Brent" }, mempty { age = Just 26 }]-R {name = Just &#8220;Brent&#8221;, age = Just 26}-&gt; mconcat [mempty { name = Just "Brent" }, mempty { age = Just 26 }, mempty { age = Just 23 }]-R {name = Just &#8220;Brent&#8221;, age = Just 26}-</pre>-<p>Note how the appending is left-biased, because mplus is left-biased: after seeing the first age, all subsequent ages are ignored.</p>-<p>Now, really what we&#8217;re doing here is using the monoid (as in my previous post) induced by the preorder which says that any name is <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" /> any other name, and any age is <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" /> any other age, and names and ages can&#8217;t be compared! </p>-<p>Some code is in order. First, we create a class for preorders, and a newtype to contain sets of elements (there&#8217;s already a Monoid instance for Set, so we need a newtype to give a different semantics). Then we translate the specification from my previous post directly into a Monoid instance.</p>-<pre>-import qualified Data.Set as S---- laws:--- if x == y, then x &lt;~ y--- if x &lt;~ y and y &lt;~ z, then x &lt;~ z-class (Eq p) =&gt; Preorder p where- (&lt;~) :: p -&gt; p -&gt; Bool--newtype PStar p = PStar { unPStar :: (S.Set p) }- deriving Show--instance (Preorder p, Ord p) =&gt; Monoid (PStar p) where- mempty = PStar S.empty- mappend (PStar ss) (PStar ts) = PStar $- S.filter (\s -&gt; all (\t -&gt; s == t || t &lt;~ s || not (s &lt;~ t)) $ S.toList ts) ss- `S.union`- S.filter (\t -&gt; all (\s -&gt; s == t || not (t &lt;~ s)) $ S.toList ss) ts-</pre>-<p>Pretty straightforward! Of course, there are probably more efficient ways to do this, but I don&#8217;t care about that at the moment: let&#8217;s get some working proof-of-concept code, and worry about efficiency later. Now, one thing you may notice is that our Monoid instance requires an Ord instance for p! &#8220;But I thought we only needed a preorder?&#8221; I hear you cry. Well, the Ord is just there so that we can use an efficient implementation of Set. In particular, note that the Ord instance need have nothing at all to do with the Preorder instance, and won&#8217;t affect the semantics of this Monoid instance in any way. If we wanted, we could do away with the Ord entirely and use lists of unique elements (or something like that) instead of Sets.</p>-<p>So, how do we translate our record example from above into this new framework? Easy, we just create a data type to represent the different kinds of facts we want to represent, along with a convenience method or two, and make it an instance of Preorder:</p>-<pre>-data Fact = Name String | Age Int- deriving (Eq,Show,Ord)--fact :: Fact -&gt; PStar Fact-fact f = PStar (S.singleton f)--instance Preorder Fact where- (Name _) &lt;~ (Name _) = True- (Age _) &lt;~ (Age _) = True- _ &lt;~ _ = False-</pre>-<p>Let&#8217;s try it!</p>-<pre>-&gt; mempty :: PStar Fact-PStar {unPStar = fromList []}-&gt; mconcat . map fact $ [Name "Brent"]-PStar {unPStar = fromList [Name "Brent"]}-&gt; mconcat . map fact $ [Name "Brent", Age 26]-PStar {unPStar = fromList [Name "Brent",Age 26]}-&gt; mconcat . map fact $ [Name "Brent", Age 26, Age 23]-PStar {unPStar = fromList [Name "Brent",Age 26]}-</pre>-<p>Neato! But the really cool thing is all the extra power we get now: we can easily tweak the semantics of the Monoid instance by altering the Preorder instance. For example, suppose we want the first name that we see, but the <i>oldest</i> age. Easy peasy:</p>-<pre>-instance Preorder Fact where- (Name _) &lt;~ (Name _) = True- (Age m) &lt;~ (Age n) = m &lt;= n- _ &lt;~ _ = False--&gt; mconcat . map fact $ [Age 23, Name "Brent"]-PStar {unPStar = fromList [Name "Brent",Age 23]}-&gt; mconcat . map fact $ [Age 23, Name "Brent", Age 24]-PStar {unPStar = fromList [Name "Brent",Age 24]}-&gt; mconcat . map fact $ [Age 23, Name "Brent", Age 24, Name "Joe", Age 26]-PStar {unPStar = fromList [Name "Brent",Age 26]}-</pre>-<p>Of course, we could have done this with the Record model, but it wouldn&#8217;t be terribly elegant. But we&#8217;re not done: let&#8217;s say we want to remember the oldest age we find, and the first name, unless the age is over 50, in which case we don&#8217;t want to remember the name (I admit this is a bit contrived)? That&#8217;s not too hard either:</p>-<pre>-instance Preorder Fact where- (Name _) &lt;~ (Name _) = True- (Age m) &lt;~ (Age n) = m &lt;= n- (Name _) &lt;~ (Age n) = n &gt; 50- _ &lt;~ _ = False--&gt; mconcat . map fact $ [Name "Brent", Age 26]-PStar {unPStar = fromList [Name "Brent",Age 26]}-&gt; mconcat . map fact $ [Name "Brent", Age 26, Age 45]-PStar {unPStar = fromList [Name "Brent",Age 45]}-&gt; mconcat . map fact $ [Name "Brent", Age 26, Age 45, Age 53]-PStar {unPStar = fromList [Age 53]}-</pre>-<p>This would have been a huge pain to do with the Record model! Now, this isn&#8217;t an unqualified improvement; there are several things we can&#8217;t do here. One is if we want to be able to combine facts into larger compound facts: we can do that fairly straightforwardly with the Record-of-Maybes model, but not with the preorder-monoid model. We also can&#8217;t easily choose to have some fields be left-biased and some right-biased (the Monoid instance for PStar has left-bias built in!). But it&#8217;s certainly an interesting approach.</p>-<p>Now, one thing we do have to be careful of is that our Preorder instances really do define a preorder! For example, at first I tried using <img src="http://l.wordpress.com/latex.php?latex=n+%3C+18&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="n &lt; 18" title="n &lt; 18" class="latex" /> in the above Preorder instance instead of <img src="http://l.wordpress.com/latex.php?latex=n+%3E+50&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="n &gt; 50" title="n &gt; 50" class="latex" />, and was confused by the weird results I got. But such a Preorder instance violates transitivity, so no wonder I was getting weird semantics. =) It would be interesting to reformulate this in a dependently typed language like <a href="http://appserv.cs.chalmers.se/users/ulfn/wiki/agda.php">Agda</a>, where creating a Preorder could actually require a proof that it satisfied the preorder axioms.</p>-<p>Thanks to <a href="http://conal.net/">Conal Elliott</a> for some suggestions on making the formulation in the previous post more elegant &#8212; we&#8217;ll see what comes of it!</p>-<img alt="" border="0" src="http://feeds.wordpress.com/1.0/categories/byorgey.wordpress.com/63/" /> <img alt="" border="0" src="http://feeds.wordpress.com/1.0/tags/byorgey.wordpress.com/63/" /> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/gocomments/byorgey.wordpress.com/63/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/comments/byorgey.wordpress.com/63/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/godelicious/byorgey.wordpress.com/63/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/delicious/byorgey.wordpress.com/63/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/gostumble/byorgey.wordpress.com/63/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/stumble/byorgey.wordpress.com/63/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/godigg/byorgey.wordpress.com/63/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/digg/byorgey.wordpress.com/63/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/goreddit/byorgey.wordpress.com/63/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/reddit/byorgey.wordpress.com/63/" /></a> <img alt="" border="0" src="http://stats.wordpress.com/b.gif?host=byorgey.wordpress.com&amp;blog=1152889&amp;post=63&amp;subd=byorgey&amp;ref=&amp;feed=1" /></div></description>- <pubDate>Thu, 17 Apr 2008 21:32:00 +0000</pubDate>- <dc:creator>Brent</dc:creator>-</item>-<item>- <title>Brent Yorgey: Brent</title>- <guid isPermalink="false">http://byorgey.wordpress.com/?p=62</guid>- <link>http://byorgey.wordpress.com/2008/04/17/an-interesting-monoid/</link>- <description><div class="snap_preview"><br /><p>The other day I was just sort of letting my mind wander, and I came up with an interesting monoid, which I&#8217;m calling the &#8220;monoid of partial knowledge&#8221;. So I thought I&#8217;d write about it here, partly just because it&#8217;s interesting, and partly to see whether anyone has any pointers to any literature (I&#8217;m sure I&#8217;m not the first to come up with it).</p>-<p>Recall that a <a href="https://secure.wikimedia.org/wikipedia/en/wiki/Monoid"><i>monoid</i></a> is a set with an associative binary operation and a distinguished element which is the identity for the operation.</p>-<p>Now, given a <a href="https://secure.wikimedia.org/wikipedia/en/wiki/Total_order"><i>total order</i></a> on a set <img src="http://l.wordpress.com/latex.php?latex=S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S" title="S" class="latex" /> with a smallest element <img src="http://l.wordpress.com/latex.php?latex=e&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="e" title="e" class="latex" />, we get a monoid <img src="http://l.wordpress.com/latex.php?latex=%28S%2C+%5Cmax%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="(S, \max)" title="(S, \max)" class="latex" />, where <img src="http://l.wordpress.com/latex.php?latex=%5Cmax&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\max" title="\max" class="latex" /> denotes the function which determines the larger of two elements, according to the total order on <img src="http://l.wordpress.com/latex.php?latex=S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S" title="S" class="latex" />. <img src="http://l.wordpress.com/latex.php?latex=%5Cmax&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\max" title="\max" class="latex" /> is clearly associative, and has identity <img src="http://l.wordpress.com/latex.php?latex=e&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="e" title="e" class="latex" />. Taking a list of elements of <img src="http://l.wordpress.com/latex.php?latex=S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S" title="S" class="latex" /> and summarizing it via this monoid corresponds to finding the maximum element in the list. If you think of receiving the elements of the list one by one, and applying <img src="http://l.wordpress.com/latex.php?latex=%5Cmax&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\max" title="\max" class="latex" /> to each new incoming value and the value of an accumulator (storing the result back into the accumulator, which should obviously be initialized to <img src="http://l.wordpress.com/latex.php?latex=e&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="e" title="e" class="latex" />), at any given time the value of the accumulator represents the &#8216;current best&#8217;, i.e. the largest element among those received so far.</p>-<p>The idea I had was to generalize this from a total order to a preorder. Recall that a <a href="https://secure.wikimedia.org/wikipedia/en/wiki/Preorder"><i>preorder</i></a> is a set <img src="http://l.wordpress.com/latex.php?latex=S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S" title="S" class="latex" /> equipped with a reflexive, transitive binary relation, often denoted <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" />. That is, for any <img src="http://l.wordpress.com/latex.php?latex=x%2Cy%2Cz+%5Cin+S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x,y,z \in S" title="x,y,z \in S" class="latex" />, we have <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim x" title="x \lesssim x" class="latex" />; and <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+y+%5Cland+y+%5Clesssim+z&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim y \land y \lesssim z" title="x \lesssim y \land y \lesssim z" class="latex" /> implies <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+z&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim z" title="x \lesssim z" class="latex" />. If <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" /> is also antisymmetric, that is, <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+y+%5Cland+y+%5Clesssim+x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim y \land y \lesssim x" title="x \lesssim y \land y \lesssim x" class="latex" /> implies <img src="http://l.wordpress.com/latex.php?latex=x+%3D+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x = y" title="x = y" class="latex" />, it is called a <i>partial order</i>, or <i>poset</i>. Then if <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim y" title="x \lesssim y" class="latex" /> or <img src="http://l.wordpress.com/latex.php?latex=y+%5Clesssim+x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="y \lesssim x" title="y \lesssim x" class="latex" /> for any two elements <img src="http://l.wordpress.com/latex.php?latex=x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x" title="x" class="latex" /> and <img src="http://l.wordpress.com/latex.php?latex=y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="y" title="y" class="latex" />, we get a total order, but for a general preorder some pairs of elements may not be comparable &#8212; that is, there may be elements <img src="http://l.wordpress.com/latex.php?latex=x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x" title="x" class="latex" /> and <img src="http://l.wordpress.com/latex.php?latex=y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="y" title="y" class="latex" /> for which neither <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim y" title="x \lesssim y" class="latex" /> nor <img src="http://l.wordpress.com/latex.php?latex=y+%5Clesssim+x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="y \lesssim x" title="y \lesssim x" class="latex" /> holds.</p>-<p>Let&#8217;s think about this. Suppose we are given a preorder <img src="http://l.wordpress.com/latex.php?latex=%28P%2C%5Clesssim%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="(P,\lesssim)" title="(P,\lesssim)" class="latex" /> with an <i>initial object</i> <img src="http://l.wordpress.com/latex.php?latex=e&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="e" title="e" class="latex" /> (an initial object in this context is an element which is <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" /> all other elements). We&#8217;ll initialize an accumulator to <img src="http://l.wordpress.com/latex.php?latex=e&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="e" title="e" class="latex" />, and imagine receiving elements of <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> one at a time. For a concrete example, suppose we are dealing with the preorder (actually also a poset) of positive integers under the divisibility relation, so our accumulator is initialized to 1. Let&#8217;s say we receive the integer 4. Clearly, 1 divides 4, so we should replace the 1 in our accumulator with 4. But now suppose we next receive the integer 5. 4 does not divide 5 or vice versa, so what should we do? We would be justified in neither throwing the 5 away nor replacing the 4, since 4 and 5 are not related to each other under the divisibility relation. Somehow we need to keep the 4 <i>and</i> the 5 around.</p>-<p>The solution is that instead of creating a monoid over <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> itself, as we can for sets with a total order, we create a monoid over <i>subsets</i> of <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" />. In particular, consider the set <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> of subsets of <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> which do not contain two distinct elements <img src="http://l.wordpress.com/latex.php?latex=x%2Cy&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x,y" title="x,y" class="latex" /> for which <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim y" title="x \lesssim y" class="latex" />. Since we are dealing with subsets of <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" />, we can actually drop the restriction that <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> contain an initial object; the empty set will serve as the identity for the monoid.</p>-<p>We then define the monoid operation <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" /> on two such subsets as</p>-<p><img src="http://l.wordpress.com/latex.php?latex=S+%5Coplus+T+%3D+%28S+%5Ctriangleleft+T%29+%5Ccup+%28S+%5Ctriangleright+T%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \oplus T = (S \triangleleft T) \cup (S \triangleright T)" title="S \oplus T = (S \triangleleft T) \cup (S \triangleright T)" class="latex" /></p>-<p>where</p>-<p><img src="http://l.wordpress.com/latex.php?latex=S+%5Ctriangleleft+T+%3D+%5C%7B+s+%5Cin+S+%5Cmid+%5Cforall+t+%5Cin+T%2C+s+%3D+t+%5Cmbox%7B+or+%7D+t+%5Clesssim+s+%5Cmbox%7B+or+%7D+s+%5Cnot+%5Clesssim+t+%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \triangleleft T = \{ s \in S \mid \forall t \in T, s = t \mbox{ or } t \lesssim s \mbox{ or } s \not \lesssim t \}" title="S \triangleleft T = \{ s \in S \mid \forall t \in T, s = t \mbox{ or } t \lesssim s \mbox{ or } s \not \lesssim t \}" class="latex" /></p>-<p>and</p>-<p><img src="http://l.wordpress.com/latex.php?latex=S+%5Ctriangleright+T+%3D+%5C%7B+t+%5Cin+T+%5Cmid+%5Cforall+s+%5Cin+S%2C+s+%3D+t+%5Cmbox%7B+or+%7D+t+%5Cnot+%5Clesssim+s+%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \triangleright T = \{ t \in T \mid \forall s \in S, s = t \mbox{ or } t \not \lesssim s \}" title="S \triangleright T = \{ t \in T \mid \forall s \in S, s = t \mbox{ or } t \not \lesssim s \}" class="latex" />.</p>-<p>In words, we combine subsets <img src="http://l.wordpress.com/latex.php?latex=S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S" title="S" class="latex" /> and <img src="http://l.wordpress.com/latex.php?latex=T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="T" title="T" class="latex" /> by forming the set of objects from <img src="http://l.wordpress.com/latex.php?latex=S+%5Ccup+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \cup T" title="S \cup T" class="latex" /> which are not <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" /> any others, with the exception of objects <img src="http://l.wordpress.com/latex.php?latex=s+%5Cin+S%2C+t+%5Cin+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="s \in S, t \in T" title="s \in S, t \in T" class="latex" /> where both <img src="http://l.wordpress.com/latex.php?latex=s+%5Clesssim+t&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="s \lesssim t" title="s \lesssim t" class="latex" /> and <img src="http://l.wordpress.com/latex.php?latex=t+%5Clesssim+s&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="t \lesssim s" title="t \lesssim s" class="latex" />; in this case we keep <img src="http://l.wordpress.com/latex.php?latex=s&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="s" title="s" class="latex" /> but not <img src="http://l.wordpress.com/latex.php?latex=t&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="t" title="t" class="latex" />. This introduces a &#8220;left bias&#8221; to <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" />; there is also an equally valid version with right bias (in particular, <img src="http://l.wordpress.com/latex.php?latex=S+%5Coplus%27+T+%3D+%28T+%5Ctriangleleft+S%29+%5Ccup+%28T+%5Ctriangleright+S%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \oplus&#039; T = (T \triangleleft S) \cup (T \triangleright S)" title="S \oplus&#039; T = (T \triangleleft S) \cup (T \triangleright S)" class="latex" />).</p>-<p>Now, let&#8217;s show that this really does define a valid monoid. First, we need to show that <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" /> is closed over <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" />. Suppose <img src="http://l.wordpress.com/latex.php?latex=S%2C+T+%5Cin+P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S, T \in P_*" title="S, T \in P_*" class="latex" />. Suppose also that <img src="http://l.wordpress.com/latex.php?latex=x%2Cy+%5Cin+S+%5Coplus+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x,y \in S \oplus T" title="x,y \in S \oplus T" class="latex" /> are distinct elements of <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> with <img src="http://l.wordpress.com/latex.php?latex=x+%5Clesssim+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \lesssim y" title="x \lesssim y" class="latex" />; we&#8217;ll derive a contradiction. First, we cannot have <img src="http://l.wordpress.com/latex.php?latex=x%2Cy+%5Cin+S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x,y \in S" title="x,y \in S" class="latex" /> or <img src="http://l.wordpress.com/latex.php?latex=x%2Cy+%5Cin+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x,y \in T" title="x,y \in T" class="latex" /> by definition of <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" />. Now suppose <img src="http://l.wordpress.com/latex.php?latex=x+%5Cin+T%2C+y+%5Cin+S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \in T, y \in S" title="x \in T, y \in S" class="latex" />. The fact that <img src="http://l.wordpress.com/latex.php?latex=x+%5Cin+S+%5Coplus+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \in S \oplus T" title="x \in S \oplus T" class="latex" /> together with the definition of <img src="http://l.wordpress.com/latex.php?latex=S+%5Ctriangleright+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \triangleright T" title="S \triangleright T" class="latex" /> imply that we must have <img src="http://l.wordpress.com/latex.php?latex=x+%5Cnot+%5Clesssim+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \not \lesssim y" title="x \not \lesssim y" class="latex" />, a contradiction. Finally, suppose <img src="http://l.wordpress.com/latex.php?latex=x+%5Cin+S%2C+y+%5Cin+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \in S, y \in T" title="x \in S, y \in T" class="latex" />. Again, by the definition of <img src="http://l.wordpress.com/latex.php?latex=S+%5Ctriangleright+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \triangleright T" title="S \triangleright T" class="latex" /> we must have <img src="http://l.wordpress.com/latex.php?latex=y+%5Cnot+%5Clesssim+x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="y \not \lesssim x" title="y \not \lesssim x" class="latex" />. But then the fact that <img src="http://l.wordpress.com/latex.php?latex=x+%5Cin+S+%5Coplus+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \in S \oplus T" title="x \in S \oplus T" class="latex" />, together with the definition of <img src="http://l.wordpress.com/latex.php?latex=S+%5Ctriangleleft+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \triangleleft T" title="S \triangleleft T" class="latex" /> and the facts that <img src="http://l.wordpress.com/latex.php?latex=x+%5Cneq+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \neq y" title="x \neq y" class="latex" /> and <img src="http://l.wordpress.com/latex.php?latex=y+%5Cnot+%5Clesssim+x&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="y \not \lesssim x" title="y \not \lesssim x" class="latex" /> imply that <img src="http://l.wordpress.com/latex.php?latex=x+%5Cnot+%5Clesssim+y&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="x \not \lesssim y" title="x \not \lesssim y" class="latex" />, a contradiction again. Hence <img src="http://l.wordpress.com/latex.php?latex=S+%5Coplus+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \oplus T" title="S \oplus T" class="latex" /> contains no such pair of elements.</p>-<p>The fact that the empty set <img src="http://l.wordpress.com/latex.php?latex=%5Cvarnothing&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\varnothing" title="\varnothing" class="latex" /> is the identity for <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" /> is clear. (Incidentally, this is why we require that none of the sets in <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> contain two distinct elements with one <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" /> the other: if <img src="http://l.wordpress.com/latex.php?latex=S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S" title="S" class="latex" /> were such a set, we would have <img src="http://l.wordpress.com/latex.php?latex=%5Cvarnothing+%5Coplus+S+%5Cneq+S&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\varnothing \oplus S \neq S" title="\varnothing \oplus S \neq S" class="latex" />.) I leave the associativity of <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" /> as an exercise for the reader (translation: this post is already getting long, the associativity of <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" /> seems intuitively obvious to me, and I don&#8217;t feel like formalizing it at the moment &#8212; perhaps I&#8217;ll try writing it up later). I also leave as an interesting exercise the following theorem: if <img src="http://l.wordpress.com/latex.php?latex=S%2C+T+%5Cin+P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S, T \in P_*" title="S, T \in P_*" class="latex" /> are both finite and nonempty, then <img src="http://l.wordpress.com/latex.php?latex=S+%5Coplus+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \oplus T" title="S \oplus T" class="latex" /> is also finite and nonempty.</p>-<p>In our example from before, we could now begin with <img src="http://l.wordpress.com/latex.php?latex=%5C%7B1%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{1\}" title="\{1\}" class="latex" /> in our accumulator. After receiving the singleton set <img src="http://l.wordpress.com/latex.php?latex=%5C%7B4%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{4\}" title="\{4\}" class="latex" />, our accumulator would have that singleton set as its new value. Upon receiving <img src="http://l.wordpress.com/latex.php?latex=%5C%7B5%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{5\}" title="\{5\}" class="latex" />, our accumulator would become <img src="http://l.wordpress.com/latex.php?latex=%5C%7B4%2C5%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{4,5\}" title="\{4,5\}" class="latex" />. Receiving <img src="http://l.wordpress.com/latex.php?latex=%5C%7B10%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{10\}" title="\{10\}" class="latex" /> would result in <img src="http://l.wordpress.com/latex.php?latex=%5C%7B4%2C10%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{4,10\}" title="\{4,10\}" class="latex" /> (5 divides 10, so the 5 is discarded); if we later received <img src="http://l.wordpress.com/latex.php?latex=%5C%7B20%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{20\}" title="\{20\}" class="latex" />, we would simply have <img src="http://l.wordpress.com/latex.php?latex=%5C%7B20%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{20\}" title="\{20\}" class="latex" /> in our accumulator (both 4 and 10 divide 20).</p>-<p>I like to think of this as the monoid of <i>partial knowledge</i>. If we consider <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> to be a set of facts or beliefs, some better (more reliable, useful, correct, complete, etc.) than others, then elements of <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> correspond to possible sets of beliefs. <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" /> describes how a set of beliefs changes upon encountering a new set of facts; some of the new facts may supersede and replace old ones, some may not impart any new information, and some may be completely new facts that aren&#8217;t related to any currently known.</p>-<p>Now, why can this be thought of as a generalization of the monoid <img src="http://l.wordpress.com/latex.php?latex=%28P%2C+%5Cmax%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="(P, \max)" title="(P, \max)" class="latex" /> on a totally ordered set? Well, look what happens when we replace <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> in the definitions above with a totally ordered set with relation <img src="http://l.wordpress.com/latex.php?latex=%5Cleq&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\leq" title="\leq" class="latex" />: first of all, the restriction on <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> (no two elements of a set in <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> should be related by <img src="http://l.wordpress.com/latex.php?latex=%5Cleq&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\leq" title="\leq" class="latex" />) means that <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> contains only the empty set and singleton sets, so (ignoring the empty set) <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> is isomorphic to <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" />. Now look at the definition of <img src="http://l.wordpress.com/latex.php?latex=S+%5Ctriangleleft+T&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \triangleleft T" title="S \triangleleft T" class="latex" />, with <img src="http://l.wordpress.com/latex.php?latex=%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\lesssim" title="\lesssim" class="latex" /> replaced by <img src="http://l.wordpress.com/latex.php?latex=%5Cleq&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\leq" title="\leq" class="latex" /> (and <img src="http://l.wordpress.com/latex.php?latex=%5Cnot+%5Clesssim&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\not \lesssim" title="\not \lesssim" class="latex" /> replaced by <img src="http://l.wordpress.com/latex.php?latex=%3E&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="&gt;" title="&gt;" class="latex" />):</p>-<p><img src="http://l.wordpress.com/latex.php?latex=S+%5Ctriangleleft+T+%3D+%5C%7B+s+%5Cin+S+%5Cmid+%5Cforall+t+%5Cin+T%2C+s+%3D+t+%5Cmbox%7B+or+%7D+t+%5Cleq+s+%5Cmbox%7B+or+%7D+s+%3E+t+%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="S \triangleleft T = \{ s \in S \mid \forall t \in T, s = t \mbox{ or } t \leq s \mbox{ or } s &gt; t \}" title="S \triangleleft T = \{ s \in S \mid \forall t \in T, s = t \mbox{ or } t \leq s \mbox{ or } s &gt; t \}" class="latex" /></p>-<p>But <img src="http://l.wordpress.com/latex.php?latex=s+%3D+t&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="s = t" title="s = t" class="latex" /> and <img src="http://l.wordpress.com/latex.php?latex=s+%3E+t&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="s &gt; t" title="s &gt; t" class="latex" /> are both subsumed by <img src="http://l.wordpress.com/latex.php?latex=t+%5Cleq+s&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="t \leq s" title="t \leq s" class="latex" />, so we can rewrite this as</p>-<p><img src="http://l.wordpress.com/latex.php?latex=%5C%7Bs%5C%7D+%5Ctriangleleft+%5C%7Bt%5C%7D+%3D+%5C%7Bs%5C%7D+%5Cmbox%7B+if+%7D+s+%5Cgeq+t%2C+%5Cmbox%7B+or+%7D+%5Cvarnothing+%5Cmbox%7B+otherwise+%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{s\} \triangleleft \{t\} = \{s\} \mbox{ if } s \geq t, \mbox{ or } \varnothing \mbox{ otherwise }" title="\{s\} \triangleleft \{t\} = \{s\} \mbox{ if } s \geq t, \mbox{ or } \varnothing \mbox{ otherwise }" class="latex" />.</p>-<p>An analysis of <img src="http://l.wordpress.com/latex.php?latex=%5Ctriangleright&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\triangleright" title="\triangleright" class="latex" /> is similar, and it is clear that <img src="http://l.wordpress.com/latex.php?latex=%5C%7Bs%5C%7D+%5Coplus+%5C%7Bt%5C%7D+%3D+%5C%7B%5Cmax%28s%2Ct%29%5C%7D&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\{s\} \oplus \{t\} = \{\max(s,t)\}" title="\{s\} \oplus \{t\} = \{\max(s,t)\}" class="latex" />.</p>-<p>I note in passing that although it might appear shady that I swept that &#8220;ignoring the empty set&#8221; bit under the rug, everything really does check out: technically, to see a direct generalization of <img src="http://l.wordpress.com/latex.php?latex=%28P%2C%5Cmax%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="(P,\max)" title="(P,\max)" class="latex" /> to <img src="http://l.wordpress.com/latex.php?latex=%28P_%2A%2C+%5Coplus%29&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="(P_*, \oplus)" title="(P_*, \oplus)" class="latex" />, we can require that <img src="http://l.wordpress.com/latex.php?latex=P&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P" title="P" class="latex" /> have an initial object and that <img src="http://l.wordpress.com/latex.php?latex=P_%2A&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="P_*" title="P_*" class="latex" /> contains only finite, nonempty sets. Then it requires a bit more work to prove that <img src="http://l.wordpress.com/latex.php?latex=%5Coplus&amp;bg=ffffff&amp;fg=333333&amp;s=0" alt="\oplus" title="\oplus" class="latex" /> is closed, but it still goes through. I used the formulation I did since it seems more general and requires less proving.</p>-<p>Anyway, this ended up being longer than I originally anticipated (why does that always happen!? =), so I&#8217;ll stop here for now, but next time I&#8217;ll give some actual Haskell code (which I think ends up being pretty neat!), and talk about one relatively common design pattern which is actually a special case of this monoid.</p>-<img alt="" border="0" src="http://feeds.wordpress.com/1.0/categories/byorgey.wordpress.com/62/" /> <img alt="" border="0" src="http://feeds.wordpress.com/1.0/tags/byorgey.wordpress.com/62/" /> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/gocomments/byorgey.wordpress.com/62/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/comments/byorgey.wordpress.com/62/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/godelicious/byorgey.wordpress.com/62/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/delicious/byorgey.wordpress.com/62/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/gostumble/byorgey.wordpress.com/62/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/stumble/byorgey.wordpress.com/62/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/godigg/byorgey.wordpress.com/62/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/digg/byorgey.wordpress.com/62/" /></a> <a rel="nofollow" href="http://feeds.wordpress.com/1.0/goreddit/byorgey.wordpress.com/62/"><img alt="" border="0" src="http://feeds.wordpress.com/1.0/reddit/byorgey.wordpress.com/62/" /></a> <img alt="" border="0" src="http://stats.wordpress.com/b.gif?host=byorgey.wordpress.com&amp;blog=1152889&amp;post=62&amp;subd=byorgey&amp;ref=&amp;feed=1" /></div></description>- <pubDate>Thu, 17 Apr 2008 19:37:24 +0000</pubDate>- <dc:creator>Brent</dc:creator>-</item>-<item>- <title>Joachim Breitner: Announcing DarcsWatch</title>- <guid isPermalink="false">http://www.joachim-breitner.de/blog/archives/290-guid.html</guid>- <link>http://www.joachim-breitner.de/blog/archives/290-Announcing-DarcsWatch.html</link>- <description><p>A lot of haskell-related projects use the <a href="http://darcs.net/">darcs</a> version control system. Darcs has the nice feature that you can easily submit a patch by e-mail, usually sent to the project maintainer or a mailing list. What has bothered me in the past was that I had to manually check whether my patch was applied yet.</p><p>So this week, I wrote <a href="http://darcs.nomeata.de/">DarcsWatch</a>. DarcsWatch receives submitted patches and compares them to the repositories it knows about, whether the patch is missing there or not. You either send your patches to DarcsWeb directly when submitting them, using CC, or DarcsWatch is subscribed to the project mailing list itself, which is the case for the <a href="http://lists.osuosl.org/mailman/listinfo/darcs-devel">darcs-devel</a> and <a href="http://www.haskell.org/mailman/listinfo/xmonad">xmonad</a> lists. Other than that, not much is to do, and you’ll find a nice overview of your patches, like this <a href="http://darcswatch.nomeata.de/user_mail@joachim-breitner.de.html">overview of my patches</a>, with diffs and download links.</p><p>If you want to use DarcsWatch for your contributions to other projects, or for your own projects, have a look the <a href="http://darcs.nomeata.de/darcswatch/documentation.html">documentation</a>. There are probably still bugs around, and the problem of marking patches as obsolete is not really solved yet, so if you have ideas about it, mail me, comment here, or come to #darcs on freenode. Patches are always welcome, you can get the source from <a href="http://darcs.nomeata.de/darcswatch/">DarcsWatch’s repository</a>.</p></description>- <pubDate>Thu, 17 Apr 2008 17:25:15 +0000</pubDate>- <dc:creator>mail@joachim-breitner.de (nomeata)</dc:creator>-</item>-<item>- <title>Mark Jason Dominus: Is blood a transitive relation?</title>- <guid isPermalink="false">tag:blog.plover.com,2008:/oops/blood-relatives</guid>- <link>http://blog.plover.com/oops/blood-relatives.html</link>- <description>When you're first teaching high school students about the idea of a-relation, you give examples of the important properties of relations.-Relations can be some, none, or all of reflexive, symmetric,-antisymmetric, or transitive. You start with examples that everyone-is already familiar with, such as the identity relation, which is-reflexive, symmetric, and transitive, and the &le; relation, which is-antisymmetric and transitive. Other good examples include familial-relations: "sister-in-law of" is symmetric on the set of women, but-not on the larger set of people; "ancestor of" is transitive but not-symmetric.<p>--It might seem at first glance that "is related to" is transitive, but,-at least under conventional definitions, it isn't, because my wife is-not related to my cousins.<p>--(I was once invited to speak at Haverford College, and,-since I have no obvious qualifications in <a href="http://perl.plover.com/yak/cftalk/">the topic on which I was speaking</a>, I was asked how I-had come to be there. I explained that it was because <a href="http://www.haverford.edu/math/lbutler.html">my wife's mother's-younger brother's daughter's husband's older brother's wife was the-chair of the mathematics department</a>. Remember, it's not what you-know, it's who you know.)<p>--I think I had sometimes tried to turn "related to" into a transitive-relation by restricting it to "is related to by blood". This rules-out the example above of my wife being unrelated to my cousins,-because my relationship with my wife is not one of blood. I don't-quite remember using "related by blood" as an example of a transitive-relation, but I think I might have, because I was quite surprised when-I realized that it didn't work. I spent a lot of time that morning-going over my counterexample in detail, writing it up in my head, as-it were. I was waiting around in Trevose for the mechanic to finish-examining my car, and had nothing better to do that morning. If I had-had a blog then, I would probably have posted it. But it is a good-thing that I didn't, because in spite of all my thought about it, I-missed something important.<p>--The example is as follows. <i>A</i> and <i>B</i> have a child,-<i>X</i>. (You may suppose that they marry beforehand, and divorce-afterward, if your morality requires it.) Similarly, <i>C</i> and-<i>D</i> have a child, <i>Z</i>. Then <i>B</i> and <i>C</i> have a-child <i>Y</i>. <i>Y</i> is now the half-sibling of both <i>X</i> and-<i>Z</i>, and so is unquestionably a blood relative of both, but-<i>X</i> and <i>Z</i> are entirely unrelated. They are not even-step-siblings.<p>--Well, this is all very well, but the reason I have filed it under <a href="http://blog.plover.com/oops/">oops/</a>, and the reason it's a good thing I-didn't post it on my (then nonexistent) blog is that this elaborate-counterexample contains a much simpler one: <i>X</i> is the child and-hence the blood relative of-both <i>A</i> and <i>B</i>, who are not in general related to-each other. <i>C</i>, <i>D</i>, <i>Y</i>, and <i>Z</i> are wholly-unnecessary.<p>--I wish I had some nice conclusion to draw here, but if there's-something I could learn from it I can't think would it might be.<p>--<!----That is all I meant to write about, but I am in the waiting room at-the Parking Authority, waiting to protest a ticket, so I have lots of-time, and I may as well go on for a while.<p>--At my last regular job, one of my co-workers observed that everyone on-the corridor was part-Asian. Her mother was Japanese; another-colleague's was Thai. One colleague was Bengali. "I am on this-corridor," I said, "and I am not Asian." "You have blood relatives-who are Asian," she pointed out, which I had not really though of-before. Iris had recently been born, and she is half-Korean.<p>--When Iris was still <i>in utero</i>, Lorrie and I visited a genetic-counselor whose job was to judge the chance that Iris might come out-with some hereditary disorder. She asked me many questions about my-forebears, which I answered in my characteristically guarded way: "Is-there any history of Tay-Sachs disease in your family?" "Not so far-as I know." "I am not aware of any." "I believe not." And so on.<p>--But then she got to a more general question: "Is there any possibility-that you and Lorrie might be related?" And I laughed, and said-heartily, "None whatsoever!". <p>----></p></p></p></p></p></p></p></description>- <pubDate>Thu, 17 Apr 2008 17:05:00 +0000</pubDate>- <dc:creator>Mark Dominus</dc:creator>-</item>-<item>- <title>Conrad Parker: :rikaichan for Vimperator</title>- <guid isPermalink="false">tag:blogger.com,1999:blog-9101292118679422945.post-8373941523429907668</guid>- <link>http://blog.kfish.org/2008/04/rikaichan-for-vimperator.html</link>- <description><p>-Some of my favourite Firefox plugins are:-<ul>-<li><a href="http://www.polarcloud.com/rikaichan/">Rikaichan</a>, a Japanese dictionary, which adds instant translation popups when you mouse over a word;</li>-<li><a href="http://vimperator.mozdev.org/">Vimperator</a>, which provides <tt>vi</tt>-like user interface;</li>-<li>and <a href="https://addons.mozilla.org/en-US/firefox/addon/1337">Hide Tab Bar</a>, because Vimperator's buffer list is more useful.</li>-</ul>-<p>-Vimperator hides the menu bar by default. <b>Tools->Toggle Rikaichan</b> has no default keybinding, and the keybindings to navigate the menubar are not available if the menubar is not visible, so Rikaichan can no longer be activated.-</p>-<p>-The following adds a vimperator command <tt>:rikaichan</tt>; save it to <tt>.vimperator/plugin/toggleRikaichan.js</tt>:--<blockquote><pre>-(function(){- vimperator.commands.add(new vimperator.Command(- ['rikaichan', 'rikai'],- function(){- rcxMain.inlineToggle();- }- ))-}) ();-</pre></blockquote>-</p>-<p>-It is aliased to <tt>:rikai</tt> for short, but unfortunately vimperator won't recognize <tt>:理解</tt>.-Thanks to ktsukagoshi for the explanation of how to write a vimperator plugin (<a href="http://d.hatena.ne.jp/ktsukagoshi/20080305/1204730962">vimperatorのプラグインの作成</a>).-</p>-<p>-<i>Remember, <a href="http://www.vergenet.net/~conrad/syre/">the interface is inside your mind</a>.</i>-</p></p></description>- <pubDate>Thu, 17 Apr 2008 16:01:22 +0000</pubDate>- <dc:creator>Conrad Parker</dc:creator>-</item>-<item>- <title>Philip Wadler: Fun with correlation and citations</title>- <guid isPermalink="false">tag:blogger.com,1999:blog-9757377.post-9088874984566084902</guid>- <link>http://wadler.blogspot.com/2008/04/fun-with-correllation-and-citations.html</link>- <description>I'm sure I'll want to cite this someday, possibly in class but perhaps in the pub. What I'll be citing it as an example of, I'm not yet sure. Thanks to Leonid Libkin for spotting this.</description>- <pubDate>Thu, 17 Apr 2008 10:00:50 +0000</pubDate>- <dc:creator>Philip Wadler</dc:creator>-</item>-<item>- <title>Kenn Knowles: Drawing fractals in Haskell with a cursor graphics DSEL and a cute list representation</title>- <guid isPermalink="false">http://www.kennknowles.com/blog/2008/04/16/drawing-fractals-in-haskell-with-a-cursor-graphics-dsel-and-a-cute-list-representation/</guid>- <link>http://www.kennknowles.com/blog/2008/04/16/drawing-fractals-in-haskell-with-a-cursor-graphics-dsel-and-a-cute-list-representation/</link>- <description><p>I'm reading the very fun <em>Measure, Topology, and Fractal Geometry</em> by GA Edgar, and thought I'd hack up some of the examples in Haskell. So this post implements cursor graphics in OpenGL in (I think) DSEL style, demonstrating the <code>StateT</code> and <code>Writer</code> monad gadgets from the-standard library and a cool "novel representation of lists" due to R Hughes. On the fractal side, the examples will hopefully convince you that fractals are not just cute pictures, but extremely important illustrations that the real numbers are weird. As usual, you can save this post to <code>Fractals.lhs</code> and compile it with <code>ghc --make Fractals</code>- <a href="http://www.kennknowles.com/blog/2008/04/16/drawing-fractals-in-haskell-with-a-cursor-graphics-dsel-and-a-cute-list-representation/#more-42" class="more-link">(more&#8230;)</a></p></description>- <pubDate>Wed, 16 Apr 2008 18:02:52 +0000</pubDate>- <dc:creator>Kenn</dc:creator>-</item>-<item>- <title>Luke Palmer: Symphonic Poem no. 1</title>- <guid isPermalink="false">http://luqui.org/blog?p=517</guid>- <link>http://luqui.org/blog/archives/2008/04/16/symphonic-poem-no-1/</link>- <description><p>I just finished, in some sense, <a href="http://luqui.org/music/progress/symphonic_poems/01.mp3">the first</a> of a series (hopefully) of symphonic poems. I took a long break in the middle of writing this, so I could be mistaken, but I think it took about 20 hours total. It still needs a little tweaking; in particular some of the harmonies on the climaxes are drowned out by the percussion and poor instrument balancing, and I&#8217;m not sure if I&#8217;m happy with the ending (it&#8217;s meant to be a little unsettling&#8230;). But the idea is there.</p></description>- <pubDate>Wed, 16 Apr 2008 11:21:47 +0000</pubDate>- <dc:creator>Luke</dc:creator>-</item>-<item>- <title>John Goerzen (CosmicRay): datapacker</title>- <guid isPermalink="false">http://changelog.complete.org/posts/707-guid.html</guid>- <link>http://changelog.complete.org/posts/707-datapacker.html</link>- <description>Every so often, I come across some utility that need. I think it <b>must</b> have been written before, but I can't find it.<br />-<br />-Today I needed a tool to take a set of files and split them up into directories in a size that will fit on DVDs. I wanted a tool that could either produce the minimum number of DVDs, or keep the files in order. I couldn't find one. So I wrote <a href="http://software.complete.org/datapacker">datapacker</a>.<br />-<br />-datapacker is a tool to group files by size. It is perhaps most often used to fit a set of files onto the minimum number of CDs or DVDs.<br />-<br />-datapacker is designed to group files such that they fill fixed-size containers (called "bins") using the minimum number of containers. This is useful, for instance, if you want to archive a number of files to CD or DVD, and want to organize them such that you use the minimum possible number of CDs or DVDs.<br />-<br />-In many cases, datapacker executes almost instantaneously. Of particular note, the hardlink action can be used to effectively copy data into bins without having to actually copy the data at all.<br />-<br />-datapacker is a tool in the traditional Unix style; it can be used in pipes and call other tools.<br />-<br />-I have, of course, uploaded it to sid. But while it sits in NEW, you can download the source tarball (with debian/ directory) from the project homepage at <a href="http://software.complete.org/datapacker">http://software.complete.org/datapacker</a>. I've also got an <a href="http://software.complete.org/datapacker/static/doc/datapacker.html">HTML version of the manpage</a> online, so you can see all the cool features of datapacker. It works nicely with find, xargs, mkisofs, and any other Unixy pipe-friendly program.<br />-<br />-Those of you that know me will not be surprised that I wrote datapacker in Haskell. For this project, I added a <a href="http://en.wikipedia.org/wiki/Bin_packing_problem">bin-packing</a> module and support for parsing inputs like <tt>1.5g</tt> to <a href="http://software.complete.org/missingh">MissingH</a>. So everyone else that needs to do that sort of thing can now use library functions for it.<br />-<br />-<b>Update...</b> I should have mentioned the <b>really cool thing</b> about this. After datapacker compiled and ran, I had only <b>one mistake</b> that was not caught by the Haskell compiler: I said &lt; where I should have said &lt;= one place. This is one of the very nice things about Haskell: the language lends itself to compilers that can catch so much. It's not that I'm a perfect programmer, just that my compiler is pretty crafty.</description>- <pubDate>Wed, 16 Apr 2008 04:09:53 +0000</pubDate>- <dc:creator>nospam@example.com (John Goerzen)</dc:creator>-</item>-<item>- <title>Nick Mudge: Inelegance of Combining HTML and Code</title>- <guid isPermalink="false">http://nickmudge.info?post=92</guid>- <link>http://nickmudge.info?post=92</link>- <description><p>-I thought I’d shoot off an idea about programming webpages.-</p>-<p>-To me writing a script to generate HTML has always been a problem. It’s a problem because you have to mix a bunch of code with HTML. No matter how you mix more than a little bit of code and HTML the result is inelegance, ugly code, hard to read code. It’s not very good because you’re mixing two different syntaxes together in a jumbled fashion. Code that is just code without HTML in it so much nicer and easy to follow and read. And gosh, I’m always perturbed about how to indent code and HTML together so that structure and things can be made clearer. The elegance, clarity and structure provided by indentation is reduced a lot by the combination of programming logic and HTML intermingled, at least from my experience.-</p>-<p>-There’s been various ways to help make this better. For instance in PHP you can move in and out of HTML and PHP modes which makes the transitions nicer sometimes. The <a href="http://www.smarty.net/">Smarty templating system</a> is largely a system to make this easier. The Smarty language syntax and tools integrate nicer with HTML and help keep programming away from HTML. This also has a nice benefit of being nice to designers that need to work with HTML and CSS but don’t want to hassle with programming.-</p>-<p>-Smarty is a nice improvement and the best solution I’ve used so far but the problem is still there. Sometimes you want to add quite a bit of logic to your Smarty templates, adding loops, and inner loops, adding lots of if conditions, making function calls etc. You might want to do this because the display of the webpage you are making is complex and requires lots of if conditions and loops or because you want to reuse the same templates for different webpages (this cuts down the amount of work you need to do and manage – reuse is good) and so need to add additional logic that runs depending on which page the template is being used to generate. Too much logic in Smarty templates quickly gets inelegant and hard.-</p>-<p>-Things get inelegant and harder to follow when you start adding a bunch of logic to HTML pages. It’s like HTML wasn’t meant to have logic in it.-</p>-<p>-A related problem that is also a big problem with HTML is that it does not scale. The bigger an HTML file gets the harder it is to follow and work with. With a zillion div tags and table tags it gets harder and harder to know what exactly is happening anywhere in a document. It just doesn’t scale. This combined with logic makes for general ickyness. -</p>-<p>-I wonder if there is another way.-</p>-<p>-I’ve looked into Lisp a little in the past and what I’ve seen is that in Common Lisp the combination of programming and HTML are handled in a completely different way. I wonder if something here could be a real solution to this inelegance pest, and actually really bring about an elegance and smoothness in the combination of programming logic and HTML.-</p>-<p>-From what I've seen in Common Lisp when you program webpages you don’t really mix HTML and programming. Instead you make it all programming. I’m thinking it might be something along these lines: You have a library of functions and/or macors. Each function or macro or arguement corresponds to an HTML tag. For instance you have the div function that is used to generate the HTML for a div tag etc. You just use all these functions that generate all the HTML for you. And it’s easy and natural to add logic because it’s all consistent programming code. You keep the consistency, elegance and scalability of a programming language by only programming in the programming language.-</p>-<p>-The main problem I see with this approach of using functions to generate HTML is that HTML is highly flexible -- some tags can have certain attributes and can be nestled within some tags but not others and there’s a ton of variance and things you can do in HTML. In lots of programming languages I think functions are probably not flexible enough to cope with all the possibilities. I think these functions would limit what you could do with HTML and cut your flexibility of how you want the HTML to be. It really might not be very workable. I certainly don’t like to code with constraints on me.-</p>-<p>-But maybe it’s possible with something like Lisp. You’d need finely grained functions/macros that had the same flexibility and limitations as the HTML tags. And I think that’s something Lisp might be able to provide. In Lisp you have finely grained control on what your functions are and how they work – more than I’ve seen anywhere. In addition Lisp has powerful macro abilities that enable you to mold the syntax and semantics of the language to your will. This fine grainess of control on the syntax and semantics of the language might enable you to write a library of HTML functions that you could use to write pure elegant code that generates all the HTML you need and with as much flexibility as you need. Perhaps this already exists.-</p>-<p>-I think something like this would make it much easier and faster to work with webpages because pure well written code is much easier to write and read than a mess of HTML and code together. With code you have one consistent syntax and it scales better than HTML does. In addition if your functions are perfect (have no bugs in their implementation), then any HTML you generate with them should automatically be perfect too – that’s real scalability power when talking about HTML correctness.-</p>-<p>-Of course this pure programming way of handling HTML might not be so good for designers. So I was thinking that there could be some kind of separate interface for designers – like CSS is a separate interface into the display of HTML and a webpage. One idea is that a designer could design stuff in pure HTML and CSS and then feed it into a program that analyses it and if it is correct HTML and CSS generates or modifies the programming code to generate that HTML and CSS and if it is wrong spits the HTML and CSS back to the designer to fix.-</p>-<hr />-<p>-From Chris Minnick:-</p>-<p>-Good thoughts, Nick.-</p>-<p>-I see what you’re getting at, but I’m skeptical of solutions to make code or HTML more 'pure'. It seems like no matter what you do, someone is going to start slipping some HTML in where it doesn’t belong, or is going to put something that should be in the CSS into the HTML, or is going to use tables for layout, or what-have-you. Usually, people resist doing things the 'right' way because the right way is more difficult or doesn't work right.-</p>-<p>-CSS positioning is a perfect example: purists insist that all Web page layout should be done with divs and CSS, and that tables should only be used for tabular data. This makes perfect sense, of course, but the reality is that you just can’t do some of the things you can do with tables using divs, or it’s very difficult—especially considering browser differences. -</p>-<p>-So, what usually ends up happening as a result of this is that the people who were insisting on purity start backing off … so, now RSS 2.0 is popular, while the strict RDF version (RSS 1.1) was a big flop, and HTML 5 is going to be the successor to XHTML because people continued to use the much more flexible HTML 4.01 years and years after the stricter XHTML 1.0 came out.-</p>-<p>-My question is: would the benefits of writing HTML using functions outweigh the added complexity and inconvenience to people who design webpages?-</p>-<hr />-<p>-From Nick Mudge:-</p>-<p>-Hey Chris,-</p>-<p>-I totally agree and excellent point. Your email made me realize that ideally the functions should be flexible enough to allow people to be as non-standard and/or hacky as they want. I think people should have the freedom to do things how they want. I think the functions should prevent obvious errors like a &lt;div&gt; without a &lt;/div&gt; and things that will obviously break webpages in web browsers. It would be nice if it could also help people be as standard as they want by letting them set some global setting or something so that functions enforce more strictness to a standard or whatever they want.-</p>-<p>-I think the goal of a library like this would be to enable programmers to combine programming and HTML in way that is syntactically consistent, easier to read, write and maintain without loosing the flexibility that they want. Or to achieve a scalable elegance with the combination of logic and HTML. Perhaps a secondary goal would be to help people create HTML as correct or as standard/unstandard as they want.-</p>-<p>-Any system around the functions/macro library such as a program that translates HTML into code that generates the same HTML should be as flexible to the user as the functions.-</p>-<p>-I think a designer who does HTML and CSS work would use some program that does an HTML to code translation and the designer should have a way to specify how loose the translator is in accepting HTML and CSS. And I think programmers would just work in the code. -</p></description>- <pubDate>Tue, 15 Apr 2008 00:00:00 +0000</pubDate>-</item>-<item>- <title>Luke Palmer: SNW Backlogging</title>- <guid isPermalink="false">http://luqui.org/blog?p=516</guid>- <link>http://luqui.org/blog/archives/2008/04/14/snw-backlogging/</link>- <description><p>SNW is dead <tt>:-(</tt>. But I still have some recordings lying around that I&#8217;m gradually editing. Here&#8217;s the first batch, from March 20:</p>-<ul>- <li><a href="http://luqui.org/music/improv/2008-03-20_01.mp3">01</a></li>- <li><a href="http://luqui.org/music/improv/2008-03-20_02.mp3">02</a> - a minimalist (in the classical sense) exercise</li>- <li><a href="http://luqui.org/music/improv/2008-03-20_03.mp3">03</a></li>- <li><a href="http://luqui.org/music/improv/2008-03-20_04.mp3">04</a> - fun and funky</li>- <li><a href="http://luqui.org/music/improv/2008-03-20_05.mp3">05</a> - a long piece with many sections, pretty upbeat</li>-</ul>-<p>#01 and #03 are included for completeness; they suck <tt>:-p</tt>. The rest are pretty good.</p></description>- <pubDate>Mon, 14 Apr 2008 21:28:13 +0000</pubDate>- <dc:creator>Luke</dc:creator>-</item>-<item>- <title>Conrad Parker: Continuation Fest 2008: Continuations for video decoding and scrubbing</title>- <guid isPermalink="false">tag:blogger.com,1999:blog-9101292118679422945.post-8478267578838678327</guid>- <link>http://blog.kfish.org/2008/04/continuation-fest-2008-continuations.html</link>- <description><p>-Yesterday was <a href="http://logic.cs.tsukuba.ac.jp/Continuation/">Continuation Fest 2008</a>,-at the University of Tokyo's campus in Akihabara (a very nice venue!).-It was very well attended; latecomers overflowed to a second room and participated by video conference. It was a little strange to see so many people interested in such an-<strike>obscure, troublesome and malignant</strike> expressively powerful-programming construct; the breadth of talks made for a very inspiring and practical introduction to the theory, applications and implementation of continuations in many different languages.-</p>-<p>-I recommend reading-<a href="http://pllab.is.ocha.ac.jp/~asai/">Kenichi Asai</a>'s-introduction to delimited continuations-(<a href="http://pllab.is.ocha.ac.jp/~asai/papers/contfest08slide.pdf">slides</a> [PDF]).-He introduced the <tt>shift</tt> and <tt>reset</tt> operators-through the problem of expressing exceptional control flow, and-then explained how to use these to type (ie. determine a concrete type for)-<tt>printf</tt>. The main point was that-<tt>shift/reset</tt> provide a high-level abstraction over control flow, with minimal impact-on the implementation of your existing functions.-</p>-<p>-<a href="http://okmij.org/ftp/">Oleg Kiselyov</a> demonstrated some new code for transactional-web applications, using delimited continuations for explicit state sharing between parallel connections. The result is that the user has a consistent view across multiple tabs are open on the same site, and the state is transactional so that there is no need for warnings like "Do not press the BUY button more than once!". He said that everyone already understands delimited continuations, they just don't realize it.-</p>-<p>-The topic of my presentation at Continuation Fest was-<b>Continuations for video decoding and scrubbing</b>:-</p>-<blockquote><p>-Playback of encoded video involves scheduling the decoding of audio and video frames and synchronizing their playback. "Scrubbing" is the ability to quickly seek to and display an arbitrary frame, and is a common user interface requirement for a video editor. The implementation of playback and scrubbing is complicated by data dependencies in compressed video formats, which require setup and manipulation of decoder state.-</p><p>-We present the preliminary design of a continuation-based system for video decoding, reified as a cursor into a stream of decoded video frames. Frames are decoded lazily, and decoder states are recreated or restored when seeking. To reduce space requirements, a sequence of decoded frames can be replaced after use by the continuation which created them.-<strike>We outline implementations in Haskell and C.</strike>-</p></blockquote>-<p>-<ul>-<li><a href="http://seq.kfish.org/~conrad/static/continuation-fest-2008/continuations-for-video.pdf">Slides</a> [383KB PDF]</li>-<li><a href="http://seq.kfish.org/~conrad/static/continuation-fest-2008/continuations-for-video.article.pdf">Article</a> [215KB PDF]</li>-</ul>-</p>--<p>I'll be introducing the code for this over the next few months.-Whereas in my presentation about-<a href="http://blog.kfish.org/2008/03/bossa-2008-video-player-internals.html">video player internals</a> at BOSSA I outlined the problem space in designing a multimedia architecture,-at Continuation Fest I tried to break it down into subproblems and considered-useful data structures and programming techniques for dealing with them.-</p>-<p>-I got a lot of great feedback, and I think I succeeded in my mission to introduce this problem space to some really smart people.-Thanks particularly to-<a href="http://www.cs.rutgers.edu/~ccshan">Chung-chieh Shan</a> for some insightful ideas-about how to deal with existing stateful codec implementations. It was also very interesting to-talk with-<a href="http://www.ie.u-ryukyu.ac.jp/~kono/index-e.html">Shinji Kono</a> about-<a href="http://sourceforge.jp/projects/cbc/">Continuation-based C (cBc)</a>-(<a href="http://www.ie.u-ryukyu.ac.jp/~kono/tmp/cf08-kono.tgz">slides</a> [HTML tarball]),-a C-like language capable of expressing continuations, non-local jumps, multiple function entry-points, and assorted other ways to shoot yourself in the foot. He suggested that it was designed for exactly the kind of thing I'm doing, and I'll be interested to try it-out. It is implemented in a modifed GCC 4.x as an RTL code generator, so should now be (fairly)-architecture-independent.-</p>-<p>-Thanks to the organizers of Continuation Fest 2008 for putting together such a useful and interesting event. I look forward to implementing just some of the things I learned :-)-</p></description>- <pubDate>Mon, 14 Apr 2008 18:10:56 +0000</pubDate>- <dc:creator>Conrad Parker</dc:creator>-</item>-<item>- <title>John Goerzen (CosmicRay): Backup Software</title>- <guid isPermalink="false">http://changelog.complete.org/posts/706-guid.html</guid>- <link>http://changelog.complete.org/posts/706-Backup-Software.html</link>- <description><p>I think most people reading my blog would agree that backups are extremely important. So much important data is on computers these days: family photos, emails, financial records. So I take backups seriously.-</p><br />-<p>-A little while back, I purchased two identical 400GB external hard disks. One is kept at home, and the other at a safe deposit box in a bank in a different town. Every week or two, I swap drives, so that neither one ever becomes too dated. This process is relatively inexpensive (safe deposit boxes big enough to hold the drive go for $25/year), and works well.-</p><br />-<p>-I have been using <a href="http://www.nongnu.org/rdiff-backup/">rdiff-backup</a> to make these backups for several years now. (Since at least 2004, when I submitted a patch to make it record all metadata on MacOS X). rdiff-backup is quite nice. It is designed for storage to a hard disk. It stores on the disk a current filesystem mirror along with some metadata files that include permissions information. History is achieved by storing compressed rdiff (rsync) deltas going backwards in time. So restoring "most recent" files is a simple copy plus application of metadata, and restoring older files means reversing history. rdiff-backup does both automatically.-</p><br />-<p>-This is a nice system and has served me well for quite some time. But it has its drawbacks. One is that you always have to have the current image, uncompressed, which uses up lots of space. Another is that you can't encrypt these backups with something like gpg for storage on a potentially untrusted hosting service (say, rsync.net). Also, when your backup disk fills up, it takes forever to figure out what to delete, since rdiff-backup --list-increment-sizes must stat tens of thousands of files. So I went looking for alternatives.-</p><br />-<p>-The author of rdiff-backup actually wrote one, called <a href="http://duplicity.nongnu.org/">duplicity</a>. Duplicity works by, essentially, storing a tarball full backup with its rdiff signature, then storing tarballs of rdiff deltas going forward in time. The reason rdiff-backup must have the full mirror is that it must generate rdiff deltas "backwards", which requires the full prior file available. Duplicity works around this.-</p><br />-<p>-However, the problem with duplicity is that if the full backup gets lost or corrupted, nothing newer than it can be restored. You must make new full backups periodically so that you can remove the old history. The other big problem with duplicity is that it doesn't grok hard links at all. That makes it unsuitable for backing up /sbin, /bin, /usr, and my /home, in which I frequently use hard links for preparing CD images, linking DVCS branches, etc.-</p><br />-<p>-So I went off searching out other projects and thinking about the problem myself.-</p><br />-<p>-One potential solution is to simply store tarballs and rdiff deltas going forward. That would require performing an entire full backup every day, which probably isn't a problem for me now, but I worry about the load that will place on my hard disks and the additional power it would consume to process all that data.-</p><br />-<p>-So what other projects are out there? Two caught my attention. The first is <a href="http://www.boxbackup.org/">Box Backup</a>. It is similar in concept to rdiff-backup. It has its own archive format, and otherwise operates on a similar principle to rdiff-backup. It stores the most recent data in its archive format, compressed, along with the signatures for it. Then it generates reverse deltas similar to rdiff-backup. It supports encryption out of the box, too. It sounded like a perfect solution. Then I realized it <a href="http://lists.warhead.org.uk/pipermail/boxbackup/2008-April/004338.html">doesn't store hard links</a>, device entries, etc., and has a design flaw that causes it to miss some changes to config files in /etc on Gentoo. That's a real bummer, because it sounded so nice otherwise. But I just can't trust my system to a program where I have to be careful not to use certain OS features because they won't be backed up right.-</p><br />-<p>-The other interesting one is <a href="http://dar.linux.free.fr/">dar</a>, the Disk ARchive tool, described by its author as the great grandson of tar -- and a pretty legitimate claim at that. Traditionally, if you are going to back up a Unix box, you have to choose between two not-quite-perfect options. You could use something like tar, which backs up all your permissions, special files, hard links, etc, but doesn't support random access. So to extract just one file, tar will read through the 5GB before it in the archive. Or you could use zip, which doesn't handle all the special stuff, but does support random access. Over the years, many backup systems have improved upon this in various ways. Bacula, for instance, is incredibly fast for tapes as it creates new tape "files" every so often and stores the precise tape location of each file in its database.-</p><br />-<p>-But none seem quite as nice as dar for disk backups. In addition to supporting all the special stuff out there, dar sports built-in compression and encryption. Unlike tar, compression is applied per-file, and encryption is applied per 10K block, which is really slick. This allows you to extract one file without having to decrypt and decompress the entire archive. dar also maintains a catalog which permits random access, has built-in support for splitting archives across removable media like CD-Rs, has a nice incremental backup feature, and sports a host of tools for tweaking archives -- removing files from them, changing compression schemes, etc.-</p><br />-<p>-But dar does not use binary deltas. I thought this would be quite space-inefficient, so I decided I would put it to the test, against a real-world scenario that would probably be pretty much a worst case scenario for it and a best case for rdiff-backup.-</p><br />-<p>-I track Debian sid and haven't updated my home box in quite some time. I have over 1GB of .debs downloaded which represent updates. Many of these updates are going to touch tons of files in /usr, though often making small changes, or even none at all. Sounds like rdiff-backup heaven, right?-</p><br />-<p>-I ran rdiff-backup to a clean area before applying any updates, and used dar to create a full backup file of the same data. Then I ran apt-get upgrade, and made incrementals with both rdiff-backup and dar. Finally I ran apt-get dist-upgrade, and did the same thing. So I have three backups with each system.-</p><br />-<p>-Let's look at how rdiff-backup did first.-</p><br />-<p>-According to rdiff-backup --list-increment-sizes, my /usr backup looks like this:-</p><br />-<pre>- Time Size Cumulative size-------------------------------------------------------------------------------Sun Apr 13 18:37:56 2008 5.15 GB 5.15 GB (current mirror)-Sun Apr 13 08:51:30 2008 405 MB 5.54 GB-Sun Apr 13 03:08:07 2008 471 MB 6.00 GB-</pre><br />--<p>-So what we see here is that we're using 5.15GB for the mirror of the current state of /usr. The delta between the old state of /usr and the state after apt-get upgrade was 471MB, and the delta representing dist-upgrade was 405MB, for total disk consumption of 6GB.-</p><br />-<p>-But if I run du -s over the /usr storage area in rdiff, it says that 7.0GB was used. du -s --apparent-size shows 6.1GB. The difference is that all the tens of thousands of files each waste some space at the end of their blocks, and that adds up to an entire gigabyte. rdiff-backup effectively consumed 7.0GB of space.-</p><br />-<p>-Now, for dar:-</p><br />-<pre>--rw-r--r-- 1 root root 2.3G Apr 12 22:47 usr-l00.1.dar--rw-r--r-- 1 root root 826M Apr 13 11:34 usr-l01.1.dar--rw-r--r-- 1 root root 411M Apr 13 19:05 usr-l02.1.dar-</pre><br />-<p>-This was using bzip2 compression, and backed up the exact same files and data that rdiff-backup did. The initial mirror was 2.3GB, much smaller than the 5.1GB that rdiff-backup consumes. The apt-get upgrade differential was 826MB compared to the 471MB in rdiff-backup -- not really a surprise. But the dist-upgrade differential -- still a pathologically bad case for dar, but less so -- was only 6MB larger than the 405MB rdiff-backup case. And the total actual disk consumption of dar was only 3.5GB -- half the 7.0GB rdiff-backup claimed!-</p><br />-<p>-I still expect that, over an extended time, rdiff-backup could chip away at dar's lead... or maybe not, if lots of small files change.-</p><br />-<p>-But this was a completely unexpected result. I am definitely going to give dar a closer look.-</p><br />-<p>-Also, before I started all this, I converted my external hard disk from ext3 to XFS because of ext3's terrible performance with rdiff-backup.-</p></description>- <pubDate>Mon, 14 Apr 2008 00:35:00 +0000</pubDate>- <dc:creator>nospam@example.com (John Goerzen)</dc:creator>-</item>-<item>- <title>"FP Lunch": The shortest beta-normalizer</title>- <guid isPermalink="false">http://sneezy.cs.nott.ac.uk/fplunch/weblog/?p=95</guid>- <link>http://sneezy.cs.nott.ac.uk/fplunch/weblog/?p=95</link>- <description><p>I presented the shortest implementation of a normalizer for beta equality for untyped lambda calculus which is based on Normalisation by Evaluation. </p>-<p>We start with the definition of lambda terms using de Bruijn levels:<br />-<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/6b2c3e05c957460fa08ae20bdfeb1753.png" title="&#10;\begin{code}&#10;data T = Var Int | Lam T | App T T deriving Show&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;data T = Var Int | Lam T | App T T deriving Show&#10;\end{code}&#10;" /></p>-<p>The reason for using de Bruijn levels is that weakening comes for free. The other side of the coin is that one has to reindex bound variables when substituting. However, this is not an issue because we never do that.</p>-<p>We define values by solving a negative domain equation:<br />-<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/8025c23de1c08f7c265a350cb637a688.png" title="&#10;\begin{code}&#10;data V = Fun (V -&gt; V)&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;data V = Fun (V -&gt; V)&#10;\end{code}&#10;" /></p>-<p>It is easy to define application:<br />-<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/4c3e28203bdc418b9bb3483ee2e3f79d.png" title="&#10;\begin{code}&#10;app :: V -&gt; V -&gt; V&#10;app (Fun f) v = f v&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;app :: V -&gt; V -&gt; V&#10;app (Fun f) v = f v&#10;\end{code}&#10;" /></p>-<p>We can evaluate lambda terms in the Value domain using a list of values as the environment:<br />-<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/2e59405e96890b4c97292547d66c775d.png" title="&#10;\begin{code}&#10;eval :: T -&gt; [V] -&gt; V&#10;eval (Var x) e = e !! x&#10;eval (Lam t) e = Fun (\ v -&gt; eval t (e++[v]))&#10;eval (App t u) e = app (eval t e) (eval u e)&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;eval :: T -&gt; [V] -&gt; V&#10;eval (Var x) e = e !! x&#10;eval (Lam t) e = Fun (\ v -&gt; eval t (e++[v]))&#10;eval (App t u) e = app (eval t e) (eval u e)&#10;\end{code}&#10;" /></p>-<p>All we have to do now is to invert evaluation, i.e. to define a function<br />-<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/5742dab51f5ea1b7a4673a4a7ef21e5e.png" title="&#10;\begin{code}&#10;quote :: V -&gt; T&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;quote :: V -&gt; T&#10;\end{code}&#10;" /></p>-<p>To be able to do this we have first to extend values with variables. Then to be able to extend app, we also have to represent stuck applications, or neutral values:<br />-<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/232e1b86c01bdb2e1330d22055bbace9.png" title="&#10;\begin{code}&#10;data V = Fun (V -&gt; V) | NVar Int | NApp V V&#10;&#10;app :: V -&gt; V -&gt; V&#10;app (Fun f) v = f v&#10;app n v = NApp n v&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;data V = Fun (V -&gt; V) | NVar Int | NApp V V&#10;&#10;app :: V -&gt; V -&gt; V&#10;app (Fun f) v = f v&#10;app n v = NApp n v&#10;\end{code}&#10;" /><br />-The code for eval remains unchanged. Now we can implement quote, though we need an extra parameter to keep track of the free variables:<br />-<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/4d9eaf056742b7d605ac1ad380045eee.png" title="&#10;\begin{code}&#10;quote :: Int -&gt; V -&gt; T&#10;quote x (Fun f) = Lam (quote (x+1) (f (NVar x)))&#10;quote x (NVar y) = Var y&#10;quote x (NApp n v) = App (quote x n) (quote x v)&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;quote :: Int -&gt; V -&gt; T&#10;quote x (Fun f) = Lam (quote (x+1) (f (NVar x)))&#10;quote x (NVar y) = Var y&#10;quote x (NApp n v) = App (quote x n) (quote x v)&#10;\end{code}&#10;" /><br />-Now nf just evaluates and quotes the result:<br />-<img src="http://sneezy.cs.nott.ac.uk/fplunch/weblog/latexrender/pictures/36c4c25141994c1cf3af73da66418a49.png" title="&#10;\begin{code}&#10;nf :: T -&gt; T&#10;nf t = quote 0 (eval t [])&#10;\end{code}&#10;" alt="&#10;\begin{code}&#10;nf :: T -&gt; T&#10;nf t = quote 0 (eval t [])&#10;\end{code}&#10;" /></p>-<p>We discussed how to verify such a normalisation function - I suggested to use the partiality monad.</p></description>- <pubDate>Sun, 13 Apr 2008 08:16:37 +0000</pubDate>- <dc:creator>Thorsten</dc:creator>-</item>-<item>- <title>Ulisses Costa: Lexical Analysis - Wikipedia</title>- <guid isPermalink="false">http://caos.di.uminho.pt/~ulisses/blog/2008/04/13/lexical-analysis-wikipedia/</guid>- <link>http://caos.di.uminho.pt/~ulisses/blog/2008/04/13/lexical-analysis-wikipedia/</link>- <description><h2 id="58_intro_1">Intro</h2>-<p>This year I started to learn processing languages. I started by regular expressions and past few days I began to study the <a href="http://flex.sourceforge.net/">Flex</a>, as with regular expressions we can&#8217;t create text filters.<br />-The first job I did was a kind of a dictionary. Getting a source of words and a faithful translation, add all the information in one document.</p>-<p>The problem was finding a good document with many Portuguese words and their translations into English.</p>-<p>With this post I want to teach what I learned from this work.</p>-<h2 id="58_wikipedia-xml-struct_1">Wikipedia XML structure</h2>-<p>I started by picking up the last dump of Wikipedia-PT and &#8220;decipher&#8221; the XML where it is stored. The structure is something like that:</p>--<div class="wp_syntax"><div class="code"><pre class="xml"><span><span>&lt;page<span>&gt;</span></span></span>- ...-<span><span>&lt;/page<span>&gt;</span></span></span>-<span><span>&lt;page<span>&gt;</span></span></span>- ...-<span><span>&lt;/page<span>&gt;</span></span></span></pre></div></div>--<p>And each <strong>page</strong> tag, expanded, have this structure:</p>--<div class="wp_syntax"><div class="code"><pre class="xml"><span><span>&lt;page<span>&gt;</span></span></span>- <span><span>&lt;title<span>&gt;</span></span></span>TITLE<span><span>&lt;/title<span>&gt;</span></span></span>- <span><span>&lt;id<span>&gt;</span></span></span>PAGE_ID_NUMBER<span><span>&lt;/id<span>&gt;</span></span></span>- <span><span>&lt;revision<span>&gt;</span></span></span>- <span><span>&lt;id<span>&gt;</span></span></span>ID_REVISION_NUMBER<span><span>&lt;/id<span>&gt;</span></span></span>- <span><span>&lt;timestamp<span>&gt;</span></span></span>TIMESTAMP<span><span>&lt;/timestamp<span>&gt;</span></span></span>- <span><span>&lt;contributor<span>&gt;</span></span></span>- <span><span>&lt;username<span>&gt;</span></span></span>USERNAME<span><span>&lt;/username<span>&gt;</span></span></span>- <span><span>&lt;id<span>&gt;</span></span></span>ID_CONTRIBUTOR<span><span>&lt;/id<span>&gt;</span></span></span>- <span><span>&lt;/contributor<span>&gt;</span></span></span>- <span><span>&lt;comment<span>&gt;</span></span></span>COMMENT<span><span>&lt;/comment<span>&gt;</span></span></span>- <span><span>&lt;text</span> <span>xml:space</span>=<span>&quot;preserve&quot;</span><span>&gt;</span></span>WIKIPEDIA_ENTRY<span><span>&lt;/text<span>&gt;</span></span></span>- <span><span>&lt;/revision<span>&gt;</span></span></span>- <span><span>&lt;/page<span>&gt;</span></span></span></pre></div></div>--<p>So, here we have the variables: TITLE, PAGE_ID_NUMBER, ID_REVISION_NUMBER, TIMESTAMP, USERNAME, ID_CONTRIBUTOR, COMMENT and WIKIPEDIA_ENTRY.</p>-<p>TITLE is the Portuguese word, because the Wikipedia I&#8217;ve downloaded is in Portuguese.<br />-But so far, no English word.</p>-<p>Lets expand WIKIPEDIA_ENTRY:</p>--<div class="wp_syntax"><div class="code"><pre class="xml"><span><span>&lt;text</span> <span>xml:space</span>=<span>&quot;preserve&quot;</span><span>&gt;</span></span>- ...- [[categoria:CATEGORY]]- ...- [[en:ENGLISH]]- ...-<span><span>&lt;/text<span>&gt;</span></span></span></pre></div></div>--<p>Here we have the ENGLISH variable that is the corresponding word in English to TITLE. I also want the CATEGORY variable that indicates from what category this entry belong.</p>-<p>As some entries in the Wikipedia have multiple categories lines I am also interested in keep them all.<br />-I want that the output of my program became something like that:</p>-<pre>-PT - TITLE1-EN - ENGLISH1-Categoria - CATEGORY11- CATEGORY12- ...- CATEGORY1j-...-PT - TITLEi-EN - ENGLISHi-Categoria - CATEGORYi1- CATEGORYi2- ...- CATEGORYij-...</pre>-<p>Some entries in the Portuguese Wikipedia do not have the English correspondent version so I will not want those entries.</p>-<h2 id="58_lexing_1"><em>Lexing</em></h2>-<p>A Lex file have this aspect:</p>-<pre>-definitions-%%-rules-%%-user code-</pre>-<p>Let&#8217;s focus in <strong>rules</strong> part:</p>-<p>Rules have the following structure;</p>-<pre>-%%-REGEX code-REGEX code-%%-</pre>-<p>I know Regular Expressions (REGEX) now, so let&#8217;s start to build that thing!</p>-<p>I got me to realize that the part of the TITLE may have not only the entries name, also has the Wikipedia contributors pages, among other things that do not interest me to save.<br />-I start to do a list of all those pages:<br />-{Wikipedia,Usuário,Discussão,Ajuda,Anexo,MediaWiki,Categoria}</p>-<p>So, I have to, somehow, throw away all the pages with the following structure:</p>--<div class="wp_syntax"><div class="code"><pre class="xml"> <span><span>&lt;page<span>&gt;</span></span></span>- <span><span>&lt;title<span>&gt;</span></span></span>[&quot;Wikipedia&quot;&quot;Usuario&quot;&quot;Discussao&quot;&quot;Ajuda&quot;&quot;Anexo&quot;&quot;MediaWiki&quot;&quot;Categoria&quot;]:TITLE<span><span>&lt;/title<span>&gt;</span></span></span>- <span><span>&lt;id<span>&gt;</span></span></span>ID_PAGE<span><span>&lt;/id<span>&gt;</span></span></span>- <span><span>&lt;revision<span>&gt;</span></span></span>- <span><span>&lt;id<span>&gt;</span></span></span>ID_REVISION<span><span>&lt;/id<span>&gt;</span></span></span>- <span><span>&lt;timestamp<span>&gt;</span></span></span>TIMESTAMP<span><span>&lt;/timestamp<span>&gt;</span></span></span>- <span><span>&lt;contributor<span>&gt;</span></span></span>- <span><span>&lt;username<span>&gt;</span></span></span>USERNAME<span><span>&lt;/username<span>&gt;</span></span></span>- <span><span>&lt;id<span>&gt;</span></span></span>ID_CONTRIBUTOR<span><span>&lt;/id<span>&gt;</span></span></span>- <span><span>&lt;/contributor<span>&gt;</span></span></span>- <span><span>&lt;comment<span>&gt;</span></span></span>COMMENT<span><span>&lt;/comment<span>&gt;</span></span></span>- <span><span>&lt;text</span> <span>xml:space</span>=<span>&quot;preserve&quot;</span><span>&gt;</span></span>ENTRY<span><span>&lt;/text<span>&gt;</span></span></span>- <span><span>&lt;/revision<span>&gt;</span></span></span>- <span><span>&lt;/page<span>&gt;</span></span></span></pre></div></div>--<p>After a dozen of lines I start to understand that I have to some how &#8220;explain&#8221; Lex the structure of the Wikipedia XML file. That way will be easier.</p>-<p>I start to read the <a href="http://flex.sourceforge.net/manual/">Flex manual</a> and I find the <a href="http://flex.sourceforge.net/manual/Start-Conditions.html#Start-Conditions">Start Conditions</a>, a very clever way to treat a block of information.</p>-<p>Languages like C, HTML and XML are structured by blocks, so Start Conditions may be the way to easily get the information from those.</p>-<h2 id="58_start-conditions_1">Start Conditions</h2>-<p>If you have a block of code that have this aspect:</p>--<div class="wp_syntax"><div class="code"><pre class="xml"><span><span>&lt;title<span>&gt;</span></span></span>TITLE<span><span>&lt;/title<span>&gt;</span></span></span></pre></div></div>--<p>Our block start with &#8220;&#8221; string.</p>-<p>So in Lex, we must use Start Conditions and produce the following code:</p>--<div class="wp_syntax"><div class="code"><pre class="c">%x title_sc-anything .|<span>&#91;</span>\n\t\r<span>&#93;</span>-%%-<span>&quot;&lt;title&gt;&quot;</span> BEGIN<span>&#40;</span>title_sc<span>&#41;</span>;-&lt;title_sc&gt;<span>&#91;</span>^&gt;<span>&#93;</span>+ <span>&#123;</span><span>printf</span><span>&#40;</span><span>&quot;title=%s<span>\n</span>&quot;</span>,yytext<span>&#41;</span>;<span>&#125;</span>-&lt;title_sc&gt;<span>&quot;&lt;/title&gt;&quot;</span> BEGIN<span>&#40;</span>INITIAL<span>&#41;</span>;-<span>&#123;</span>anything<span>&#125;</span> <span>&#123;</span>;<span>&#125;</span> <span>/* do nothing*/</span>-%%-main<span>&#40;</span><span>&#41;</span> <span>&#123;</span>- yylex<span>&#40;</span><span>&#41;</span>;-<span>&#125;</span></pre></div></div>--<p>The <code>%x title_sc</code> declaration is to declare a state exclusive, that means; while we are inside <code>code_sc</code> Flex won&#8217;t look rules outside of that, until <code>BEGIN(INITAIL)</code>.</p>-<p>In <strong>definitions</strong> part we can declare variables <code>anything .|[\n\t\r]</code> to use in <strong>rules</strong> part as <code>{anything}</code>.</p>-<p>The <code>BEGIN(title_sc)</code> statement makes Lex jump to the first line of rule and it start to match the rules that finds there.</p>-<p>We can rewrite the above code like that:</p>--<div class="wp_syntax"><div class="code"><pre class="c">%x title_sc-anything .|<span>&#91;</span>\n\t\r<span>&#93;</span>-%%-<span>&quot;&lt;title&gt;&quot;</span> BEGIN<span>&#40;</span>title_sc<span>&#41;</span>;-&lt;title_sc&gt;<span>&#123;</span>- <span>&#91;</span>^&gt;<span>&#93;</span>+ <span>&#123;</span><span>printf</span><span>&#40;</span><span>&quot;title=%s<span>\n</span>&quot;</span>,yytext<span>&#41;</span>;<span>&#125;</span>- <span>&quot;&lt;/title&gt;&quot;</span> BEGIN<span>&#40;</span>INITIAL<span>&#41;</span>;-<span>&#125;</span>-<span>&#123;</span>anything<span>&#125;</span> <span>&#123;</span>;<span>&#125;</span> <span>/* do nothing*/</span>-%%-main<span>&#40;</span><span>&#41;</span> <span>&#123;</span>- yylex<span>&#40;</span><span>&#41;</span>;-<span>&#125;</span></pre></div></div>--<p>When Lex find <code>BEGIN(INITIAL)</code> statement it jumps to the first <code>BEGIN(XXX)</code>, so we can never be able to use block&#8217;s inside other block&#8217;s (like XML does).</p>-<p>Of course that&#8217;s not true.</p>-<h2 id="58_start-conditions-ins_1">Start Conditions inside Start Conditions</h2>-<p>Lex have a brilliant way to deal with that. It uses Stack&#8217;s to store the state were we are!</p>-<p>The idea is something like that, imagine a mathematical expression:</p>-<p><img src="http://caos.di.uminho.pt/~ulisses/blog/wp-content/latex/87e/87e6b04da406d2885e69188f49514a2b-FFFFFF000000.png" alt="(1+2)-(3*(4/5))" title="(1+2)-(3*(4/5))" class="latex" /></p>-<p>I can say:</p>-<ul>-<li>2 or [1,2]</li>-<li>3 or [2,1]</li>-<li>5 or [2,2,2]</li>-<li>and so on&#8230;</li>-</ul>-<p>That&#8217;s all about keeping the path, our actual position in the tree.</p>-<p>So, now we replace the <code>BEGIN(state)</code> to <code>yy_push_state(state)</code>, and to go to the previously block I say <code>yy_pop_state()</code>.</p>-<p>With that now I can read structures like that one:</p>--<div class="wp_syntax"><div class="code"><pre class="xml"> <span><span>&lt;page<span>&gt;</span></span></span>- <span><span>&lt;title<span>&gt;</span></span></span>TITLE<span><span>&lt;/title<span>&gt;</span></span></span>- ...- <span><span>&lt;text</span> <span>xml:space</span>=<span>&quot;preserve&quot;</span><span>&gt;</span></span>- ...- [[Categoria:CATEGORY]]- ...- [[en:ENGLISH]]- ...- <span><span>&lt;/text<span>&gt;</span></span></span>- <span><span>&lt;/page<span>&gt;</span></span></span></pre></div></div>--<p>And to do so, I write that Lex code:</p>--<div class="wp_syntax"><div class="code"><pre class="c">%x PAGE TITLE TEXT CATEGORIA EN-%option stack-anything .|<span>&#91;</span>\n\t\r<span>&#93;</span>-notPage <span>&#91;</span><span>&quot;Wikipedia&quot;</span><span>&quot;Usuário&quot;</span><span>&quot;Discussão&quot;</span><span>&quot;Ajuda&quot;</span><span>&quot;Anexo&quot;</span><span>&quot;MediaWiki&quot;</span><span>&quot;Categoria&quot;</span><span>&#93;</span>-%%-<span>&quot;&lt;page&gt;&quot;</span> yy_push_state<span>&#40;</span>PAGE<span>&#41;</span>;-&lt;PAGE&gt;<span>&#123;</span>- <span>&quot;&lt;title&gt;&quot;</span><span>&#123;</span>notPagina<span>&#125;</span> yy_pop_state<span>&#40;</span><span>&#41;</span>; <span>// not a valid page</span>- <span>&quot;&lt;title&gt;&quot;</span> yy_push_state<span>&#40;</span>TITLE<span>&#41;</span>;- <span>&quot;&lt;text&quot;</span><span>&#91;</span>^&gt;<span>&#93;</span>+<span>&quot;&gt;&quot;</span> yy_push_state<span>&#40;</span>TEXT<span>&#41;</span>;- <span>&quot;&lt;/page&gt;&quot;</span> yy_pop_state<span>&#40;</span><span>&#41;</span>;- <span>&#123;</span>anything<span>&#125;</span> <span>/* do nothing */</span>-<span>&#125;</span>-&nbsp;-&lt;TEXT&gt;<span>&#123;</span>- <span>&quot;[[&quot;</span><span>&#91;</span>cC<span>&#93;</span><span>&quot;ategoria:&quot;</span> yy_push_state<span>&#40;</span>CATEGORIA<span>&#41;</span>;- <span>&quot;[[en:&quot;</span> yy_push_state<span>&#40;</span>EN<span>&#41;</span>;- <span>&quot;&lt;/text&gt;&quot;</span> yy_pop_state<span>&#40;</span><span>&#41;</span>;- <span>&#123;</span>anything<span>&#125;</span> <span>/* do nothing */</span>-<span>&#125;</span>-&nbsp;-&lt;TITLE&gt;<span>&#123;</span>- <span>&#91;</span>^&lt;<span>&#93;</span>+ <span>&#123;</span>- i=<span>0</span>;- imprime<span>&#40;</span>cat, pt, en<span>&#41;</span>;- limpa<span>&#40;</span>cat<span>&#41;</span>;- pt=<span>NULL</span>; en=<span>NULL</span>;- pt=strdup<span>&#40;</span>yytext<span>&#41;</span>;- <span>&#125;</span>- <span>&quot;&lt;/title&gt;&quot;</span> yy_pop_state<span>&#40;</span><span>&#41;</span>;- <span>&#123;</span>anything<span>&#125;</span> <span>/* do nothing */</span>-<span>&#125;</span>-&nbsp;-&lt;EN&gt;<span>&#123;</span>- <span>&#91;</span>^\<span>&#93;</span><span>&#93;</span>+ en=strdup<span>&#40;</span>yytext<span>&#41;</span>;- <span>&#91;</span>\<span>&#93;</span><span>&#93;</span>+ yy_pop_state<span>&#40;</span><span>&#41;</span>;- <span>&quot;]&quot;</span>\n<span>&#123;</span>anything<span>&#125;</span> <span>/* do nothing */</span>-<span>&#125;</span>-&nbsp;-&lt;CATEGORIA&gt;<span>&#123;</span>- <span>&#91;</span> \<span>#\!\*\|]+ yy_pop_state();</span>- <span>&#91;</span>^\<span>&#93;</span>\|\n<span>&#93;</span>+ <span>&#123;</span>- cat<span>&#91;</span>i<span>&#93;</span>=strdup<span>&#40;</span>yytext<span>&#41;</span>;- i++;- <span>&#125;</span>- <span>&#91;</span>\<span>&#93;</span><span>&#93;</span>+ yy_pop_state<span>&#40;</span><span>&#41;</span>;- <span>&quot;]&quot;</span>\n<span>&#123;</span>anything<span>&#125;</span> <span>/* do nothing */</span>-<span>&#125;</span>-<span>&#123;</span>anything<span>&#125;</span> <span>/* do nothing */</span>-%%-<span>int</span> main<span>&#40;</span><span>&#41;</span> <span>&#123;</span>- yylex<span>&#40;</span><span>&#41;</span>;- <span>return</span> <span>0</span>;-<span>&#125;</span></pre></div></div>--<p>As you can see we are all the time matching a rule that makes lex jump to another state until one terminal rule (in this case variables affectations) or until pop.</p>-<p>To see all the code <a href="http://caos.di.uminho.pt/~ulisses/code/pl/trab1/trab.lex">go here</a>(.lex).</p>-<p>If you understand Portuguese and feel interested in more information you can <a href="http://caos.di.uminho.pt/~ulisses/code/pl/trab1/rel/online/index.html">go here</a>(.html).</p>-<h3 id="58_references_1">References</h3>-<p><a href="http://flex.sourceforge.net/">flex: The Fast Lexical Analyzer</a></p>- <span class="post2pdf_span"><a href="http://caos.di.uminho.pt/~ulisses/blog/wp-content/plugins/post2pdf/generate.php?post=58" rel="nofollow"><img src="http://caos.di.uminho.pt/~ulisses/blog/wp-content/plugins/post2pdf/icon/pdf.png" width="16px" height="16px" />convert this post to pdf.</a></span></description>- <pubDate>Sun, 13 Apr 2008 06:50:50 +0000</pubDate>- <dc:creator>ulisses</dc:creator>-</item>-<item>- <title>David R. MacIver: Blog move</title>- <guid isPermalink="false">tag:blogger.com,1999:blog-2789077809400086800.post-2114636340936909669</guid>- <link>http://unenterprise.blogspot.com/2008/04/blog-move.html</link>- <description><p>Well, I've been meaning to set up a site of my own for ages. I finally got around to it. I can now be found at <a href="http://www.drmaciver.com/">http://www.drmaciver.com</a>/ </p>--<p>This blog will be moving to the "programming" category there. I'll update the various aggregator sites that have it on to point there instead.</p></description>- <pubDate>Sun, 13 Apr 2008 06:50:09 +0000</pubDate>- <dc:creator>David R. MacIver</dc:creator>-</item>-<item>- <title>Nick Mudge: A New Operating System</title>- <guid isPermalink="false">http://nickmudge.info?post=91</guid>- <link>http://nickmudge.info?post=91</link>- <description><p>-I've decided to attempt to write an operating system.-</p>-<p>-Basically I want to be able to understand a whole system as much as I can and I want to make it as easy as possible for others to understand it as well. This is the main reason I want to write an operating system.-</p>-<p>-The reason I'm not just studying an existing operating system like <a href="http://www.kernel.org/">Linux</a> or <a href="http://www.minix3.org/">Minix</a> or <a href="http://mikeos.berlios.de/">MikeOS</a> is because I think I will understand a system better if I write it myself and it seems more fun to me. I am of course studying those operating systems to learn to write my own.-</p>-<p>-<strong>Goals and Guides</strong>-</p>-<p>-The design of the system is pretty loose so far but I do have some general guides and goals for the system.-</p>-<ol>-<li> -Designed to explicitly take advantage of 64 bit processors.-</li>-<li>-Designed to explicitly take advantage of multi-core or multi-cpu processors.-</li>-<li>-Designed to take advantage of and provide virtualization i.e. operating system virtualization etc.-</li>-<li>-It's a server operating system. Not designed to be a desktop operating system or anything else.-</li>-<li>-It needs to be designed so that the system can be understood as easily as possible. It must be simple. The code base must be as small as possible.-</li>-<li>-It must be good.-</li>-</ol>-<p>-I'm not sure if the kernel will be a microkernel or monolithic or something else. -</p></description>- <pubDate>Sun, 13 Apr 2008 00:00:00 +0000</pubDate>-</item>-<item>- <title>Dan Piponi (sigfpe): Negative Probabilities</title>- <guid isPermalink="false">tag:blogger.com,1999:blog-11295132.post-5498552306554187806</guid>- <link>http://sigfpe.blogspot.com/2008/04/negative-probabilities.html</link>- <description>I'm always interested in new ways to present the ideas of quantum mechanics to a wider audience. Unfortunately the conventional description of quantum mechanics requires knowledge of complex numbers and vector spaces making it difficult to avoid falling back on misleading analogies and metaphors. But there's another approach to quantum mechanics, due to Feynman, that I have never seen mentioned in the popular science literature. It assumes only basic knowledge of <a href="http://simple.wikipedia.org/wiki/Probability">probability theory</a> and <a href="http://simple.wikipedia.org/wiki/Negative_number">negative numbers</a> to get a foot on the ladder.<br /><br />We start with tweaking probability theory a bit. One of the axioms of probability theory says that all probabilities must lie in the range zero to one. However, we could imagine relaxing this rule even though on the face of it it seems meaningless. For example, suppose we have a coin that has a 3/2 chance of landing heads and a -1/2 chance of landing tails. We can still reason that the chance of getting two heads in a row is 3/2&times;3/2=9/4 by the usual multiplication rule. But obviously no situation like this could ever arise in the real world because after tossing such a coin 10 times we'd expect to see -5 tails on average.<br /><br />But what if we could contrive a system with some kind of internal state governed by negative probabilities even though we couldn't observe it directly? So consider this case: a machine produces boxes with (ordererd) pairs of bits in them, each bit viewable through its own door. Let's suppose the probability of each possible combination of two bits is given by the following table:<br /><table><br /><tr><td>First bit</td><td>Second bit</td><td>Probability</td></tr><br /><tr><td>0</td><td>0</td><td>-1/2</td></tr><br /><tr><td>0</td><td>1</td><td>1/2</td></tr><br /><tr><td>1</td><td>0</td><td>1/2</td></tr><br /><tr><td>1</td><td>1</td><td>1/2</td></tr><br /></table><br />Obviously if we were able to look through both doors we'd end up with the meaningless prediction that we'd expect to see 00 a negative number of times. But suppose that things are arranged so that we can only look through one door. Maybe the boxes self-destruct if one or other door is opened but you still get enough time to see what was behind the door. Now what happens?<br /><br />If you look through the first door the probability of seeing 1 is P(10)+P(11)=1. We get the same result if we look through the second door. We only get probabilities in the range zero to one. As long as we're restricted to one door we get meaningful results.<br /><br />If we were to perform this experiment repeatedly with different runs of the machine, each time picking a random door to look through, we'd eventually become very confident that every box contained 11. After all, if we freely choose which door to look through, and we always see 1, there's no place 0's could be 'hiding'.<br /><br />But now suppose a new feature is added to the box that allows us to compare the two bits to see if they are equal. It reveals nothing about what the bits are, just their state of equality. And of course, after telling us, it self-destructs. We now find that the probability of the two bits being different is P(01)+P(10)=1. So if we randomly chose one of the three possible observations each time the machine produced the box we'd quickly run into the strange situation that the two bits both appear to be 1, and yet are different. But note that although the situation is weird, it's not meaningless. As long as we never get to see both bits at the same time we never directly observe a paradox. If we met such boxes in the real world we'd be forced to conclude that maybe the boxes knew which bit you were going to look at and changed value as a result, or that maybe you didn't have the free will to choose door that you thought you had, or maybe, even more radically, you'd conclude that the bits generated by the machine were described by negative probabilities.<br /><br />That's all very well, but obviously the world doesn't really work like this and we never see boxes like this. Except that actually it does! The <a href="http://en.wikipedia.org/wiki/EPR_Paradox">EPR</a> experiment has many similarities to the scenario I described above. The numbers aren't quite the same, and we're not talking about bits in boxes, but we do end up with a scenario involving observations of bits that simply don't add up. If we do try to explain what's going on using probability theory, we either conclude there's something weird about our assumptions of locality or causality or we end up assigning negative probabilities to the internal states of our systems. In fact, you can read the details in an article by <a href="http://www.drchinese.com/David/Bell_Theorem_Negative_Probabilities.htm">David Schneider</a>. Being forced to conclude that we have negative probabilities in a physical system is usually taken as a sign that we have a contradiction. In the case of <a href="http://en.wikipedia.org/wiki/Bell's_theorem">Bell's theorem</a> it shows that we can't interpret what we see in terms of probability theory and hence that the weirdness of quantum mechanics can't be explained in terms of some hidden random variable that we can't see. QM simply doesn't obey the rules you'd expect of hidden variables we can't see.<br /><br />But in a paper called <a href="http://en.wikipedia.org/wiki/Negative_probability">Negative Probability</a>, Feynman tried taking the idea of negative probabilities seriously. He showed that you could reformulate quantum mechanics completely in terms of them so that you no longer needed to think in terms of the complex number valued 'amplitudes' that physicists normally use. This means the above isn't just an analogy, it's actually a formal system within which you can do QM, although I haven't touched on the bit that refers to the dynamics of quantum systems. So if you can get your head around the ideas I've talked about above you're well on your way to understanding some reasons why quantum mechanics seems so paradoxical.<br /><br />At this point you may be wondering how nature contrives to hide these negative probabilities from direct observation. Her trick is that making one kind of observation disturbs up the state of what you've observed so that you can't make the other kind of observation on a pristine state. You have to pick one kind of observation or the other. Electrons and photons really are a lot like the boxes I just described.<br /><br />So why don't physicists use this formulation? Despite the fact that negative numbers seem simpler to most people than imaginary numbers, the negative number formulation of QM is much more complicated. What's more, because it makes exactly the same predictions as regular QM there's no compelling reason to switch to it. And anyway, it's not as if directly observing negative probabilities is any more intuitive or meaningful than imaginary ones. Once you've introduced negative ones, you might as well go all the way!<br /><br />This all ties in with what I said a <a href="http://sigfpe.blogspot.com/2006/05/quantum-mechanics-and-probability.html">while back</a>. The important thing about QM is that having two ways to do something can make it <em>less</em> likely to happen, not more.<br /><br />For a different perspective <a href="http://www.lns.cornell.edu/spr/2002-03/msg0040195.html">this</a> is an interesting comment.<br /><br />Footnote: We can embed QM in negative probability theory. But can we do the converse? Can every negative probability distribution be physically realised in a quantum system? I've a hunch the answer is obvious but I'm too stupid to see it.</description>- <pubDate>Sat, 12 Apr 2008 17:02:00 +0000</pubDate>- <dc:creator>sigfpe</dc:creator>-</item>-<item>- <title>Shin-Cheng Mu: Terminating Unfolds (2)</title>- <guid isPermalink="false">http://www.iis.sinica.edu.tw/~scm/?p=49</guid>- <link>http://www.iis.sinica.edu.tw/~scm/2008/terminating-unfolds-2/</link>- <description><p>After seeing <a href="http://www.iis.sinica.edu.tw/~scm/2008/terminating-unfolds-1/">our code</a>, <a href="http://www.cs.nott.ac.uk/~nad/">Nils Anders Danielsson</a> suggested two improvements. Firstly, to wrap the bound in the seed. The terminating <code>unfoldr↓</code> would thus have a simpler type as well as a simpler implemenation:</p>-<blockquote><p><code>unfoldr↓ : {a : Set}(b : ℕ -> Set){n : ℕ} -><br />-&nbsp;&nbsp;&nbsp;&nbsp;(f : forall {i} -> b (suc i) -> ⊤ ⊎ (a × b i)) -><br />-&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;b n -> [ a ]<br />-unfoldr↓ b {zero} f y = []<br />-unfoldr↓ b {suc i} f y with f y<br />-... | inj₁ _ = []<br />-... | inj₂ (x , y') = unfoldr↓ b {i} f y'</code></p></blockquote>-<p>The definition passes the termination check, apparently, because <code>unfoldr↓</code> is defined inductively on <code>n</code>.</p>-<p>To generate a descending a list, one may invent a datatype <code>Wrap</code> that wraps the seed, whose bound is simply the seed itself:</p>-<blockquote><p><code>data Wrap : ℕ -> Set where<br />-&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;W : (n : ℕ) -> Wrap n</code></p></blockquote>-<p>The list may then be generated by an unfold:</p>-<blockquote><p><code>dec : forall {i} -> Wrap (suc i) -> ⊤ ⊎ (ℕ × Wrap i)<br />-dec {i} (W .(suc i)) = inj₂ (i , W i)</code></p>-<p>down↓ : ℕ -> [ ℕ ]<br />-down↓ n = unfoldr↓ Wrap dec (W n)<br />-</p></blockquote>-<p>Of course, this would defeat my original goal of reusing the non-dependently typed <code>dec</code>, which is probably a bad idea anyway.</p>-<p>To show that the bound need not be exact, let&#8217;s try to generate a descending list whose elements are decremented by 2 in each step. We may use this slightly generalised wrapper:</p>-<blockquote><p><code>data Wrap2 : ℕ -> Set where<br />-&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;W2 : (x : ℕ) -> (bnd : ℕ) -> x ≤ bnd -> Wrap2 bnd</code></p></blockquote>-<p>and a function <code>dec2</code> that decrements a <code>suc i</code>-bounded seed by 2 but showing that the new seed is bounded by <code>i</code>:</p>-<blockquote><p><code>dec2 : forall {i} -> Wrap2 (suc i) -> ⊤ ⊎ (ℕ × WAlt i)<br />-dec2 {i} (W2 0 .(1 + i) _) = inj₁ tt<br />-dec2 {i} (W2 1 .(1 + i) _) = inj₁ tt<br />-dec2 {i} (W2 (suc (suc n)) .(1 + i) 2+n≤1+i) =<br />-&nbsp;&nbsp;&nbsp; inj₂ (n , W2 n i (suc-≤-weaken-l (≤-pred 2+n≤1+i)))<br />-</code></p></blockquote>-<p>The list can then be unfolded by:</p>-<blockquote><p><code>down↓2 : ℕ -> [ ℕ ]<br />-down↓2 n = unfoldr↓ Wrap2 dec2 (W2 n n ≤-refl)</code></p></blockquote>-<p>where <code>suc-≤-weaken-l</code> is a proof of <code>forall {m n} -> suc m ≤ n -> m ≤ n</code>.</p>-<h3>Unfolding a Tree</h3>-<p>It is an easy exercise to come up with a tree version of the unfold above:</p>-<blockquote><p><code>unfoldT↓ : {a : Set}(b : ℕ -> Set){n : ℕ} -><br />-&nbsp;&nbsp;(f : forall {i} -> b (suc i) -> a ⊎ (b i × b i)) -><br />-&nbsp;&nbsp;&nbsp;&nbsp;B n -> Tree a<br />-unfoldT↓ b {0} f y = Nul<br />-unfoldT↓ b {suc i} f y with f y<br />-... | inj₁ x = Tip x<br />-... | inj₂ (y₁ , y₂) =<br />-&nbsp;&nbsp;&nbsp;&nbsp;Bin (unfoldT↓ b {i} f y₁) (unfoldT↓ b {i} f y₂)</code></p></blockquote>-<p>To deal with the second task of building a roughly balanced binary tree, one may try this wrapper:</p>-<blockquote><p><code>data Split (a : Set): ℕ -> Set where<br />-&nbsp;&nbsp;Sp : (xs : [ a ]) -> (bnd : ℕ) -><br />-&nbsp;&nbsp;&nbsp;&nbsp;length xs bnd -> Split a bnd</code></p></blockquote>-<p>and try to code up a generator function <code>split↓</code> having this type:</p>-<blockquote><p><code>split↓ : forall {a i} -> Split a (suc i) -> a ⊎ (Split a i × Split a i)<br />-</code></p></blockquote>-<p>The function <code>split↓</code> I eventually come up with, however, is much more complicated than I had wished. Even worse, it is now <code>split↓</code> that fails to pass the termination check.</p>-<p><a href="http://www.cs.chalmers.se/~ulfn/">Ulf Norell</a> suggested some possible fixes. The difficulties, however, is probably a hint that there is something wrong in my approach in the first place. Rather than trying to fix it, Nils showed me how he would tackle the problem from the beginning.</p>-<h3>Using Well-Founded Recursion</h3>-<p>Nils showed me how to define <code>unfoldT↓</code> using <em>well-founded recursion</em>. For a simplified explanation, the <a href="http://appserv.cs.chalmers.se/users/ulfn/wiki/agda.php?n=Libraries.StandardLibrary">Standard Library</a> provides a function <code>-rec</code> having type (after normalisation):</p>-<blockquote><p><code>-rec : (P : ℕ -> Set) -><br />-&nbsp;&nbsp;(f : (i : ℕ) -> (rec : (j : ℕ) -> j ′ i -> P j) -> P i) -><br />-&nbsp;&nbsp;&nbsp;&nbsp;(x : ℕ) -> P x </code></p></blockquote>-<p>With <code>-rec</code> one can define functions on natural numbers by recursion, provided that the argument strictly decreases in each recursive call. <code>P</code> is the type of the result, parameterised by the input. The function <code>f</code> is a template that specifies the body of the recursion which, given <code>i</code>, computes some result of type <code>P i</code>. The functional argument <code>rec</code> is supposed to be the recursive call. The constraint <code>j ′ i</code>, however, guarantees that it accepts only inputs strictly smaller than <code>i</code> (the ordering <code>′ </code> is a variation of <code>&lt;</code> that is more suitable for this purpose). One may perhaps think of <code>-rec</code> as a fixed-point operator computing the fixed-point of <code>f</code>, only that <code>f</code> has to take <code>i</code> before <code>rec</code> because the latter depends on the former.</p>-<p>Let us try to define an unfold on trees using <code>-rec</code>. The &#8220;base-functor&#8221; of the datatype <code>Tree⁺ a</code> is <code>F b = a ⊎ b × b</code>. One of the lessons we have learnt is that it would be more convenient for the generating function to return the bound information. We could use a type like this:</p>-<blockquote><p><code>F a b k = a ⊎ ∃ (ℕ × ℕ) (\(i , j) -> b i × b j × i ′ k × j ′ k)</code>-</p></blockquote>-<p>But it is perhaps more reader-friendly to define the base functor as a datatype:</p>-<blockquote><p><code>data Tree⁺F (a : Set) (b : ℕ -> Set) : ℕ -> Set where<br />-&nbsp;&nbsp;tip : forall {k} -> a -> Tree⁺F a b k<br />-&nbsp;&nbsp;bin : forall {i j k} -><br />-&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;b i -> b j -> i ′ k -> j ′ k -> Tree⁺F a b k<br />-</code></p></blockquote>-<p>The generating function for the unfold should thus have type <code>forall {a b i} -> b i -> Tree⁺F a b i</code>.</p>-<p>The function <code>unfoldT↓F</code> is the template for <code>unfoldT↓</code>:</p>-<blockquote><p><code>unfoldT↓F : {a : Set} {b : ℕ -> Set} -><br />-&nbsp;&nbsp;(f : forall {i} -> b i -> Tree⁺F a b i) -><br />-&nbsp;&nbsp;&nbsp;(n : ℕ) -> ((i : ℕ) -> i ′ n -> b i -> Tree⁺ a) -><br />-&nbsp;&nbsp;&nbsp;&nbsp;b n -> Tree⁺ a<br />-unfoldT↓F f n rec y with f y<br />-&#8230; | tip a = Tip⁺ a<br />-&#8230; | bin {i} {j} y₁ y₂ i&lt;n j&lt;n =<br />-&nbsp;&nbsp;&nbsp;&nbsp;Bin⁺ (rec i i&lt;n y₁) (rec j j&lt;n y₂)<br />-</code></p></blockquote>-<p>Now <code>unfoldT↓</code> can be defined by:</p>-<blockquote><p><code>unfoldT↓ : {a : Set} {b : ℕ -> Set} -><br />-&nbsp;&nbsp;(f : forall {i} -> b i -> Tree⁺F a b i) -><br />-&nbsp;&nbsp;&nbsp;&nbsp;forall {n} -> b n -> Tree⁺ a<br />-unfoldT↓ {a}{b} f {n} y =<br />-&nbsp;&nbsp;&nbsp;&nbsp;-rec (\n -> b n -> Tree⁺ a) (unfoldT↓F f) n y </code></p></blockquote>-<p>All the definition above makes no recursive calls. All the tricks getting us through the termination check are hidden in <code>-rec</code>. How is it defined?</p>-<h3>Well-Founded Recursion Defined on ′</h3>-<p>Currently, well-founded recursion are defined in <code>Logic.Induction</code> and its sub-modules. They are very interesting modules to study. The definitions there, however, are very abstract. To understand how <code>-rec</code> works, let&#8217;s try to implement our own.</p>-<p>This is the definition of <code>′</code> from <code>Data.Nat</code>:</p>-<blockquote><p><code>data _≤′_ : Rel ℕ where<br />- ≤′-refl : forall {n} -> n ≤′ n<br />- ≤′-step : forall {m n} -> m ≤′ n -> m ≤′ suc n</code></p>-<p>_′_ : Rel ℕ<br />-m ′ n = suc m ≤′ n</p></blockquote>-<p>Recall that the recursion template <code>f</code> has type <code>forall i -> (forall j -> j ′ i -> P j) -> P i</code>. That is, given <code>i</code>, <code>f</code> computes <code>P i</code>, provided that we know of a method to compute <code>P j</code> for all <code>j ′ i</code>. Let us try to construct such a method using <code>f</code>. The function <code> guard f i</code> computes <code>f</code>, provided that the input is strictly smaller than <code>i</code>:</p>-<blockquote><p><code>guard : {P : ℕ -> Set} -><br />-&nbsp;&nbsp;&nbsp;(forall i -> (forall j -> j ′ i -> P j) -> P i) -><br />-&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;forall i -> forall j -> j ′ i -> P j<br />-guard f zero _ ()<br />-guard f .(suc j) j ≤′-refl = f j (guard f j)<br />-guard f (suc i) j (≤′-step j&lt;i) = guard f i j j&lt;i </code></p></blockquote>-<p>Observe that <code>guard</code> terminates because it is defined inductively on <code>i</code>. If we discard the type information, all what <code>guard f i j</code> is to make a call to <code>f j</code>. Before doing so, however, it checks through the proof to make sure that <code>j</code> is strictly smaller than <code>i</code>. In <code>f j (guard f j)</code>, the call to <code>guard f j</code> ensures that subsequent calls to <code>f</code> are given arguments smaller than <code>j</code>.</p>-<p>Now <code>-rec</code> can be defined by:</p>-<blockquote><p><code>-rec : (P : ℕ -> Set) -><br />-&nbsp;&nbsp;&nbsp;(forall i -> (forall j -> j ′ i -> P j) -> P i) -><br />-&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;forall n -> P n<br />--rec P f n = f n (guard f n)</code></p></blockquote>-<p>In <code>Logic.Induction.Nat</code>, <code>-rec</code> is an instance of well-founded recursion defined using the concept of <em>accessibility</em>, defined in <code>Logic.Induction.WellFounded</code>. I find them very interesting modules which I hope to understand more.</p>-<p><strong>To be continued&#8230;</strong></p></description>- <pubDate>Sat, 12 Apr 2008 16:22:42 +0000</pubDate>- <dc:creator>Shin</dc:creator>-</item>-<item>- <title>Joel Reymont: Cross-platform bytecode anyone?</title>- <guid isPermalink="false">tag:typepad.com,2003:post-48340944</guid>- <link>http://feeds.feedburner.com/~r/TenerifeSkunkworks/~3/268946453/cross-platform.html</link>- <description><p>Suppose I want to generate bytecode or executable code on Mac OSX or Linux and run it on Windows. Assume that I want to do that in a web application and that I only target x86.</p>--<p>What are my options?</p>-<p>The other qualifier is that the generated code should be .NET or should run in a VM that would, in turn, talk to .NET.</p>--<p>I could try Mono but I read someplace that generated assemblies cannot be used on Windows due to signing issues. I'm not sure this is the case, can someone correct me?</p>--<p>I could try Factor and write the COM interface on the Windows side. The Factor VM is reasonably small and the bytecode should run without change.</p>--<p>What else?</p>-<div class="feedflare">-<a href="http://feeds.feedburner.com/~f/TenerifeSkunkworks?a=8YdbBgG"><img src="http://feeds.feedburner.com/~f/TenerifeSkunkworks?i=8YdbBgG" border="0" /></a> <a href="http://feeds.feedburner.com/~f/TenerifeSkunkworks?a=NvKO8Mg"><img src="http://feeds.feedburner.com/~f/TenerifeSkunkworks?i=NvKO8Mg" border="0" /></a> <a href="http://feeds.feedburner.com/~f/TenerifeSkunkworks?a=9FRJRPg"><img src="http://feeds.feedburner.com/~f/TenerifeSkunkworks?i=9FRJRPg" border="0" /></a> <a href="http://feeds.feedburner.com/~f/TenerifeSkunkworks?a=vDRgsTG"><img src="http://feeds.feedburner.com/~f/TenerifeSkunkworks?i=vDRgsTG" border="0" /></a> <a href="http://feeds.feedburner.com/~f/TenerifeSkunkworks?a=5I1ReAg"><img src="http://feeds.feedburner.com/~f/TenerifeSkunkworks?i=5I1ReAg" border="0" /></a>-</div><img src="http://feeds.feedburner.com/~r/TenerifeSkunkworks/~4/268946453" height="1" width="1" /></description>- <pubDate>Sat, 12 Apr 2008 13:09:35 +0000</pubDate>- <dc:creator>Joel Reymont</dc:creator>-</item>-<item>- <title>Neil Mitchell: darcs Feature Request (Part II)</title>- <guid isPermalink="false">tag:blogger.com,1999:blog-7094652.post-3201719101251968153</guid>- <link>http://neilmitchell.blogspot.com/2008/04/darcs-feature-request-part-ii.html</link>- <description>I <a href="http://neilmitchell.blogspot.com/2008/01/darcs-feature-request.html">previously requested</a> a feature for darcs. I always pull from an http repo, and push over SSH. I have to push using <tt>--no-set-default</tt> and typing the ssh repo in full, which I automate with a <a href="http://darcs.haskell.org/packages/filepath/push.bat">.bat file</a> in each repo.<br /><br />Today I noticed that darcs has <tt>_darcs/prefs/repos</tt>, which seems to list the repo's that darcs has used. In one of my typical repo files, I have an http entry and an SSH entry. To get darcs to behave the way I want, all I need to do is push using the first non-http repo in that list.<br /><br />I have implemented my version of the darcs push command inside my paper tool, the code is all <a href="http://www.cs.york.ac.uk/fp/darcs/paper/Paper/Push.hs">online here</a>. Now I can delete all my push.bat scripts, and just type <tt>paper push</tt> from any darcs repo. As an added bonus, I now don't need to change to the root directory to perform a push.<br /><br />It would be really nice if someone could incorporate this feature into the main darcs codebase. However, I'm quite happy using my paper tool for now. I certainly don't have time to patch, or even build darcs :-)</description>- <pubDate>Sat, 12 Apr 2008 11:20:00 +0000</pubDate>- <dc:creator>Neil Mitchell</dc:creator>-</item>-<item>- <title>Conrad Parker: Release: Sweep 0.9.3</title>- <guid isPermalink="false">tag:blogger.com,1999:blog-9101292118679422945.post-6484626782594667327</guid>- <link>http://blog.kfish.org/2008/04/release-sweep-093.html</link>- <description>This is a bugfix release of <a href="http://www.metadecks.org/software/sweep/">Sweep</a>,-addressing <a href="http://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2008-1686">CVE-2008-1686</a>.-For details, see my earlier post about-<a href="http://blog.kfish.org/2008/04/release-libfishsound-091.html">libfishsound 0.9.1</a>.-Thanks to Peter Shorthose for managing this release.</description>- <pubDate>Sat, 12 Apr 2008 07:50:09 +0000</pubDate>- <dc:creator>Conrad Parker</dc:creator>-</item>-<item>- <title>Ulisses Costa: Life After People, Documentary</title>- <guid isPermalink="false">http://caos.di.uminho.pt/~ulisses/blog/2008/04/12/life-after-people-documentary/</guid>- <link>http://caos.di.uminho.pt/~ulisses/blog/2008/04/12/life-after-people-documentary/</link>- <description><p><!--post2pdf_exclude-->Last week, after making a work for the university, I was stumbling around and found an excellent documentary to see. Life after people is a documentary from History channel that try to respond the question:</p>-<blockquote>-<p id="result_box" dir="ltr"><em> What would happen to planet earth if the human race were to suddenly disappear forever?</em></p>-</blockquote>-<p>The idea is just great! Probably everyone at some point thought about that, and maybe didn&#8217;t have the imagination or the knowledge to get a clear picture like those in this documentary.</p>-<p><img src="http://caos.di.uminho.pt/~ulisses/blog/img/buildings_decomposing.jpg" align="left" height="164" width="297" /></p>-<p>The documentary have a lot of speculative facts, just a little bit americanized, but the idea of see all the things that we created being destroyed by the land there we live is fascinating.</p>-<p>Remember us that our planet is alive, and live by it self, and in some aspects needs help. We are small but at the same time we can do a lot of changes in our planet.</p>-<p>Well, I really liked this imaginative documentary, here is the &#8220;trailer&#8221;:</p>-<p>--</p>-<p><a href="http://www.history.com/minisites/life_after_people">Here</a> the oficial site of <a href="http://video.google.com/videoplay?docid=4939078184096254535">the documentary</a>.</p></description>- <pubDate>Sat, 12 Apr 2008 04:42:04 +0000</pubDate>- <dc:creator>ulisses</dc:creator>-</item>-<item>- <title>Eric Kow (kowey): darcs 2 at last!</title>- <guid isPermalink="false">tag:blogger.com,1999:blog-21123659.post-737614930474400956</guid>- <link>http://koweycode.blogspot.com/2008/04/darcs-2-at-last.html</link>- <description>I'm sure you've all seen David's <a href="http://thread.gmane.org/gmane.comp.version-control.darcs.devel/7809">announcement</a>: darcs 2.0.0 is out!<br /><h3>what's good</h3>In short, darcs 2.0 is safer and faster.<br /><br />Particularly, the dreaded exponential-time merge bug has now been largely resolved. Let me say it more carefully: while it may still be possible to run into exponential time merges, our improvements to conflict-handling should make it considerably less common. We hope that nobody ever runs into such a situation in practice.<br /><br />Other key points are improved the hashed inventory and pristine cache which darcs more robust (you no longer have to worry about third party tools like Eclipse or Unison messing things up by mucking around with darcs internals), the ssh-connection mode which speeds up SSH-issues a lot and kills the typing-your-password-ten-million-times issue dead (at most you'll have to type it in twice).<br /><br /><h3>what's bad</h3>On the one hand, darcs 2.0.0 should be much smoother and faster for most users. On the other hand, people with large repositories (e.g. GHC-sized) might find certain operations to be somewhat slower. David does not (yet) have ideas on how to make things better for such users, and is even recommending them to switch to something else. If you've got a repository of darcs' size (over 5000 patches, 6 years, 131 contributors) or smaller, you should continue using darcs, because we still think it works better: we're still the only ones around to offer <em>deep</em> cherry picking... something which we think would be hard to do without radically changing the way other VCSes work. If you would like to prove us wrong, please do so and we would be most grateful!<br /><br />Also, taking advantage of darcs 2 will require you to upgrade your repository to the <code>darcs-2</code> format (see <code>darcs convert</code>), which unfortunately, is not compatible with older versions of darcs. People with new repositories should definitely start using this format. People with old repositories should probably do so at the earliest convenient moment, although this means your users will have to upgrade. Please switch to the new format. It will make everybody's lives easier.<br /><br />The final piece of bad news: we're going to have to shift to a lighter weight development model, something which puts less strain on David and the rest of the contributors. The consequences are that patches might get less review [one maintainer and not two], and that you'll be seeing less of David on the mailing lists. The good news in the bad news is that our lighter weight development model is now being supported by increased automation of the administrative stuff. For example, our bug tracker is now integrated with the darcs repository so that it automatically knows when a ticket has been resolved by a patch. This increased automation gives us extra rigour and more time to think about making darcs better. The only thing we need is more of us. If you want a place to hone your Haskell, Perl or C... or if you think you know a thing or two about user interfaces, please spend some time with us.<br /><h3>to sum up...</h3>Have you been hesitating to try darcs out? Well, now is a good time to do so, as our killer bugs have been fixed as well as the kind of minor nuisances that get most of us. Or... are you looking for something to work on? Uncle David needs you!<br /><br />[note: Thanks to David Roundy for comments on a draft of this post]</description>- <pubDate>Fri, 11 Apr 2008 17:56:54 +0000</pubDate>- <dc:creator>kowey</dc:creator>-</item>-<item>- <title>Tom Moertel: That looks about right</title>- <guid isPermalink="false">urn:uuid:8c556b83-dcaa-4044-9f0f-7af434f6f3f7</guid>- <link>http://blog.moertel.com/articles/2008/04/11/that-looks-about-right</link>- <description><p>Via <a href="http://www.cwinters.com/news/display/3624">Chris</a>:</p>---<pre>$ history | awk '{print $2}' | sort | uniq -c | sort -rn | head- 196 git- 110 l- 102 cd- 70 make- 34 darcs- 30 pushd- 23 ssh- 23 m- 23 ls- 20 rm-</pre>-- <p>The <em>l</em> and <em>m</em> commands are aliases:</p>--- <ul>- <li><em>l</em> = <em>ls &#8211;CF</em></li>- <li><em>m</em> = <em>less</em></li>- </ul></description>- <pubDate>Fri, 11 Apr 2008 16:04:49 +0000</pubDate>- <dc:creator>Tom Moertel</dc:creator>-</item>-<item>- <title>Bryan O'Sullivan: Hoisted from someone else&#8217;s comments</title>- <guid isPermalink="false">http://www.serpentine.com/blog/2008/04/10/hoisted-from-someone-elses-comments/</guid>- <link>http://www.serpentine.com/blog/2008/04/10/hoisted-from-someone-elses-comments/</link>- <description>Marc Ambinder comments on the <a href="http://marcambinder.theatlantic.com/archives/2008/04/advance_praise_for_war_and_dec.php">peculiar cadence of the jacket blurbs</a> for Douglas Feith&#8217;s new book, to which some wag responds with a suggestion for a similar endorsement.--<blockquote>Feith&#8217;s book is perfectly rectangular. Its page numbers progress in a pleasing upward sequence. Its evident shortcomings in terms of accuracy are offset by its usefulness in balancing wobbly furniture.</blockquote></description>- <pubDate>Fri, 11 Apr 2008 06:11:47 +0000</pubDate>- <dc:creator>Bryan O'Sullivan (bos@serpentine.com)</dc:creator>-</item>--</channel>-</rss>