WIP: prefetch query fields concurrently

spec/Main.hs

@@ -56,7 +56,6 @@ feedTests =
       ft <- toXMLFeed (_wordpress ctxt) wpfeed
       ft `shouldBe` "<?xml version='1.0' ?>\n<feed xmlns=\"http://www.w3.org/2005/Atom\">\n  <id>https://myurl.com/feed</id>\n  <title type=\"text\">My Blog</title>\n  <updated>2014-10-20T07:00:00Z</updated>\n  <entry>\n    <id>https://myurl.com/2014/10/foo-bar/</id>\n    <title type=\"html\">&lt;i&gt;Foo&lt;/i&gt; bar</title>\n    <updated>2014-10-20T07:00:00Z</updated>\n    <published>2014-10-20T07:00:00Z</published>\n    <summary type=\"html\">summary</summary>\n    <content type=\"html\">This is the title: &lt;i&gt;Foo&lt;/i&gt; bar</content>\n    <author>\n      <name>Emma Goldman</name>\n    </author>\n    <link href=\"https://myurl.com/2014/10/foo-bar/\" title=\"&lt;i&gt;Foo&lt;/i&gt; bar\" />\n  </entry>\n</feed>\n"
 
---larcenyFillTests :: SpecM () ()
 larcenyFillTests :: Spec
 larcenyFillTests = do
   describe "<wpPosts>" $ do

src/Web/Offset/Splices.hs

@@ -173,7 +173,6 @@ wpPostByPermalinkFill extraFields getURI wpLens = maybeFillChildrenWith' $
                               return $ Just (postSubs wp extraFields post)
               _ -> return Nothing
 
-
 feedSubs :: [Field s] -> WPLens b s -> Object -> Substitutions s
 feedSubs fields lens obj=
   subs $ [("wpPost", wpPostFromObjectFill fields lens obj)]
@@ -300,6 +299,39 @@ prefetchSubs wp mkeys =
   subs [ ("wpPosts", wpPostsPrefetch wp mkeys)
        , ("wpPage", useAttrs (a"name") $ wpPagePrefetch mkeys) ]
 
+postPrefetchSubs :: Wordpress b
+                -> MVar [WPKey]
+                -> [Field s]
+                -> Object
+                -> Substitutions s
+postPrefetchSubs wp mkeys extraFields object =
+  subs (map (buildSplice object) (mergeFields postFields extraFields))
+  where -- run queries for Q fields
+        buildSplice o (Q n endpoint) =
+          (transformName n, customPrefetchFill wp mkeys (toEndpoint endpoint $ getText n o))
+        -- do nothing for other fields
+        buildSplice o (F n) = (transformName n, textFill "")
+        buildSplice o (P n _) = (transformName n, textFill "")
+        buildSplice o (PN n _) = (transformName n, textFill "")
+        buildSplice o (PM n _) = (transformName n, textFill "")
+        buildSplice o (N n _) = (transformName n, textFill "")
+        buildSplice o (C n _) = (transformName n, textFill "")
+        buildSplice o (CN n _ _) = (transformName n, textFill "")
+        buildSplice o (M n fs) = (transformName n, textFill "")
+
+        getText n o = case M.lookup n o of
+                        Just (String t) -> t
+                        Just (Number i) -> either (tshow :: Double -> Text)
+                                                  (tshow :: Integer -> Text) (floatingOrInteger i)
+                        _ -> ""
+
+customPrefetchFill :: Wordpress b -> MVar [WPKey] -> Text -> Fill s
+customPrefetchFill Wordpress{..} mKeys endpoint =
+  Fill $ \attrs (path, tpl) lib ->
+           do let key = EndpointKey endpoint
+              liftIO $ modifyMVar_ mKeys (\keys -> return $ key : keys)
+              return ""
+
 wpPostsPrefetch :: Wordpress b
                 -> MVar [WPKey]
                 -> Fill s