module Data.IndieWeb.Authorship where
#if __GLASGOW_HASKELL__ < 709
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.Maybe
import Data.Aeson
import Data.Aeson.Lens
import Data.Microformats2.Parser
import Data.IndieWeb.MicroformatsUtil
import Network.URI
import Safe (headMay)
entryAuthors ∷ Monad μ ⇒ Mf2ParserSettings
→ (URI → μ (Maybe LB.ByteString))
→ URI
→ Value
→ (Value, [Value])
→ μ (Maybe [Value])
entryAuthors mfSettings fetch entryUri mfRoot (entry, parents) = runMaybeT $ asum $ map MaybeT [ embeddedCards, relCards ]
where fetchIfLink v
| isMf "h-card" v = return $ Just v
| otherwise = case (T.unpack <$> v ^? _String) >>= parseURIReference of
Nothing → return $ Just v
Just uri → cardFromUri uri
embeddedCards = case asum [ entryAuthor, feedAuthor ] of
Nothing → return Nothing
Just authors → liftM (Just . catMaybes) $ mapM fetchIfLink authors
relCards = case V.toList <$> mfRoot ^? key "rels" . key "author" . _Array of
Nothing → return Nothing
Just rels → liftM (Just . catMaybes) $ mapM fetchIfLink rels
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
html ← fetch $ uri `relativeTo` entryUri
return $ fmap fst $ headMay =<< allMicroformatsOfType "h-card" =<< parseMf2 mfSettings <$> documentRoot <$> parseLBS <$> html