~singpolyma/xmpp-blog-utils

84f4bcdace58fb1c006f549602bd57964bbede60 — Stephen Paul Weber 1 year, 5 months ago 0051864
Util to create comment node

Run this right after publish
2 files changed, 59 insertions(+), 1 deletions(-)

A pubsub-create-comment-node.hs
M xmpp-blog-utils.cabal
A pubsub-create-comment-node.hs => pubsub-create-comment-node.hs +54 -0
@@ 0,0 1,54 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
module Main (main) where

import Prelude ()
import BasicPrelude

import Data.String (fromString)
import Text.Blaze ((!), customAttribute)
import qualified Text.Blaze as Blaze
import qualified Text.Blaze.Internal as Blaze
import qualified Text.Blaze.Renderer.Text as Blaze
import qualified Dhall
import qualified Data.Text.Lazy.IO as TL

s :: (IsString s) => String -> s
s = fromString

field :: Text -> Bool -> Text -> Blaze.MarkupM ()
field var hidden value =
	fldWithType $ Blaze.customParent (s"value") (Blaze.text value)
	where
	fldWithType
		| hidden = fld ! customAttribute (s"type") (s"hidden")
		| otherwise = fld 
	fld = Blaze.customParent (s"field")
		! customAttribute (s"var") (Blaze.toValue var)

main :: IO ()
main = do
	[service, node, itemDhall] <- getArgs
	itemId <- Dhall.input Dhall.auto itemDhall

	let commentNode = node ++ s":comments/" ++ itemId

	TL.putStrLn $ Blaze.renderMarkup $
		Blaze.customParent (s"iq")
			! customAttribute (s"to") (Blaze.toValue service)
			! customAttribute (s"type") (s"set")
			! customAttribute (s"id") (s"creating")
			$ Blaze.customParent (s"pubsub")
				! customAttribute (s"xmlns") (s"http://jabber.org/protocol/pubsub")
				$ do
					Blaze.customLeaf (s"create") True
						! customAttribute (s"node") (Blaze.toValue commentNode)
					Blaze.customParent (s"configure")
						$ Blaze.customParent (s"x")
						! customAttribute (s"xmlns") (s"jabber:x:data")
						! customAttribute (s"type") (s"submit")
						$ do
							field (s"FORM_TYPE") True (s"http://jabber.org/protocol/pubsub#node_config")
							field (s"pubsub#notify_retract") False (s"true")
							field (s"pubsub#max_items") False (s"max")
							field (s"pubsub#access_model") False (s"open")

M xmpp-blog-utils.cabal => xmpp-blog-utils.cabal +5 -1
@@ 23,4 23,8 @@ common defs

executable pubsub-entry-publish
  import:              defs
  main-is:             pubsub-entry-publish.hs
\ No newline at end of file
  main-is:             pubsub-entry-publish.hs

executable pubsub-create-comment-node
  import:              defs
  main-is:             pubsub-create-comment-node.hs
\ No newline at end of file