- returnUserList :: Resource ()
- returnUserList
- = do BaseURI baseURI <- getSysConf (envSysConf env)
- users <- liftIO $ getUserList $ envAuthDB env
- runIdempotentA' $ proc ()
- -> do tree <- ( eelem "/"
- += ( eelem "rdf:RDF"
- += sattr "xmlns" "http://cielonegro.org/terms/"
- += sattr "xmlns:rdf" "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
- += ( eelem "rdf:Description"
- += sattr "rdf:about" (uriToString id (mkUserURI baseURI Nothing) "")
- += ( eelem "users"
- += ( eelem "rdf:Bag"
- += ( constL users
- >>>
- ( eelem "rdf:li"
- += attr "rdf:resource" ( arr ( \ name ->
- uriToString
- id
- (mkUserURI baseURI $ Just name)
- ""
- )
- >>>
- mkText
- )
- )
- )
- )
- )
- )
- )
- ) -< ()
- returnA -< outputXml tree
-
- mkUserURI :: URI -> Maybe String -> URI
- mkUserURI baseURI Nothing = baseURI { uriPath = uriPath baseURI </> "users" }
- mkUserURI baseURI (Just x) = baseURI { uriPath = uriPath baseURI </> "users" </> x }
-
- returnUser :: String -> Resource ()
- returnUser name
- = do users <- liftIO $ getUserList $ envAuthDB env
- if any (== name) users
- then setStatus NoContent
- else foundNoEntity Nothing
-
+ returnUserList ∷ Resource ()
+ returnUserList
+ = do users ← liftIO $ getUserList envAuthDB
+ runIdempotentA' $ proc ()
+ → do tree ← ( eelem "/"
+ += ( eelem "users"
+ += ( constL users
+ ⋙
+ ( eelem "user"
+ += attr "id" (arr T.unpack ⋙ mkText)
+ ) ) ) ) ⤙ ()
+ returnA ⤙ outputXml tree
+
+ returnUser ∷ Text → Resource ()
+ returnUser name
+ = do users ← liftIO $ getUserList envAuthDB
+ if any (≡ name) users
+ then setStatus NoContent
+ else foundNoEntity Nothing