diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,12 +1,10 @@
[](https://hackage.haskell.org/package/microformats2-parser)
-[](http://unlicense.org)
+[](https://unlicense.org)
# microformats2-parser
[Microformats 2] parser for Haskell! [#IndieWeb]
-Originally created for [sweetroll].
-
- parses `items`, `rels`, `rel-urls`
- resolves relative URLs (with support for the `` tag), including inside of `html` for `e-*` properties
- parses the [value-class-pattern](http://microformats.org/wiki/value-class-pattern), including date and time normalization
@@ -19,10 +17,9 @@
[Microformats 2]: http://microformats.org/wiki/microformats2
[#IndieWeb]: https://indieweb.org
-[sweetroll]: https://github.com/unrelentingtech/sweetroll
[tagstream-conduit]: https://hackage.haskell.org/package/tagstream-conduit
[JF2]: https://www.w3.org/TR/jf2/
-[http-link-header]: https://github.com/unrelentingtech/http-link-header
+[http-link-header]: https://codeberg.org/valpackett/http-link-header
## [DEMO PAGE](https://unrelenting.technology/mf2/)
@@ -65,14 +62,6 @@
```
[stack]: https://github.com/commercialhaskell/stack
-
-## Contributing
-
-Please feel free to submit pull requests!
-
-By participating in this project you agree to follow the [Contributor Code of Conduct](https://www.contributor-covenant.org/version/1/4/code-of-conduct/) and to release your contributions under the Unlicense.
-
-[The list of contributors is available on GitHub](https://github.com/unrelentingtech/microformats2-parser/graphs/contributors).
## License
diff --git a/executable/WebApp.hs b/executable/WebApp.hs
--- a/executable/WebApp.hs
+++ b/executable/WebApp.hs
@@ -27,12 +27,12 @@
H.head $ do
H.meta ! charset "utf-8"
H.title "microformats2-parser"
- H.style "body { font-family: 'Helvetica Neue', sans-serif; max-width: 900px; margin: 0 auto; } a { color: #ba2323; } a:hover { color: #da4343; } pre, input:not([type=checkbox]), textarea, button { width: 100%; } input:not([type=checkbox]), textarea, label { margin-bottom: 1em; display: block; } textarea { resize: vertical; min-height: 15em; } pre { white-space: pre-wrap; } footer { margin: 2em 0; }"
+ H.style "body { font-family: 'Helvetica Neue', sans-serif; max-width: 900px; margin: 0 auto; } a { color: #ba2323; } a:hover { color: #da4343; } pre, input:not([type=checkbox]), textarea, button { width: 100%; border-radius: 3px; } input:not([type=checkbox]), textarea, label { margin-bottom: 1em; display: block; } textarea { resize: vertical; min-height: 15em; } pre { white-space: pre-wrap; } footer { margin: 2em 0; } @media screen and (prefers-color-scheme: dark) { html { background: #222; color: #f1f1f1; } input, textarea { background: #444; color: #fefefe; } a { color: #da4343; } a:hover { color: #ea6363; } }"
H.body $ do
H.header $ do
h1 $ do
- a ! href "https://github.com/unrelentingtech/microformats2-parser" $ "microformats2-parser"
- a ! href "https://github.com/unrelentingtech/microformats2-parser" $ img ! alt "GitHub" ! src "https://img.shields.io/badge/git-hub-gray.svg?style=flat"
+ a ! href "https://codeberg.org/valpackett/microformats2-parser" $ "microformats2-parser"
+ a ! href "https://codeberg.org/valpackett/microformats2-parser" $ img ! alt "Codeberg" ! src "https://img.shields.io/badge/code-berg-blue.svg?style=flat"
" "
a ! href "https://hackage.haskell.org/package/microformats2-parser" $ img ! alt "Hackage" ! src "https://img.shields.io/hackage/v/microformats2-parser.svg?style=flat"
" "
@@ -57,11 +57,12 @@
let gi = $$tGitInfoCwd
p $ do
"Version: "
- a ! href (toValue $ "https://github.com/unrelentingtech/microformats2-parser/commit/" <> giHash gi) $ toMarkup $ take 12 $ giHash gi
+ a ! href (toValue $ "https://codeberg.org/valpackett/microformats2-parser/commit/" <> giHash gi) $ toMarkup $ take 12 $ giHash gi
" ("
toMarkup $ giCommitDate gi
")"
- a ! href "https://unrelenting.technology" ! rel "author" $ "unrelenting.technology"
+ "made by "
+ a ! href "https://val.packett.cool" ! rel "author" $ "Val Packett"
app ∷ IO Application
app = scottyApp $ do
diff --git a/library/Data/Microformats2/Jf2.hs b/library/Data/Microformats2/Jf2.hs
--- a/library/Data/Microformats2/Jf2.hs
+++ b/library/Data/Microformats2/Jf2.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax, OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax, OverloadedStrings, CPP #-}
module Data.Microformats2.Jf2 (mf2ToJf2) where
@@ -6,7 +6,12 @@
import Control.Lens
import Data.Maybe
import Data.Aeson.Lens
-import qualified Data.HashMap.Strict as HMS
+#if MIN_VERSION_aeson(2,0,0)
+import qualified Data.Aeson.KeyMap as KM
+import qualified Data.Aeson.Key as K
+#else
+import qualified Data.HashMap.Strict as KM
+#endif
import qualified Data.Vector as V
import qualified Data.Text as T
import Data.Microformats2.Parser.UnsafeUtil
@@ -15,15 +20,18 @@
mf2ToJf2 val@(Object _) = flattenItems $ processItems $ processChildren $ flattenProps $ val & key "type" %~ flattenType
where flattenType t@(Array _) = fromMaybe Null $ fmap (& _String %~ (\x → fromMaybe x $ T.stripPrefix "h-" x)) $ t ^? nth 0
flattenType x = x
- flattenProps p@(Object o) = Object $ HMS.delete "value" $ HMS.delete "properties" $
- foldl (\acc (k, v) → HMS.insert k (flattenArr $ processProp k v) acc) o $
+ flattenProps p@(Object o) = Object $ KM.delete "value" $ KM.delete "properties" $
+ foldl (\acc (k, v) → KM.insert k (flattenArr $ processProp k v) acc) o $
+#if MIN_VERSION_aeson(2,0,0)
+ map (\(k, v) -> (K.fromText k, v)) $
+#endif
p ^@.. key "properties" . members
flattenProps x = x
processProp "content" v = v & _Array . each %~ processContent
processProp _ v = v & _Array . each %~ mf2ToJf2
processContent (Object o) =
- case HMS.lookup "value" o of
- Just v → Object $ HMS.delete "value" $ HMS.insert "text" v o
+ case KM.lookup "value" o of
+ Just v → Object $ KM.delete "value" $ KM.insert "text" v o
_ → Object o
processContent x = x
flattenArr (Array v) | V.length v == 1 = V.head v
diff --git a/library/Data/Microformats2/Parser.hs b/library/Data/Microformats2/Parser.hs
--- a/library/Data/Microformats2/Parser.hs
+++ b/library/Data/Microformats2/Parser.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE Safe, NoImplicitPrelude, UnicodeSyntax, OverloadedStrings #-}
+{-# LANGUAGE Trustworthy, NoImplicitPrelude, UnicodeSyntax, OverloadedStrings, CPP #-}
module Data.Microformats2.Parser (
Mf2ParserSettings (..)
@@ -18,12 +18,25 @@
import Data.Microformats2.Parser.Util
import Data.Aeson.Lens
import Data.Char (isSpace)
-import qualified Data.HashMap.Strict as HMS
+#if MIN_VERSION_aeson(2,0,0)
+import qualified Data.Aeson.KeyMap as KM
+import qualified Data.Aeson.Key as K
+#else
+import qualified Data.HashMap.Strict as KM
+#endif
import Data.Maybe
import qualified Data.Text as T
import Network.URI
import Safe (headMay)
+#if MIN_VERSION_aeson(2,0,0)
+toK :: T.Text -> K.Key
+toK = K.fromText
+#else
+toK :: a -> a
+toK = id
+#endif
+
data Mf2ParserSettings = Mf2ParserSettings
{ htmlMode ∷ HtmlContentMode
, baseUri ∷ Maybe URI }
@@ -54,18 +67,18 @@
-- lens-aeson's 'key' doesn't add new keys :-(
addValue ∷ T.Text → Value → Value → Value
-addValue "p" v@(Object o) f = let v' = (fromMaybe f $ v ^? key "properties" . key "name" . nth 0) in Object $ if v' == Null then o else HMS.insert "value" v' o
-addValue "e" (Object o) f = Object $ HMS.insert "value" (fromMaybe Null $ f ^? key "value") $ HMS.insert "html" (fromMaybe Null $ f ^? key "html") o
-addValue "u" v@(Object o) f = Object $ HMS.insert "value" (fromMaybe f $ v ^? key "properties" . key "url" . nth 0) o
-addValue _ (Object o) f = Object $ HMS.insert "value" f o
+addValue "p" v@(Object o) f = let v' = (fromMaybe f $ v ^? key "properties" . key "name" . nth 0) in Object $ if v' == Null then o else KM.insert "value" v' o
+addValue "e" (Object o) f = Object $ KM.insert "value" (fromMaybe Null $ f ^? key "value") $ KM.insert "html" (fromMaybe Null $ f ^? key "html") o
+addValue "u" v@(Object o) f = Object $ KM.insert "value" (fromMaybe f $ v ^? key "properties" . key "url" . nth 0) o
+addValue _ (Object o) f = Object $ KM.insert "value" f o
addValue _ x _ = x
addImpliedProperties ∷ Mf2ParserSettings → Element → Value → Value
addImpliedProperties settings e v@(Object o) = Object $ addIfNull "photo" "photo" resolveURI' $ addIfNull "url" "url" resolveURI' $ addIfNullAndNoOthers "name" "name" id o
- where addIfNull nameJ nameH f obj = if isNothing $ v ^? key nameJ then HMS.insert nameJ (vsingleton $ f <$> implyProperty nameH e) obj else obj
+ where addIfNull nameJ nameH f obj = if isNothing $ v ^? key nameJ then KM.insert (toK nameJ) (vsingleton $ f <$> implyProperty nameH e) obj else obj
addIfNullAndNoOthers nameJ nameH f obj =
if isNothing (v ^? key nameJ) && isNothing (v ^? key "children") && isNothing (e ^? plate . cosmos . peElements)
- then HMS.insert nameJ (vsingleton $ f <$> implyProperty nameH e) obj else obj
+ then KM.insert (toK nameJ) (vsingleton $ f <$> implyProperty nameH e) obj else obj
peElements = attributeSatisfies "class" $ any (\x → isPClass x || isEClass x) . T.split isSpace
resolveURI' = resolveURI $ baseUri settings
addImpliedProperties _ _ v = v
@@ -79,8 +92,8 @@
let propNames = groupBy' snd $ map readPropertyName $ filter isPropertyClass $ classes e
extractPropertyValue (t, _) = extractProperty settings t e in
if any isMf2Class $ classes e
- then map (\(n, ts) → n .= [ addValue (fst $ head ts) (parseH settings e) (extractPropertyValue $ head ts) ]) propNames
- else map (\(n, ts) → n .= map extractPropertyValue ts) propNames
+ then map (\(n, ts) → (toK n) .= [ addValue (fst $ head ts) (parseH settings e) (extractPropertyValue $ head ts) ]) propNames
+ else map (\(n, ts) → (toK n) .= map extractPropertyValue ts) propNames
parseH ∷ Mf2ParserSettings → Element → Value
parseH settings e =
@@ -93,7 +106,7 @@
where childrenMf2 = map ((\x → addValue "p" x Null) . parseH settings) $ filter (not . isProperty) $ deduplicateElements allMf2Descendants
allMf2Descendants = filter (/= e) $ e ^.. cosmos . mf2Elements
-- we have to do all of this because multiple elements can become multiple properties (with overlap)
- properties = Object $ HMS.filter (not . emptyVal) properties'
+ properties = Object $ KM.filter (not . emptyVal) properties'
(Object properties') = addImpliedProperties settings e $ object $ map mergeProps $ groupBy' fst properties''
properties'' = concatMap (parseProperty settings) $ removePropertiesOfNestedMicroformats allMf2Descendants $ filter (/= e) $ e ^.. cosmos . propertyElements
@@ -101,9 +114,9 @@
parseMf2 ∷ Mf2ParserSettings → Element → Value
parseMf2 settings rootEl = object [ "items" .= items, "rels" .= rels, "rel-urls" .= relUrls ]
where items = map (parseH settings') $ deduplicateElements $ rootEl' ^.. cosmos . mf2Elements
- rels = object $ map (\(r, es) → r .= map snd es) $ groupBy' fst $ expandSnd $ map (\e → (T.split isSpace (e ^. attr "rel"), resolveURI (baseUri settings') $ e ^. attr "href")) linkEls
+ rels = object $ map (\(r, es) → (toK r) .= map snd es) $ groupBy' fst $ expandSnd $ map (\e → (T.split isSpace (e ^. attr "rel"), resolveURI (baseUri settings') $ e ^. attr "href")) linkEls
relUrls = object $ map relUrlObject linkEls
- relUrlObject e = resolveURI (baseUri settings') (e ^. attr "href") .= object (filter (not . emptyVal . snd) [
+ relUrlObject e = toK (resolveURI (baseUri settings') (e ^. attr "href")) .= object (filter (not . emptyVal . snd) [
"rels" .= T.split isSpace (e ^. attr "rel")
, "text" .= fromMaybe Null (String <$> getInnerTextWithImgs e)
, linkAttr "type" "type" e
diff --git a/library/Data/Microformats2/Parser/UnsafeUtil.hs b/library/Data/Microformats2/Parser/UnsafeUtil.hs
--- a/library/Data/Microformats2/Parser/UnsafeUtil.hs
+++ b/library/Data/Microformats2/Parser/UnsafeUtil.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE Trustworthy, NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, QuasiQuotes #-}
+{-# LANGUAGE Trustworthy, NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, QuasiQuotes, CPP #-}
module Data.Microformats2.Parser.UnsafeUtil (
module Data.Microformats2.Parser.UnsafeUtil
@@ -14,7 +14,11 @@
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Vector as V
-import qualified Data.HashMap.Strict as HMS
+#if MIN_VERSION_aeson(2,0,0)
+import qualified Data.Aeson.KeyMap as KM
+#else
+import qualified Data.HashMap.Strict as KM
+#endif
import Text.Regex.PCRE.Heavy
import Text.XML.Lens as X
import Text.HTML.DOM as X (sinkDoc, parseLBS)
@@ -25,7 +29,7 @@
collapseWhitespace = gsub [re|(\s| )+|] (" " ∷ String)
emptyVal ∷ Value → Bool
-emptyVal (Object o) = HMS.null o
+emptyVal (Object o) = KM.null o
emptyVal (Array v) = V.null v
emptyVal (String s) = T.null s
emptyVal Null = True
diff --git a/microformats2-parser.cabal b/microformats2-parser.cabal
--- a/microformats2-parser.cabal
+++ b/microformats2-parser.cabal
@@ -1,12 +1,13 @@
name: microformats2-parser
-version: 1.0.2.0
+version: 1.0.2.1
synopsis: A Microformats 2 parser.
description: A parser for Microformats 2 (http://microformats.org/wiki/microformats2), a simple way to describe structured information in HTML.
category: Web
-homepage: https://github.com/unrelentingtech/microformats2-parser
-author: Greg V
-copyright: 2015-2021 Greg V
-maintainer: greg@unrelenting.technology
+homepage: https://codeberg.org/valpackett/microformats2-parser
+bug-reports: https://codeberg.org/valpackett/microformats2-parser/issues
+author: Val Packett
+copyright: 2015-2022 Val Packett
+maintainer: val@packett.cool
license: PublicDomain
license-file: UNLICENSE
build-type: Simple
@@ -14,11 +15,11 @@
extra-source-files:
README.md
tested-with:
- GHC == 8.10.4
+ GHC == 9.0.2
source-repository head
type: git
- location: git://github.com/unrelentingtech/microformats2-parser.git
+ location: https://codeberg.org/valpackett/microformats2-parser.git
library
build-depends:
diff --git a/test-suite/Data/Microformats2/ParserSpec.hs b/test-suite/Data/Microformats2/ParserSpec.hs
--- a/test-suite/Data/Microformats2/ParserSpec.hs
+++ b/test-suite/Data/Microformats2/ParserSpec.hs
@@ -164,15 +164,15 @@
test
- twitter
- github
+ website
+ codeberg