~singpolyma/xmpp-blog-utils

xmpp-blog-utils/pubsub-create-comment-node.hs -rw-r--r-- 1.8 KiB
9591d1a0Stephen Paul Weber Some fixes 3 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
module Main (main) where

import Prelude ()
import BasicPrelude

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")
							field (s"pubsub#publish_model") False (s"open")