{-# LANGUAGE FlexibleContexts, TypeFamilies, QuasiQuotes, OverloadedStrings #-}
module Clckwrks.Authenticate.Page.ViewUsers where

import Clckwrks.Admin.Template (template)
import Clckwrks.Monad
import Clckwrks.URL             (ClckURL(..))
import Clckwrks.Authenticate.Monad ()
import Clckwrks.ProfileData.URL(ProfileDataURL(..))
import Data.Maybe               (maybe)
import Data.Foldable                 (toList)
import qualified Data.Text      as Text
import Happstack.Server         (Response, ServerPartT, ok, toResponse)
import Happstack.Authenticate.Core (Email(..), GetUsers(..), User(..), UserId(..), Username(..))
import Language.Haskell.HSX.QQ (hsx)
import Web.Plugins.Core            (Plugin(..), getPluginState)
import Web.Routes (showURL)

viewUsers :: ClckT ClckURL (ServerPartT IO) Response
viewUsers :: ClckT ClckURL (ServerPartT IO) Response
viewUsers =
  do Set User
us <- GetUsers -> ClckT ClckURL (ServerPartT IO) (EventResult GetUsers)
forall event (m :: * -> *).
(QueryEvent event, GetAcidState m (EventState event), Functor m,
 MonadIO m, MonadState ClckState m) =>
event -> m (EventResult event)
query GetUsers
GetUsers
     String
-> ()
-> XMLGenT (ClckT ClckURL (ServerPartT IO)) XML
-> ClckT ClckURL (ServerPartT IO) Response
forall (m :: * -> *) url headers body.
(Happstack m, EmbedAsChild (ClckT url m) headers,
 EmbedAsChild (ClckT url m) body) =>
String -> headers -> body -> ClckT url m Response
template String
"View Users" () (XMLGenT (ClckT ClckURL (ServerPartT IO)) XML
 -> ClckT ClckURL (ServerPartT IO) Response)
-> XMLGenT (ClckT ClckURL (ServerPartT IO)) XML
-> ClckT ClckURL (ServerPartT IO) Response
forall a b. (a -> b) -> a -> b
$ [hsx|
        <div>
          <h2>Users</h2>
          <table class="table">
           <thead>
            <tr><th>UserId</th><th>Username</th><th>Email</th></tr>
           </thead>
           <tbody>
             <% mapM mkRow (toList us) %>
           </tbody>
          </table>
        </div> |]
         where
           mkRow :: User -> XMLGenT m (XMLType m)
mkRow User
u =
             do Text
epdf <- URL (XMLGenT m) -> XMLGenT m Text
forall (m :: * -> *). MonadRoute m => URL m -> m Text
showURL (ProfileDataURL -> ClckURL
Profile (UserId -> ProfileDataURL
EditProfileDataFor (User -> UserId
_userId User
u)))
                [hsx| <tr><td><a href=(Text.unpack epdf)><% show $ _unUserId $ _userId u %></a></td><td><% _unUsername $ _username u %></td><td><% maybe (Text.empty) _unEmail (_email u) %></td></tr> |]