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")