microformats2-parser 1.0.1.5 → 1.0.1.6

raw patch · 9 files changed

+82/−66 lines, 9 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• executable/Main.hs +5/−5
• library/Data/Microformats2/Parser.hs +2/−12
• library/Data/Microformats2/Parser/Date.hs +8/−9
• library/Data/Microformats2/Parser/HtmlUtil.hs +5/−15
• library/Data/Microformats2/Parser/Property.hs +1/−3
• library/Data/Microformats2/Parser/UnsafeUtil.hs +47/−0
• library/Data/Microformats2/Parser/Util.hs +6/−16
• microformats2-parser.cabal +6/−4
• test-suite/Data/Microformats2/ParserSpec.hs +2/−2

@@ -18,8 +18,8 @@ import           Network.Wai.Middleware.Autohead import qualified Network.Socket as S import           Network.URI (parseURI)-import           Web.Scotty-import           Text.Blaze.Html5 as H hiding (main, param, object)+import           Web.Scotty hiding (html)+import           Text.Blaze.Html5 as H hiding (main, param, object, base) import           Text.Blaze.Html5.Attributes as A import           Text.Blaze.Html.Renderer.Utf8 (renderHtml) import qualified Options as O@@ -82,17 +82,17 @@     json $ object []    post "/parse.json" $ do-    html ← param "html"+    hsrc ← param "html"     base ← param "base" `rescue` (\_ → return "")     setHeader "Content-Type" "application/json; charset=utf-8"     setHeader "Access-Control-Allow-Origin" "*"-    let root = documentRoot $ parseLBS html+    let root = documentRoot $ parseLBS hsrc     raw $ encodePretty $ parseMf2 (def { baseUri = parseURI base }) root  main = O.runCommand $ \opts args → do   let warpSettings = setPort (port opts) defaultSettings   case protocol opts of     "http" → app >>= runSettings warpSettings-    "unix" → bracket (bindPath $ socket opts) S.close (\socket → app >>= runSettingsSocket warpSettings socket)+    "unix" → bracket (bindPath $ socket opts) S.close (\s → app >>= runSettingsSocket warpSettings s)     "cgi" → app >>= CGI.run     _ → putStrLn $ "Unsupported protocol: " ++ protocol opts

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax, OverloadedStrings #-}+{-# LANGUAGE Safe, NoImplicitPrelude, UnicodeSyntax, OverloadedStrings #-}  module Data.Microformats2.Parser (   Mf2ParserSettings (..)@@ -13,18 +13,12 @@ ) where  import           Prelude.Compat-import           Text.HTML.DOM-import           Text.XML.Lens hiding ((.=)) import           Data.Microformats2.Parser.Property import           Data.Microformats2.Parser.HtmlUtil import           Data.Microformats2.Parser.Util-import           Data.Default-import           Data.Aeson-import           Data.Aeson.Types import           Data.Aeson.Lens import           Data.Char (isSpace) import qualified Data.HashMap.Strict as HMS-import qualified Data.Vector as V import           Data.Maybe import qualified Data.Text as T import           Network.URI@@ -68,8 +62,7 @@  addImpliedProperties ∷ Mf2ParserSettings → Element → Value → Value addImpliedProperties settings e v@(Object o) = Object $ addIfNull "photo" "photo" resolveURI' $ addIfNull "url" "url" resolveURI' $ addIfNull "name" "name" id o-  where addIfNull nameJ nameH f obj = if isNothing $ v ^? key nameJ then HMS.insert nameJ (singleton $ f <$> implyProperty nameH e) obj else obj-        singleton x = fromMaybe Null $ (Array . V.singleton . String) <$> x+  where addIfNull nameJ nameH f obj = if isNothing $ v ^? key nameJ then HMS.insert nameJ (vsingleton $ f <$> implyProperty nameH e) obj else obj         resolveURI' = resolveURI $ baseUri settings addImpliedProperties _ _ v = v @@ -99,9 +92,6 @@         properties = Object $ HMS.filter (not . emptyVal) properties'         (Object properties') = addImpliedProperties settings e $ object $ map mergeProps $ groupBy' fst properties''         properties'' = concatMap (parseProperty settings) $ removePropertiesOfNestedMicroformats allMf2Descendants $ filter (/= e) $ e ^.. entire . propertyElements-        mergeProps (n, vs) = (n, Array $ V.concat $ reverse $ map (extractVector . snd) vs)-        extractVector (Array v) = v-        extractVector _ = V.empty  -- | Parses Microformats 2 from an HTML Element into a JSON Value. parseMf2 ∷ Mf2ParserSettings → Element → Value

@@ -1,11 +1,10 @@ {-# OPTIONS_GHC -fno-warn-unused-do-bind #-}-{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, TypeFamilies #-}+{-# LANGUAGE Safe, NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, TypeFamilies #-}  module Data.Microformats2.Parser.Date where  import           Prelude.Compat import           Control.Applicative-import           Control.Monad import           Control.Error.Util (hush) import           Text.Printf import           Data.Maybe@@ -91,7 +90,7 @@   hrs  ← read <$> count 2 digit   mins ← option 0 $ char ':' >> read <$> count 2 digit   secs ← option 0 $ char ':' >> read <$> count 2 digit-  htyp ← option TwentyFourHour $ parseHourType+  htyp ← option TwentyFourHour parseHourType   let hrs' = case (hrs, htyp) of                (12, AMHour) → 00                (x,  PMHour) | x < 12 → x + 12@@ -127,12 +126,12 @@  parseDTPart ∷ Parser DTPart parseDTPart =-      (liftM DateTimeZonePart parseDateTimeZone)-  <|> (liftM DateTimePart parseDateTime)-  <|> (liftM DatePart parseDate)-  <|> (liftM TimeZonePart parseTimeZone)-  <|> (liftM TimePart parseTime)-  <|> (liftM ZonePart parseZone)+      (DateTimeZonePart <$> parseDateTimeZone)+  <|> (DateTimePart <$> parseDateTime)+  <|> (DatePart <$> parseDate)+  <|> (TimeZonePart <$> parseTimeZone)+  <|> (TimePart <$> parseTime)+  <|> (ZonePart <$> parseZone)  parseDTParts ∷ (Traversable φ, Monoid (φ DTPart)) ⇒ φ T.Text → φ DTPart parseDTParts = fromMaybe mempty . sequence . fmap (hush . parseOnly parseDTPart)

@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, RankNTypes  #-}+{-# LANGUAGE Safe, NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, RankNTypes #-}  module Data.Microformats2.Parser.HtmlUtil (   HtmlContentMode (..)@@ -17,17 +17,13 @@ import           Data.Monoid.Compat import qualified Data.Map as M import qualified Data.Text as T-import qualified Data.Text.Lazy as TL import           Data.Text (Text) import           Data.Char (isSpace) import           Data.Foldable (asum) import           Data.Attoparsec.Text import           Data.Maybe-import           Text.Blaze-import           Text.Blaze.Renderer.Text import           Text.HTML.SanitizeXSS import           Text.HTML.TagSoup.Entity-import           Text.XML.Lens hiding (re) import           Network.URI import           Data.Microformats2.Parser.Util @@ -43,12 +39,6 @@         f' (NodeElement e') = f e'         f' _ = False -renderInner ∷ Element → Text-renderInner = T.concat . map renderNode . elementNodes-  where renderNode (NodeContent c) = c-        renderNode (NodeElement e) = TL.toStrict $ renderMarkup $ toMarkup e-        renderNode _ = ""- getInnerHtml ∷ Maybe URI → Element → Maybe Text getInnerHtml b rootEl = Just $ renderInner processedRoot   where (NodeElement processedRoot) = processNode (NodeElement rootEl)@@ -70,7 +60,7 @@  getInnerTextRaw ∷ Element → Maybe Text getInnerTextRaw rootEl = unless' (txt == Just "") txt-  where txt = Just $ T.dropAround isSpace $ processedRoot+  where txt = Just $ T.dropAround isSpace processedRoot         (NodeContent processedRoot) = processNode (NodeElement rootEl)         processNode (NodeContent c) = NodeContent $ escapeHtml c         processNode (NodeElement e) = NodeContent $ T.dropAround isSpace $ renderInner $ processChildren processNode $ filterChildElements (safeTagName . nameLocalName . elementName) e@@ -78,7 +68,7 @@  getInnerTextWithImgs ∷ Element → Maybe Text getInnerTextWithImgs rootEl = unless' (txt == Just "") txt-  where txt = Just $ T.dropAround isSpace $ processedRoot+  where txt = Just $ T.dropAround isSpace processedRoot         (NodeContent processedRoot) = processNode (NodeElement rootEl)         processNode (NodeContent c) = NodeContent $ escapeHtml c         processNode (NodeElement e) | nameLocalName (elementName e) == "img" = NodeContent $ fromMaybe "" $ asum [ e ^. attribute "alt", e ^. attribute "src" ]@@ -105,7 +95,7 @@ unescapeHtml x = fromMaybe x $ T.concat <$> hush (parseOnly p x)   where p = many1 $ takeWhile1 (/= '&') <|> pent          pent = do-          char '&'+          _ ← char '&'           ent ← takeWhile1 (/= ';')-          char ';'+          _ ← char ';'           return $ fromMaybe ("&" <> ent <> ";") $ T.pack <$> lookupEntity (T.unpack ent)

@@ -1,5 +1,4 @@-{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, QuasiQuotes, UnicodeSyntax #-}-{-# LANGUAGE CPP, RankNTypes, TupleSections #-}+{-# LANGUAGE Safe, NoImplicitPrelude, OverloadedStrings, QuasiQuotes, UnicodeSyntax, CPP, RankNTypes, TupleSections #-} -- LOL: CPP is required for the \ linebreak thing  module Data.Microformats2.Parser.Property where@@ -11,7 +10,6 @@ import           Data.Foldable (asum) import qualified Data.Map as M import           Data.Maybe-import           Text.XML.Lens hiding (re) import           Data.Microformats2.Parser.Date (normalizeDTParts, parseDTParts) import           Data.Microformats2.Parser.HtmlUtil import           Data.Microformats2.Parser.Util

@@ -0,0 +1,47 @@+{-# LANGUAGE Trustworthy, NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, QuasiQuotes #-}++module Data.Microformats2.Parser.UnsafeUtil (+  module Data.Microformats2.Parser.UnsafeUtil+, module X+) where++import           Prelude.Compat+import           Data.Aeson+import           Data.Aeson.Types as X+import           Data.Default as X+import           Data.Maybe (fromMaybe)+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+import           Text.Regex.PCRE.Heavy+import           Text.XML.Lens as X hiding (re, (.=))+import           Text.HTML.DOM as X (sinkDoc, parseLBS)+import           Text.Blaze+import           Text.Blaze.Renderer.Text++collapseWhitespace ∷ T.Text → T.Text+collapseWhitespace = gsub [re|(\s|&nbsp;)+|] (" " ∷ String)++emptyVal ∷ Value → Bool+emptyVal (Object o) = HMS.null o+emptyVal (Array v) = V.null v+emptyVal (String s) = T.null s+emptyVal Null = True+emptyVal _ = False++renderInner ∷ Element → T.Text+renderInner = T.concat . map renderNode . elementNodes+  where renderNode (NodeContent c) = c+        renderNode (NodeElement e) = TL.toStrict $ renderMarkup $ toMarkup e+        renderNode _ = ""++vsingleton ∷ Maybe T.Text → Value+vsingleton x = fromMaybe Null $ (Array . V.singleton . String) <$> x++extractVector ∷ Value → Array+extractVector (Array v) = v+extractVector _ = V.empty++mergeProps ∷ (τ, [(α, Value)]) → (τ, Value)+mergeProps (n, vs) = (n, Array $ V.concat $ reverse $ map (extractVector . snd) vs)

@@ -1,19 +1,19 @@-{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, QuasiQuotes, UnicodeSyntax, TupleSections #-}+{-# LANGUAGE Safe, NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, TupleSections #-} -module Data.Microformats2.Parser.Util where+module Data.Microformats2.Parser.Util (+  module Data.Microformats2.Parser.Util+, module Data.Microformats2.Parser.UnsafeUtil+) where  import           Prelude.Compat-import           Data.Aeson import           Data.Maybe import           Data.List (isPrefixOf) import qualified Data.Text as T import qualified Data.Text.Lazy as TL-import qualified Data.HashMap.Strict as HMS import qualified Data.Map as M-import qualified Data.Vector as V import qualified Data.Foldable as F import           Network.URI-import           Text.Regex.PCRE.Heavy+import           Data.Microformats2.Parser.UnsafeUtil  if' ∷ Bool → Maybe a → Maybe a if' c x = if c then x else Nothing@@ -26,16 +26,6 @@  stripQueryString ∷ TL.Text → TL.Text stripQueryString = TL.intercalate "" . take 1 . TL.splitOn "?" . TL.strip--collapseWhitespace ∷ T.Text → T.Text-collapseWhitespace = gsub [re|(\s| )+|] (" " ∷ String)--emptyVal ∷ Value → Bool-emptyVal (Object o) = HMS.null o-emptyVal (Array v) = V.null v-emptyVal (String s) = T.null s-emptyVal Null = True-emptyVal _ = False  groupBy' ∷ (Ord β) ⇒ (α → β) → [α] → [(β, [α])] groupBy' f = M.toAscList . M.fromListWith (++) . map (\a → (f a, [a]))

@@ -1,10 +1,11 @@ name:            microformats2-parser-version:         1.0.1.5+version:         1.0.1.6 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/myfreeweb/microformats2-parser author:          Greg V-copyright:       2015 Greg V <greg@unrelenting.technology>+copyright:       2015-2016 Greg V <greg@unrelenting.technology> maintainer:      greg@unrelenting.technology license:         PublicDomain license-file:    UNLICENSE@@ -13,7 +14,7 @@ extra-source-files:     README.md tested-with:-    GHC == 7.10.3+    GHC == 8.0.1  source-repository head     type: git@@ -52,6 +53,8 @@         Data.Microformats2.Parser.Date         Data.Microformats2.Parser.HtmlUtil         Data.Microformats2.Parser.Util+    other-modules:+        Data.Microformats2.Parser.UnsafeUtil     ghc-options: -Wall     hs-source-dirs: library @@ -74,7 +77,6 @@       , blaze-markup       , microformats2-parser     default-language: Haskell2010-    ghc-prof-options: -auto-all -prof     ghc-options: -threaded -rtsopts -with-rtsopts=-N     hs-source-dirs: executable     main-is: Main.hs

@@ -3,8 +3,8 @@ module Data.Microformats2.ParserSpec (spec) where  import           Prelude.Compat-import           Test.Hspec --hiding (shouldBe)---import           Test.Hspec.Expectations.Pretty (shouldBe)+import           Test.Hspec hiding (shouldBe)+import           Test.Hspec.Expectations.Pretty (shouldBe) import           TestCommon import           Network.URI (parseURI) import           Data.Microformats2.Parser