indieweb-algorithms 0.1.0 → 0.1.1
raw patch · 9 files changed
+411/−56 lines, 9 filesdep +errorsdep +xml-conduitdep +xml-conduit-writerdep ~http-link-headernew-uploader
Dependencies added: errors, xml-conduit, xml-conduit-writer, xml-lens
Dependency ranges changed: http-link-header
Files
- README.md +14/−19
- indieweb-algorithms.cabal +22/−10
- library/Data/IndieWeb/Authorship.hs +17/−8
- library/Data/IndieWeb/Endpoints.hs +5/−2
- library/Data/IndieWeb/MicroformatsToAtom.hs +101/−0
- library/Data/IndieWeb/MicroformatsUtil.hs +22/−0
- library/Data/IndieWeb/SiloToMicroformats.hs +62/−0
- test-suite/Data/IndieWeb/AuthorshipSpec.hs +25/−17
- test-suite/Data/IndieWeb/MicroformatsToAtomSpec.hs +143/−0
README.md view
@@ -1,15 +1,19 @@-# indieweb-algorithms [](https://hackage.haskell.org/package/indieweb-algorithms) [](https://travis-ci.org/myfreeweb/indieweb-algorithms) [](http://unlicense.org)+# indieweb-algorithms [](https://hackage.haskell.org/package/indieweb-algorithms) [](https://unlicense.org) A collection of implementations of [IndieWeb]- and [Microformats 2]-related algorithms (based on [microformats2-parser] and [http-link-header]): - finding all microformats of a given type (while retaining the path to them), ie. flattening the tree-- discovering **[authorship](http://indiewebcamp.com/authorship)** of an `h-entry`-- discovering [Webmention](http://indiewebcamp.com/Webmention)/[Micropub](http://indiewebcamp.com/Micropub)/[IndieAuth](http://indiewebcamp.com/IndieAuth)/etc. **endpoints** (HTTP `Link` header, `a` and `link` tags with the `rel` attribute)+- discovering **[authorship](https://indieweb.org/authorship)** of an `h-entry`+ - discovering the [representative h-card](https://microformats.org/wiki/representative-h-card-parsing)+- discovering [Webmention](https://indieweb.org/Webmention)/[Micropub](https://indieweb.org/Micropub)/[IndieAuth](https://indieweb.org/IndieAuth)/etc. **endpoints** (HTTP `Link` header, `a` and `link` tags with the `rel` attribute)+- parsing tweets on Twitter.com into microformats (like [php-mf2-shim](https://github.com/indieweb/php-mf2-shim))+- detecting [post types](httpss://indieweb.org/posts#Kinds_of_Posts)+- converting microformats to Atom feeds -[#IndieWeb]: http://indiewebcamp.com-[Microformats 2]: http://microformats.org/wiki/microformats2-[microformats2-parser]: https://github.com/myfreeweb/microformats2-parser-[http-link-header]: https://github.com/myfreeweb/http-link-header+[IndieWeb]: https://indieweb.org+[Microformats 2]: https://microformats.org/wiki/microformats2+[microformats2-parser]: https://codeberg.org/valpackett/microformats2-parser+[http-link-header]: https://codeberg.org/valpackett/http-link-header ## Usage @@ -35,23 +39,14 @@ ```bash $ stack build -$ stack test && rm tests.tix+$ stack test -$ stack ghci --ghc-options="-fno-hpc"+$ stack ghci ``` [stack]: https://github.com/commercialhaskell/stack -## Contributing--Please feel free to submit pull requests!-Bugfixes and simple non-breaking improvements will be accepted without any questions :-)--By participating in this project you agree to follow the [Contributor Code of Conduct](http://contributor-covenant.org/version/1/2/0/).--[The list of contributors is available on GitHub](https://github.com/myfreeweb/indieweb-algorithms/graphs/contributors).- ## License This is free and unencumbered software released into the public domain. -For more information, please refer to the `UNLICENSE` file or [unlicense.org](http://unlicense.org).+For more information, please refer to the `UNLICENSE` file or [unlicense.org](https://unlicense.org).
indieweb-algorithms.cabal view
@@ -1,24 +1,25 @@ name: indieweb-algorithms-version: 0.1.0+version: 0.1.1 synopsis: A collection of implementations of IndieWeb algorithms. category: Web-homepage: https://github.com/myfreeweb/indieweb-algorithms-author: Greg V-copyright: 2015 Greg V <greg@unrelenting.technology>-maintainer: greg@unrelenting.technology+homepage: https://codeberg.org/valpackett/indieweb-algorithms+bug-reports: https://codeberg.org/valpackett/indieweb-algorithms/issues+author: Val Packett+copyright: 2015-2017 Val Packett <val@packett.cool>+maintainer: val@packett.cool license: PublicDomain license-file: UNLICENSE build-type: Simple-cabal-version: >= 1.18+cabal-version: 1.18 extra-source-files: README.md tested-with:- GHC == 7.10.2+ GHC == 9.0.2 source-repository head type: git- location: git://github.com/myfreeweb/indieweb-algorithms.git+ location: https://codeberg.org/valpackett/indieweb-algorithms.git library build-depends:@@ -29,21 +30,27 @@ , time , either , safe+ , errors , containers , unordered-containers , vector , lens , aeson , lens-aeson+ , xml-conduit+ , xml-lens >= 0.2+ , xml-conduit-writer , data-default , network-uri , microformats2-parser- , http-link-header+ , http-link-header >= 1.2.0 default-language: Haskell2010 exposed-modules: Data.IndieWeb.Authorship Data.IndieWeb.Endpoints+ Data.IndieWeb.MicroformatsToAtom Data.IndieWeb.MicroformatsUtil+ Data.IndieWeb.SiloToMicroformats ghc-options: -Wall hs-source-dirs: library @@ -57,20 +64,25 @@ , network-uri , hspec , hspec-expectations-pretty-diff+ , lens , aeson+ , lens-aeson+ , xml-conduit , template-haskell , indieweb-algorithms , microformats2-parser , raw-strings-qq , aeson-qq , data-default+ , http-link-header >= 1.2.0 default-language: Haskell2010- ghc-options: -threaded -Wall -fhpc+ ghc-options: -threaded -Wall hs-source-dirs: test-suite main-is: Spec.hs other-modules: TestCommon Data.IndieWeb.AuthorshipSpec Data.IndieWeb.EndpointsSpec+ Data.IndieWeb.MicroformatsToAtomSpec Data.IndieWeb.MicroformatsUtilSpec type: exitcode-stdio-1.0
library/Data/IndieWeb/Authorship.hs view
@@ -2,27 +2,27 @@ module Data.IndieWeb.Authorship where -#if __GLASGOW_HASKELL__ < 709+#if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif import Control.Monad import Control.Monad.Trans.Maybe import Control.Lens import qualified Data.Text as T-import qualified Data.ByteString.Lazy as LB import qualified Data.Vector as V-import Data.Foldable (asum)+import Data.Foldable (asum, find) import Data.Maybe import Data.Aeson import Data.Aeson.Lens import Data.Microformats2.Parser import Data.IndieWeb.MicroformatsUtil+import Text.XML (Document) import Network.URI import Safe (headMay) -- | Finds the authors of an h-entry, discovering its authorship <http://indiewebcamp.com/authorship> using the HTTP fetcher function from arguments. entryAuthors ∷ Monad μ ⇒ Mf2ParserSettings- → (URI → μ (Maybe LB.ByteString)) -- ^ the URI fetcher function+ → (URI → μ (Maybe Document)) -- ^ the URI fetcher function → URI -- ^ the URI of the page the entry was extracted from → Value -- ^ the full Microformats 2 parse of the page as extracted by 'Data.Microformats2.Parser.parseMf2' → (Value, [Value]) -- ^ (the h-entry, [parent microformats]) as extracted by 'Data.IndieWeb.MicroformatsUtil.allMicroformatsOfType'@@ -42,9 +42,18 @@ entryAuthor = getAuthorProp entry feedAuthor = getAuthorProp =<< (headMay $ filter (isMf "h-feed") parents) getAuthorProp = (V.toList <$>) . (^? key "properties" . key "author" . _Array)- isMf t = (String t `V.elem`) . (fromMaybe V.empty) . (^? key "type" . _Array) cardFromUri uri = do -- TODO: only allow http(s)- html ← fetch $ uri `relativeTo` entryUri- -- TODO: representative h-card, not just first- return $ fmap fst $ headMay =<< allMicroformatsOfType "h-card" =<< parseMf2 mfSettings <$> documentRoot <$> parseLBS <$> html+ let uri' = uri `relativeTo` entryUri+ html ← fetch uri'+ let mfSettings' = mfSettings { baseUri = Just uri' }+ return $ representativeCard uri' =<< parseMf2 mfSettings' <$> documentRoot <$> html++representativeCard ∷ URI → Value → Maybe Value+representativeCard uri mfRoot = asum [ matchingUidUrl, matchingRelMeUrl, matchingOnlyUrl ]+ where matchingUidUrl = find (\c → any (== uri) (uris "url" c) && any (== uri) (uris "uid" c)) cards+ matchingRelMeUrl = find (any (`elem` relMeUris) . uris "url") cards+ matchingOnlyUrl = if length cards /= 1 then Nothing else find (any (== uri) . uris "url") cards+ relMeUris = mapMaybe (parseURI . T.unpack) $ mfRoot ^.. key "rels" . key "me" . values . _String+ uris k c = mapMaybe (parseURI . T.unpack) $ c ^.. key "properties" . key k . values . _String+ cards = fmap fst $ fromMaybe [] $ allMicroformatsOfType "h-card" mfRoot
library/Data/IndieWeb/Endpoints.hs view
@@ -1,7 +1,10 @@-{-# LANGUAGE OverloadedStrings, UnicodeSyntax #-}+{-# LANGUAGE OverloadedStrings, UnicodeSyntax, CPP #-} module Data.IndieWeb.Endpoints where +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif import Control.Lens import Data.Maybe (catMaybes) import Data.List (nub)@@ -14,7 +17,7 @@ discoverEndpoints ∷ [T.Text]-- ^ the rels of the links you want to find (alternatives, like "webmention" and "http://webmention.org/") → Value -- ^ the full Microformats 2 parse of the page as extracted by 'Data.Microformats2.Parser.parseMf2'- → [Link] -- ^ the Link header as parsed by 'Network.HTTP.Link.parseLinkHeader'+ → [Link URI] -- ^ the Link header as parsed by 'Network.HTTP.Link.parseLinkHeader' → [URI] discoverEndpoints rels mfRoot linkH = nub $ headerLinks ++ mfLinks where headerLinks = map href $ concat $ map (\r → filter (\(Link _ as) → (Rel, r) `elem` as) linkH) rels
+ library/Data/IndieWeb/MicroformatsToAtom.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE OverloadedStrings, UnicodeSyntax #-}++module Data.IndieWeb.MicroformatsToAtom (+ feedToAtom+, atomForEntry+, asForEntry+, el+, elA+, atom+, empty+) where++import Control.Lens hiding (element)+import Control.Monad+import Control.Applicative ((<|>))+import Data.Maybe+import Data.Text as T (Text, isPrefixOf, drop)+import Data.List (sortOn)+import Data.Aeson+import Data.Aeson.Lens+import Text.XML.Writer+import Text.XML+import Data.IndieWeb.MicroformatsUtil++atom ∷ Text → Name+atom x = Name x (Just "http://www.w3.org/2005/Atom") Nothing++el ∷ ToXML a ⇒ Text → a → XML+el x = element (atom x)++elA ∷ ToXML a ⇒ Text → [(Name, Text)] → a → XML+elA x = elementA (atom x)++firstStr ∷ AsValue s ⇒ Text → s → Maybe Text+firstStr k = (^? key "properties" . key k . nth 0 . _String)++prop ∷ (t → XML) → Maybe t → XML+prop f (Just x) = f x+prop _ _ = empty+++-- | Converts a givent Microformats 2 parse to an Atom feed.+feedToAtom ∷ XML → Value → Document+feedToAtom metaXml mfRoot =+ document (atom "feed") $ do+ metaXml++ let isAuthorOfFeed (_, p:_) = isMf "h-feed" p+ isAuthorOfFeed _ = False+ author = take 1 $ reverse $ sortOn isAuthorOfFeed $ fromMaybe [] $ allMicroformatsOfType "h-card" mfRoot+ forM_ author $ \(card, _) → do+ atomForCard card+ prop (el "logo" . content) $ firstStr "photo" card++ let entries = fromMaybe [] $ allMicroformatsOfType "h-entry" mfRoot+ forM_ entries $ \(entry, path) →+ el "entry" $ atomForEntry entry+++atomForCard ∷ Value → XML+atomForCard card = el "author" $ do+ prop (el "name" . content) $ firstStr "name" card+ prop (el "uri" . content) $ firstStr "url" card+ prop (el "email" . content) $ (\x → if "mailto:" `T.isPrefixOf` x then T.drop 7 x else x) <$> firstStr "email" card+ prop (\u → elA "link" [("rel", "alternate"), ("type", "text/html"), ("href", u)] empty) $ firstStr "url" card+ prop (\u → elA "link" [("rel", "avatar"), ("href", u)] empty) $ firstStr "photo" card+ asType "person"++atomForEntry ∷ Value → XML+atomForEntry entry = do+ prop (el "id" . content) $ firstStr "uid" entry <|> firstStr "url" entry+ el "title" $ content $ if detectEntryType entry == Note then "" else (fromMaybe "" $ firstStr "name" entry)+ prop (\u → elA "link" [("rel", "alternate"), ("type", "text/html"), ("href", u)] empty) $ firstStr "url" entry+ prop (el "published" . content) $ firstStr "published" entry+ prop (el "updated" . content) $ firstStr "updated" entry+ prop (elA "content" [("type", "html")] . content) $ entry ^? key "properties" . key "content" . nth 0 . key "html" . _String+ mapM_ atomForCard (entry ^.. key "properties" . key "author")+ asForEntry entry++asType, asVerb ∷ Text → XML+asType x = element (Name "object-type" (Just "http://activitystrea.ms/spec/1.0/") Nothing) $ content $ "http://activitystrea.ms/schema/1.0/" <> x+asVerb x = element (Name "verb" (Just "http://activitystrea.ms/spec/1.0/") Nothing) $ content x+++thrInReplyTo ∷ Text → XML+thrInReplyTo x = elementA (Name "in-reply-to" (Just "http://purl.org/syndication/thread/1.0") Nothing) [("ref", x), ("href", x)] empty++asForEntry ∷ Value → XML+asForEntry entry = asForEntry' (detectEntryType entry) entry+ where asForEntry' Like e = asVerb "like" >> nest e "like-of"+ asForEntry' RSVP e = fromMaybe empty (asVerb . ("rsvp-" <>) <$> e ^? key "properties" . key "rsvp" . nth 0 . _String) >> asType "event"+ asForEntry' Checkin _ = asVerb "checkin" >> asType "place"+ asForEntry' Repost e = asVerb "share" >> nest e "repost-of"+ asForEntry' Reply e = asVerb "post" >> asType "comment" >> mapM_ thrInReplyTo (refUrls e "in-reply-to")+ asForEntry' Bookmark _ = asVerb "post" >> asType "bookmark"+ asForEntry' Article _ = asVerb "post" >> asType "article"+ asForEntry' _ _ = asVerb "post" >> asType "note"+ refUrls e k = e ^.. key "properties" . key k . values . key "properties" . key "url" . values . _String+ nest e k = forM_ (e ^.. key "properties" . key k . values) $ \ee → do+ asType "activity"+ element (Name "object" (Just "http://activitystrea.ms/spec/1.0/") Nothing) $ atomForEntry ee
library/Data/IndieWeb/MicroformatsUtil.hs view
@@ -25,3 +25,25 @@ then (v, path) : acc' else acc' Just $ concatMap (findOfType [] []) items++-- | Tests whether a given Value is of a given microformat type (e.g. h-entry, h-feed).+isMf ∷ T.Text → Value → Bool+isMf t = (String t `V.elem`) . (fromMaybe V.empty) . (^? key "type" . _Array)++data EntryType = Repost | Like | Bookmark | RSVP | Reply | Checkin | Event | Audio | Photo | Article | Note+ deriving (Show, Eq)++-- | Detects a post type (https://indiewebcamp.com/posts#Kinds_of_Posts)+detectEntryType ∷ Value → EntryType+detectEntryType entry+ | isJust (entry ^? key "properties" . key "repost-of" . nth 0) = Repost+ | isJust (entry ^? key "properties" . key "like-of" . nth 0) = Like+ | isJust (entry ^? key "properties" . key "bookmark-of" . nth 0) = Bookmark+ | isJust (entry ^? key "properties" . key "rsvp" . nth 0) = RSVP+ | isJust (entry ^? key "properties" . key "in-reply-to" . nth 0) = Reply+ | isJust (entry ^? key "properties" . key "location" . nth 0) = Checkin+ | isJust (entry ^? key "properties" . key "event" . nth 0) = Event+ | isJust (entry ^? key "properties" . key "audio" . nth 0) = Audio+ | isJust (entry ^? key "properties" . key "photo" . nth 0) = Photo+ | isJust (entry ^? key "properties" . key "name" . nth 0) && (entry ^? key "properties" . key "name" . nth 0) /= (entry ^? key "properties" . key "content" . nth 0 . key "value") = Article+ | otherwise = Note
+ library/Data/IndieWeb/SiloToMicroformats.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings, UnicodeSyntax #-}++module Data.IndieWeb.SiloToMicroformats where++import Prelude+import Text.XML.Lens+import qualified Data.Text as T+import qualified Data.Text.Read as T+import Data.Aeson+import Data.Aeson.Lens (key)+import Data.Maybe+import Control.Applicative+import Control.Lens hiding ((.=))+import Control.Error.Util (hush)+import Data.Time.Format+import Data.Time.Clock.POSIX+import Data.Microformats2.Parser.HtmlUtil+import Data.Microformats2.Parser.Property (getImgSrc)+import Data.Microformats2.Parser (extractProperty, Mf2ParserSettings)++-- | Parses a twitter.com tweet into an h-entry value.+parseTwitter ∷ Mf2ParserSettings → Element → Maybe Value+parseTwitter s r = if isJust tweet && isJust username && isJust tweetText+ then Just wrapper+ else Nothing+ where wrapper = object [ "type" .= [ String "h-entry" ]+ , "properties" .= props ]+ props = object [ "uid" .= [ permalink ]+ , "url" .= [ permalink ]+ , "content" .= [ tweetText ]+ , "name" .= [ fromMaybe Null $ tweetText >>= (^? key "value") ]+ , "published" .= [ str timestamp ]+ , "author" .= [ author ]+ , "comment" .= comments ]+ author = object [ "type" .= [ String "h-card" ]+ , "properties" .= object ([ "uid" .= [ profileUrl username ]+ , "url" .= [ profileUrl username ]+ , "name" .= [ str fullname ]+ , "note" .= [ str bio ]+ , "nickname" .= [ str username ]+ , "photo" .= [ str avatar ] ] ++ pronouns) ]+ comments = mapMaybe (parseTwitter s) $ r ^.. hasClass "permalink-replies" ... hasClass "tweet"+ profileUrl (Just x) = String $ "https://twitter.com/" <> T.dropWhile (== '@') x+ profileUrl _ = Null+ tweetText = tweet >>= (^? hasClass "tweet-text") >>= return . extractProperty s "e"+ fullname = tweet >>= (^? hasClass "fullname") >>= getInnerTextRaw+ timestamp = tweet >>= (^? hasClass "_timestamp" . attr "data-time") >>= reformatTime+ reformatTime x = T.pack <$> formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%S") <$>+ posixSecondsToUTCTime <$> realToFrac <$> fst <$> (hush $ T.decimal x ∷ Maybe (Integer, T.Text))+ username = tweet >>= (^? hasClass "username") >>= getInnerTextRaw+ avatar = tweet >>= (^? hasClass "avatar") >>= getImgSrc+ permalink = tweet >>= (^? hasClass "tweet-timestamp") >>= return . extractProperty s "u"+ bio = (r ^? hasClass "ProfileHeaderCard-bio" ) >>= getInnerTextRaw+ pronouns = parsePronouns [] $ fromMaybe [] $ T.splitOn "/" <$> r ^? hasClass "ProfileSidebar" . cosmos . named "a" . attributeSatisfies "title" ("pronoun.is/" `T.isInfixOf`) . attr "title"+ parsePronouns result (w : ww : "pronoun.is" : n : o : _ : p : _) = parsePronouns (("x-pronoun-posessive" .= [ String p ]) : result) (w : ww : "pronoun.is" : n : o : [])+ parsePronouns result (w : ww : "pronoun.is" : n : o : _) = parsePronouns (("x-pronoun-oblique" .= [ String o ]) : result) (w : ww : "pronoun.is" : n : [])+ parsePronouns result (_ : _ : "pronoun.is" : n : _) = ("x-pronoun-nominative" .= [ String n ]) : result+ parsePronouns result _ = result+ tweet = r ^? hasClass "permalink-tweet" <|> r ^? hasClass "tweet"+ hasClass c = cosmos . attributeSatisfies "class" (c `T.isInfixOf`)+ str (Just x) = String x+ str _ = Null
test-suite/Data/IndieWeb/AuthorshipSpec.hs view
@@ -1,7 +1,10 @@-{-# LANGUAGE QuasiQuotes, OverloadedStrings, UnicodeSyntax #-}+{-# LANGUAGE QuasiQuotes, OverloadedStrings, UnicodeSyntax, CPP #-} module Data.IndieWeb.AuthorshipSpec (spec) where +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif import Test.Hspec hiding (shouldBe) import Test.Hspec.Expectations.Pretty (shouldBe) import TestCommon@@ -9,7 +12,8 @@ import qualified Data.ByteString.Lazy as LB import Data.Functor.Identity import Data.Maybe-import Data.Aeson+import Data.Aeson.Lens+import Control.Lens ((^?), _Just, _head) import Data.Microformats2.Parser import Data.IndieWeb.Authorship import Data.IndieWeb.MicroformatsUtil@@ -17,36 +21,40 @@ spec ∷ Spec spec = do describe "findAuthors" $ do- let o = object- mockFetch ∷ URI → Identity (Maybe LB.ByteString)+ let mockFetch ∷ URI → Identity (Maybe LB.ByteString) mockFetch "http://direct" = return $ Just [xml|<body><div class="h-entry"> <data class=p-name value=Name> <div class="p-author h-card"><h1 class="p-name">Author from Direct!|] mockFetch "http://link" = return $ Just [xml|<body><div class="h-entry"> <data class=p-name value=Name> <a class="p-author">http://author/page</a>|]+ mockFetch "http://link-relme" = return $ Just [xml|<body><div class="h-entry"> <data class=p-name value=Name> <a class="p-author">http://author/page-relme</a>|]+ mockFetch "http://link-only-url" = return $ Just [xml|<body><div class="h-entry"> <data class=p-name value=Name> <a class="p-author">http://author/page-only-url</a>|]+ mockFetch "http://link-not-only-url" = return $ Just [xml|<body><div class="h-entry"> <data class=p-name value=Name> <a class="p-author">http://author/page-not-only-url</a>|] mockFetch "http://rel" = return $ Just [xml|<body> <a href="http://author/page" rel="author"></a><div class="h-entry"><data class=p-name value=Name>|] mockFetch "http://author/page/link-relative" = return $ Just [xml|<body><div class="h-entry"> <data class=p-name value=Name> <a class="p-author">/page</a>|] mockFetch "http://feed" = return $ Just [xml|<body><div class="h-feed"> <div class="p-author h-card"><h1 class="p-name">Author from Feed!</h1></div><div class="h-entry"><data class=p-name value=Name>|] mockFetch "http://feed/link" = return $ Just [xml|<body><div class="h-feed"> <a class="p-author">http://author/page</a><div class="h-entry"><data class=p-name value=Name>|]- mockFetch "http://author/page" = return $ Just [xml|<body><div class="h-card"><h1 class="p-name">Author from Page!|]+ mockFetch "http://author/page" = return $ Just [xml|<body><div class="h-card"><a class="u-url u-uid" href="http://author/page"><h1 class="p-name">Author from Page!|]+ mockFetch "http://author/page-relme" = return $ Just [xml|<body><div class="h-card"><a rel="me" classexample="u-url" href="http://example"><h1 class="p-name">Author from Page-relme!|]+ mockFetch "http://author/page-only-url" = return $ Just [xml|<body><div class="h-card"><a class="u-url" href="http://author/page-only-url"><h1 class="p-name">Author from Page-only-url!|]+ mockFetch "http://author/page-not-only-url" = return $ Just [xml|<body><div class="h-card"><a class="u-url" href="http://author/page-not-only-url"><h1 class="p-name">Author from Page-not-only-url!</div><div class="h-card"><a class="u-url" href="http://author/page-not-only-url"><h1 class="p-name">Author from Page-not-only-url!|] mockFetch _ = return Nothing rE u = let mf = parseMf2 def . documentRoot . parseLBS . fromMaybe "" . runIdentity $ mockFetch u in- runIdentity . entryAuthors def mockFetch u mf . head . fromJust $ allMicroformatsOfType "h-entry" mf- card n = o [ "value" .= String n- , "type" .= [ String "h-card" ]- , "properties" .= o [ "name" .= [ String n ] ] ]- card' n = o [ "type" .= [ String "h-card" ]- , "properties" .= o [ "name" .= [ String n ] ] ]+ runIdentity . entryAuthors def (\x → mockFetch x >>= \y → return $ parseLBS <$> y) u mf . head . fromJust $ allMicroformatsOfType "h-entry" mf+ firstName = _Just . _head . key "properties" . key "name" . nth 0 . _String it "finds the author h-cards embedded in the h-entry" $ do- rE "http://direct" `shouldBe` Just [ card "Author from Direct!" ]+ rE "http://direct" ^? firstName `shouldBe` Just "Author from Direct!" it "finds the author h-cards embedded in the h-feed parent of h-entry" $ do- rE "http://feed" `shouldBe` Just [ card "Author from Feed!" ]+ rE "http://feed" ^? firstName `shouldBe` Just "Author from Feed!" it "finds the author h-cards linked from the h-entry" $ do- rE "http://link" `shouldBe` Just [ card' "Author from Page!" ]+ rE "http://link" ^? firstName `shouldBe` Just "Author from Page!"+ rE "http://link-relme" ^? firstName `shouldBe` Just "Author from Page-relme!"+ rE "http://link-only-url" ^? firstName `shouldBe` Just "Author from Page-only-url!"+ rE "http://link-not-only-url" ^? firstName `shouldBe` Nothing it "finds the author h-cards linked from the h-feed parent of h-entry" $ do- rE "http://feed/link" `shouldBe` Just [ card' "Author from Page!" ]+ rE "http://feed/link" ^? firstName `shouldBe` Just "Author from Page!" it "finds the author h-cards linked as rel=author" $ do- rE "http://rel" `shouldBe` Just [ card' "Author from Page!" ]- rE "http://author/page/link-relative" `shouldBe` Just [ card' "Author from Page!" ]+ rE "http://rel" ^? firstName `shouldBe` Just "Author from Page!"+ rE "http://author/page/link-relative" ^? firstName `shouldBe` Just "Author from Page!"
+ test-suite/Data/IndieWeb/MicroformatsToAtomSpec.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE QuasiQuotes, OverloadedStrings, UnicodeSyntax #-}++module Data.IndieWeb.MicroformatsToAtomSpec where++import Test.Hspec+import TestCommon+import Text.XML+import Data.Text.Lazy (Text, unpack)+import Data.Aeson hiding (json)+import Data.IndieWeb.MicroformatsToAtom++ex ∷ Value+ex = [json|{+ "items": [+ {+ "type": [ "h-entry" ],+ "properties": {+ "published": [ "2016-03-15T21:03:52.570481000000Z" ],+ "url": [ "https://unrelenting.technology/notes/2016-03-15-21-03-52" ],+ "content": [ { "value": "Updated the build of sweetroll on this website", "html": " \u003cp\u003eUpdated the build of \u003ca href=\"https://codeberg.org/valpackett/sweetroll\"\u003esweetroll\u003c/a\u003e on this website \u003c/p\u003e\u003ca href=\"https://brid.gy/publish/twitter\"\u003e\u003c/a\u003e " } ],+ "name": [ "Updated the build of sweetroll on this website" ]+ }+ },+ {+ "type": [ "h-entry" ],+ "properties": {+ "published": [ "2016-03-14T22:23:11.089Z" ],+ "url": [ "https://unrelenting.technology/responses/reply" ],+ "content": [ { "value": "(Reply test)", "html": " \u003cp\u003e(Reply test)\u003c/p\u003e" } ],+ "name": [ "(Reply test)" ],+ "in-reply-to": [+ {+ "type": [ "h-entry" ],+ "properties": {+ "url": [ "https://unrelenting.technology/responses/parent" ]+ }+ }+ ]+ }+ },+ {+ "type": [ "h-entry" ],+ "properties": {+ "published": [ "2016-03-14T22:23:11.089Z" ],+ "url": [ "https://unrelenting.technology/notes/repost" ],+ "content": [ { "value": "(Repost test)", "html": " \u003cp\u003e(Repost test)\u003c/p\u003e" } ],+ "name": [ "(Repost test)" ],+ "repost-of": [+ {+ "type": [ "h-entry" ],+ "properties": {+ "published": [ "2016-03-14T22:23:11.089Z" ],+ "url": [ "https://unrelenting.technology/notes/original" ],+ "content": [ { "value": "(Repost original)", "html": " \u003cp\u003e(Repost original)\u003c/p\u003e" } ],+ "name": [ "(Repost original)" ]+ }+ }+ ]+ }+ },+ {+ "type": [ "h-card" ],+ "properties": {+ "name": [ "Greg" ],+ "email": [ "mailto:val@packett.cool" ],+ "photo": [ "https://www.gravatar.com/avatar/5e7281cf21d93c6a238749790afe086c" ],+ "note": [ "My name's Greg. I do a lot of software development (mostly web and mobile), some design and photography. my.pronoun.is/they/them." ],+ "url": [ "https://unrelenting.technology/" ],+ "key": [ "https://unrelenting.technology/pub/3B011BAF.asc" ],+ "x-pronoun-oblique": [ "them" ],+ "x-pronoun-nominative": [ "they" ]+ }+ }+ ],+ "rels": {+ "home": [ "https://unrelenting.technology/" ],+ "author": [ "https://unrelenting.technology/" ]+ },+ "rel-urls": {+ "https://unrelenting.technology/": { "text": "Greg", "rels": [ "me", "home", "author" ] }+ }+} |]++exAtom ∷ Text+exAtom = [xml|+<?xml version="1.0" encoding="UTF-8"?>+<feed xmlns="http://www.w3.org/2005/Atom">+ <author>+ <name>Greg</name>+ <uri>https://unrelenting.technology/</uri>+ <email>val@packett.cool</email>+ <link href="https://unrelenting.technology/" rel="alternate" type="text/html"/>+ <link href="https://www.gravatar.com/avatar/5e7281cf21d93c6a238749790afe086c" rel="avatar"/>+ <object-type xmlns="http://activitystrea.ms/spec/1.0/">http://activitystrea.ms/schema/1.0/person</object-type>+ </author>+ <logo>https://www.gravatar.com/avatar/5e7281cf21d93c6a238749790afe086c</logo>+ <entry>+ <id>https://unrelenting.technology/notes/2016-03-15-21-03-52</id>+ <title>Updated the build of sweetroll on this website</title>+ <link href="https://unrelenting.technology/notes/2016-03-15-21-03-52" rel="alternate" type="text/html"/>+ <published>2016-03-15T21:03:52.570481000000Z</published>+ <content type="html"> \u003cp\u003eUpdated the build of \u003ca href="https://codeberg.org/valpackett/sweetroll"\u003esweetroll\u003c/a\u003e on this website \u003c/p\u003e\u003ca href="https://brid.gy/publish/twitter"\u003e\u003c/a\u003e </content>+ <verb xmlns="http://activitystrea.ms/spec/1.0/">post</verb>+ <object-type xmlns="http://activitystrea.ms/spec/1.0/">http://activitystrea.ms/schema/1.0/note</object-type>+ </entry>+ <entry>+ <id>https://unrelenting.technology/responses/reply</id>+ <title>(Reply test)</title>+ <link href="https://unrelenting.technology/responses/reply" rel="alternate" type="text/html"/>+ <published>2016-03-14T22:23:11.089Z</published>+ <content type="html"> \u003cp\u003e(Reply test)\u003c/p\u003e</content>+ <verb xmlns="http://activitystrea.ms/spec/1.0/">post</verb>+ <object-type xmlns="http://activitystrea.ms/spec/1.0/">http://activitystrea.ms/schema/1.0/comment</object-type>+ <in-reply-to xmlns="http://purl.org/syndication/thread/1.0" ref="https://unrelenting.technology/responses/parent" href="https://unrelenting.technology/responses/parent"></in-reply-to>+ </entry>+ <entry>+ <id>https://unrelenting.technology/notes/repost</id>+ <title>(Repost test)</title>+ <link href="https://unrelenting.technology/notes/repost" rel="alternate" type="text/html"/>+ <published>2016-03-14T22:23:11.089Z</published>+ <content type="html"> \u003cp\u003e(Repost test)\u003c/p\u003e</content>+ <verb xmlns="http://activitystrea.ms/spec/1.0/">share</verb>+ <in-reply-to xmlns="http://purl.org/syndication/thread/1.0" ref="https://unrelenting.technology/notes/original" href="https://unrelenting.technology/responses/parent"></in-reply-to>+ <object-type xmlns="http://activitystrea.ms/spec/1.0/">http://activitystrea.ms/schema/1.0/activity</object-type>+ <object xmlns="http://activitystrea.ms/spec/1.0/">+ <id>https://unrelenting.technology/notes/original</id>+ <title>(Repost original)</title>+ <link href="https://unrelenting.technology/notes/original" rel="alternate" type="text/html"/>+ <published>2016-03-14T22:23:11.089Z</published>+ <content type="html"> \u003cp\u003e(Repost original)\u003c/p\u003e</content>+ <verb xmlns="http://activitystrea.ms/spec/1.0/">post</verb>+ <object-type xmlns="http://activitystrea.ms/spec/1.0/">http://activitystrea.ms/schema/1.0/note</object-type>+ </object>+ </entry>+</feed>|]++spec ∷ Spec+spec = do+ describe "feedToAtom" $ do+ it "converts h-entries to an Atom feed" $ do+ --feedToAtom empty ex `shouldBe` parseText_ def exAtom+ --putStrLn $ unpack $ renderText def $ feedToAtom empty ex+ pendingWith "XML comparison sucks because of whitespace nodes and namespaces"