{-# LANGUAGE RecordWildCards, OverloadedStrings, QuasiQuotes #-}
module Clckwrks.ProfileData.EditProfileDataFor where

import Clckwrks
import Clckwrks.Admin.Template  (template)
import Clckwrks.ProfileData.Acid (GetProfileData(..), SetProfileData(..))
import Clckwrks.Authenticate.Monad (AcidStateAuthenticate(..))
import Clckwrks.Authenticate.URL   (AuthURL(ResetPassword))
import Control.Monad.State         (get)
import Data.Maybe               (fromMaybe)
import Data.Set                 as Set
import Data.Text.Lazy           (Text)
import qualified Data.Text.Lazy as LT
import qualified Data.Text      as Text
import Data.UserId              (UserId)

import Language.Haskell.HSX.QQ  (hsx)
import Happstack.Authenticate.Core (Email(..), GetUserByUserId(..), User(..), UserId(..), Username(..))
import Happstack.Authenticate.Password.Core (SetPassword(..), mkHashedPass, resetTokenForUserId)
import HSP.XMLGenerator
import HSP.XML
import System.FilePath             ((</>))
import Text.Reform              ((++>), mapView, transformEitherM)
import Text.Reform.Happstack    (reform)
import Text.Reform.HSP.Text     (inputCheckboxes, inputPassword, inputText, labelText, inputSubmit, fieldset, ol, li, form, setAttrs)
import Web.Plugins.Core         (getConfig, getPluginState, getPluginRouteFn)

editProfileDataForPage :: ProfileDataURL -> UserId -> Clck ProfileDataURL Response
editProfileDataForPage :: ProfileDataURL -> UserId -> Clck ProfileDataURL Response
editProfileDataForPage ProfileDataURL
here UserId
uid =
    do ProfileData
pd <- GetProfileData
-> ClckT
     ProfileDataURL (ServerPartT IO) (EventResult GetProfileData)
forall event (m :: * -> *).
(QueryEvent event, GetAcidState m (EventState event), Functor m,
 MonadIO m, MonadState ClckState m) =>
event -> m (EventResult event)
query (UserId -> GetProfileData
GetProfileData UserId
uid)
       Maybe User
mu  <- GetUserByUserId
-> ClckT
     ProfileDataURL (ServerPartT IO) (EventResult GetUserByUserId)
forall event (m :: * -> *).
(QueryEvent event, GetAcidState m (EventState event), Functor m,
 MonadIO m, MonadState ClckState m) =>
event -> m (EventResult event)
query (UserId -> GetUserByUserId
GetUserByUserId UserId
uid)
       case Maybe User
mu of
         Maybe User
Nothing ->
           String
-> ()
-> XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML
-> Clck ProfileDataURL 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
"Edit Profile Data" () (XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML
 -> Clck ProfileDataURL Response)
-> XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML
-> Clck ProfileDataURL Response
forall a b. (a -> b) -> a -> b
$
             [hsx|
               <div>Invalid UserId <% show uid  %></div>
             |]
         (Just User
u) ->
           do Text
action <- URL (ClckT ProfileDataURL (ServerPartT IO))
-> ClckT ProfileDataURL (ServerPartT IO) Text
forall (m :: * -> *). MonadRoute m => URL m -> m Text
showURL URL (ClckT ProfileDataURL (ServerPartT IO))
ProfileDataURL
here
              String
-> ()
-> XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML
-> Clck ProfileDataURL 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
"Edit Profile Data" () (XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML
 -> Clck ProfileDataURL Response)
-> XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML
-> Clck ProfileDataURL Response
forall a b. (a -> b) -> a -> b
$ [hsx|
                <div>
                 <h2>User Info</h2>
                 <dl>
                  <dt>UserId</dt>  <dd><% show $ _unUserId $ _userId u %></dd>
                  <dt>Username</dt><dd><% _unUsername $ _username u %></dd>
                  <dt>Email</dt>   <dd><% maybe Text.empty _unEmail  (_email u) %></dd>
                 </dl>
                 <h2>Roles</h2>
                 <% reform (form action) "epd" updated Nothing (profileDataFormlet pd) %>
                 <h2>Update User's Password</h2>
                 <% reform (form action) "pf"  updated Nothing (passwordForFormlet uid) %>
                 <h2>Generate Password Reset Link</h2>
                 <% reform (form action) "prl"  (generateResetLink uid) Nothing generateResetLinkFormlet %>
               </div>
               |]
    where
      updated :: () -> Clck ProfileDataURL Response
      updated :: () -> Clck ProfileDataURL Response
updated () =
          do URL (ClckT ProfileDataURL (ServerPartT IO))
-> Clck ProfileDataURL Response
forall (m :: * -> *).
(MonadRoute m, FilterMonad Response m) =>
URL m -> m Response
seeOtherURL URL (ClckT ProfileDataURL (ServerPartT IO))
ProfileDataURL
here

      generateResetLink :: UserId -> Maybe Text.Text -> Clck ProfileDataURL Response
      generateResetLink :: UserId -> Maybe Text -> Clck ProfileDataURL Response
generateResetLink UserId
uid Maybe Text
_ =
        do ClckPlugins
p <- ClckState -> ClckPlugins
plugins (ClckState -> ClckPlugins)
-> ClckT ProfileDataURL (ServerPartT IO) ClckState
-> ClckT ProfileDataURL (ServerPartT IO) ClckPlugins
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClckT ProfileDataURL (ServerPartT IO) ClckState
forall s (m :: * -> *). MonadState s m => m s
get
           ~(Just (AcidStateAuthenticate AcidState AuthenticateState
authenticateState AcidState PasswordState
passwordState)) <- ClckPlugins
-> Text
-> ClckT
     ProfileDataURL (ServerPartT IO) (Maybe AcidStateAuthenticate)
forall (m :: * -> *) state theme n hook config st.
(MonadIO m, Typeable state) =>
Plugins theme n hook config st -> Text -> m (Maybe state)
getPluginState ClckPlugins
p Text
"authenticate"
           ~(Just AuthURL -> [(Text, Maybe Text)] -> Text
authShowURL) <- ClckPlugins
-> Text
-> ClckT
     ProfileDataURL
     (ServerPartT IO)
     (Maybe (AuthURL -> [(Text, Maybe Text)] -> Text))
forall (m :: * -> *) url theme n hook config st.
(MonadIO m, Typeable url) =>
Plugins theme n hook config st
-> Text -> m (Maybe (url -> [(Text, Maybe Text)] -> Text))
getPluginRouteFn ClckPlugins
p Text
"authenticate"
           ClckwrksConfig
cc <- ClckPlugins -> ClckT ProfileDataURL (ServerPartT IO) ClckwrksConfig
forall (m :: * -> *) theme n hook config st.
MonadIO m =>
Plugins theme n hook config st -> m config
getConfig ClckPlugins
p
           let basePath :: String
basePath = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"_state" (\String
top -> String
top String -> String -> String
</> String
"_state") (ClckwrksConfig -> Maybe String
clckTopDir ClckwrksConfig
cc)
               baseUri :: Text
baseUri = case ClckwrksConfig -> Maybe Text
calcTLSBaseURI ClckwrksConfig
cc of
                 Maybe Text
Nothing  -> ClckwrksConfig -> Text
calcBaseURI ClckwrksConfig
cc
                 (Just Text
b) -> Text
b

               resetLink :: Text
resetLink = AuthURL -> [(Text, Maybe Text)] -> Text
authShowURL AuthURL
ResetPassword [] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/#"
           Either PasswordError Text
eResetTokenLink <- IO (Either PasswordError Text)
-> ClckT
     ProfileDataURL (ServerPartT IO) (Either PasswordError Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either PasswordError Text)
 -> ClckT
      ProfileDataURL (ServerPartT IO) (Either PasswordError Text))
-> IO (Either PasswordError Text)
-> ClckT
     ProfileDataURL (ServerPartT IO) (Either PasswordError Text)
forall a b. (a -> b) -> a -> b
$ Text
-> AcidState AuthenticateState
-> AcidState PasswordState
-> UserId
-> IO (Either PasswordError Text)
resetTokenForUserId Text
resetLink AcidState AuthenticateState
authenticateState AcidState PasswordState
passwordState UserId
uid
           case Either PasswordError Text
eResetTokenLink of
             (Left PasswordError
e) -> String
-> ()
-> XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML
-> Clck ProfileDataURL 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
"Reset Password Link" () (XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML
 -> Clck ProfileDataURL Response)
-> XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML
-> Clck ProfileDataURL Response
forall a b. (a -> b) -> a -> b
$
                [hsx|
                 <div>
                  <h2>Reset Password Link Error</h2>
                  <% show e %>
                 </div>
                |]
             (Right Text
lnk) ->
               String
-> ()
-> XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML
-> Clck ProfileDataURL 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
"Reset Password Link" () (XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML
 -> Clck ProfileDataURL Response)
-> XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML
-> Clck ProfileDataURL Response
forall a b. (a -> b) -> a -> b
$
                [hsx|
                 <div>
                  <h2>Reset Password Link</h2>
                  <p>Share this link with the user</p>
                  <% lnk %>
                 </div>
                |]

generateResetLinkFormlet :: ClckForm ProfileDataURL (Maybe Text.Text)
generateResetLinkFormlet :: ClckForm ProfileDataURL (Maybe Text)
generateResetLinkFormlet =
  do (ClckForm ProfileDataURL (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall (m :: * -> *) (x :: * -> *) c input error proof a.
(Monad m, Functor m, XMLGenerator x, StringType x ~ Text,
 EmbedAsChild x c) =>
Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
fieldset (ClckForm ProfileDataURL (Maybe Text)
 -> Form
      (ClckT ProfileDataURL (ServerPartT IO))
      [Input]
      ClckFormError
      [XMLGenT
         (ClckT ProfileDataURL (ServerPartT IO))
         (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
      ()
      (Maybe Text))
-> ClckForm ProfileDataURL (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$
      (Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall input error proof a.
Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControlGroup (Form
   (ClckT ProfileDataURL (ServerPartT IO))
   [Input]
   ClckFormError
   [XMLGenT
      (ClckT ProfileDataURL (ServerPartT IO))
      (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
   ()
   (Maybe Text)
 -> Form
      (ClckT ProfileDataURL (ServerPartT IO))
      [Input]
      ClckFormError
      [XMLGenT
         (ClckT ProfileDataURL (ServerPartT IO))
         (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
      ()
      (Maybe Text))
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall input error proof a.
Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControls (Form
   (ClckT ProfileDataURL (ServerPartT IO))
   [Input]
   ClckFormError
   [XMLGenT
      (ClckT ProfileDataURL (ServerPartT IO))
      (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
   ()
   (Maybe Text)
 -> Form
      (ClckT ProfileDataURL (ServerPartT IO))
      [Input]
      ClckFormError
      [XMLGenT
         (ClckT ProfileDataURL (ServerPartT IO))
         (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
      ()
      (Maybe Text))
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall (m :: * -> *) input error (x :: * -> *).
(Monad m, FormInput input, FormError error,
 ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text,
 EmbedAsAttr x (Attr Text FormId),
 EmbedAsAttr x (Attr Text Text)) =>
Text -> Form m input error [XMLGenT x (XMLType x)] () (Maybe Text)
inputSubmit Text
"Generate Change Password Link"  Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  (Maybe Text)
-> [Attr Text Text]
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall (x :: * -> *) attr (m :: * -> *) input error proof a.
(EmbedAsAttr x attr, XMLGenerator x, StringType x ~ Text, Monad m,
 Functor m) =>
Form m input error [XMLGenT x (XMLType x)] proof a
-> attr -> Form m input error [XMLGenT x (XMLType x)] proof a
`setAttrs` [(Text
"class" Text -> Text -> Attr Text Text
forall n a. n -> a -> Attr n a
:= Text
"btn") :: Attr Text Text]))
   where
     divControlGroup :: Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControlGroup = ([XMLGenT
    (ClckT ProfileDataURL (ServerPartT IO))
    (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
 -> [XMLGenT
       (ClckT ProfileDataURL (ServerPartT IO))
       (XMLType (ClckT ProfileDataURL (ServerPartT IO)))])
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
forall (m :: * -> *) view view' input error proof a.
(Monad m, Functor m) =>
(view -> view')
-> Form m input error view proof a
-> Form m input error view' proof a
mapView (\[XMLGenT
   (ClckT ProfileDataURL (ServerPartT IO))
   (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
xml -> [[hsx|<div class="control-group"><% xml %></div>|]])
     divControls :: Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControls     = ([XMLGenT
    (ClckT ProfileDataURL (ServerPartT IO))
    (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
 -> [XMLGenT
       (ClckT ProfileDataURL (ServerPartT IO))
       (XMLType (ClckT ProfileDataURL (ServerPartT IO)))])
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
forall (m :: * -> *) view view' input error proof a.
(Monad m, Functor m) =>
(view -> view')
-> Form m input error view proof a
-> Form m input error view' proof a
mapView (\[XMLGenT
   (ClckT ProfileDataURL (ServerPartT IO))
   (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
xml -> [[hsx|<div class="controls"><% xml %></div>|]])


passwordForFormlet :: UserId -> ClckForm ProfileDataURL ()
passwordForFormlet :: UserId -> ClckForm ProfileDataURL ()
passwordForFormlet UserId
userid =
    (Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
  ()
  Text
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     Text
forall (m :: * -> *) (x :: * -> *) c input error proof a.
(Monad m, Functor m, XMLGenerator x, StringType x ~ Text,
 EmbedAsChild x c) =>
Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
fieldset (Form
   (ClckT ProfileDataURL (ServerPartT IO))
   [Input]
   ClckFormError
   [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
   ()
   Text
 -> Form
      (ClckT ProfileDataURL (ServerPartT IO))
      [Input]
      ClckFormError
      [XMLGenT
         (ClckT ProfileDataURL (ServerPartT IO))
         (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
      ()
      Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
     ()
     Text
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     Text
forall a b. (a -> b) -> a -> b
$
      (Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  Text
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     Text
forall input error proof a.
Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControlGroup (Form
   (ClckT ProfileDataURL (ServerPartT IO))
   [Input]
   ClckFormError
   [XMLGenT
      (ClckT ProfileDataURL (ServerPartT IO))
      (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
   ()
   Text
 -> Form
      (ClckT ProfileDataURL (ServerPartT IO))
      [Input]
      ClckFormError
      [XMLGenT
         (ClckT ProfileDataURL (ServerPartT IO))
         (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
      ()
      Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     Text
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     Text
forall a b. (a -> b) -> a -> b
$
        (Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
  ()
  Text
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     Text
forall input error proof a.
Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControls (Text -> ClckForm ProfileDataURL ()
label' Text
"new password" ClckForm ProfileDataURL ()
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
     ()
     Text
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
     ()
     Text
forall (m :: * -> *) view input error proof a.
(Monad m, Monoid view) =>
Form m input error view () ()
-> Form m input error view proof a
-> Form m input error view proof a
++> Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
  ()
  Text
forall (m :: * -> *) input error (x :: * -> *).
(Monad m, FormInput input, FormError error,
 ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text,
 EmbedAsAttr x (Attr Text FormId),
 EmbedAsAttr x (Attr Text Text)) =>
Form m input error [XMLGenT x (XMLType x)] () Text
inputPassword))
        )
      Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
  ()
  Text
-> ClckForm ProfileDataURL (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
     ()
     Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall input error proof a.
Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControlGroup (Form
   (ClckT ProfileDataURL (ServerPartT IO))
   [Input]
   ClckFormError
   [XMLGenT
      (ClckT ProfileDataURL (ServerPartT IO))
      (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
   ()
   (Maybe Text)
 -> Form
      (ClckT ProfileDataURL (ServerPartT IO))
      [Input]
      ClckFormError
      [XMLGenT
         (ClckT ProfileDataURL (ServerPartT IO))
         (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
      ()
      (Maybe Text))
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ClckForm ProfileDataURL (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall input error proof a.
Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControls (ClckForm ProfileDataURL (Maybe Text)
 -> Form
      (ClckT ProfileDataURL (ServerPartT IO))
      [Input]
      ClckFormError
      [XMLGenT
         (ClckT ProfileDataURL (ServerPartT IO))
         (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
      ()
      (Maybe Text))
-> ClckForm ProfileDataURL (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall (m :: * -> *) input error (x :: * -> *).
(Monad m, FormInput input, FormError error,
 ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text,
 EmbedAsAttr x (Attr Text FormId),
 EmbedAsAttr x (Attr Text Text)) =>
Text -> Form m input error [XMLGenT x (XMLType x)] () (Maybe Text)
inputSubmit Text
"Change Password"  Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  (Maybe Text)
-> [Attr Text Text]
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall (x :: * -> *) attr (m :: * -> *) input error proof a.
(EmbedAsAttr x attr, XMLGenerator x, StringType x ~ Text, Monad m,
 Functor m) =>
Form m input error [XMLGenT x (XMLType x)] proof a
-> attr -> Form m input error [XMLGenT x (XMLType x)] proof a
`setAttrs` [(Text
"class" Text -> Text -> Attr Text Text
forall n a. n -> a -> Attr n a
:= Text
"btn") :: Attr Text Text])
      ) Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
  ()
  Text
-> (Text
    -> ClckT ProfileDataURL (ServerPartT IO) (Either ClckFormError ()))
-> ClckForm ProfileDataURL ()
forall (m :: * -> *) input error view anyProof a b.
Monad m =>
Form m input error view anyProof a
-> (a -> m (Either error b)) -> Form m input error view () b
`transformEitherM` Text
-> ClckT ProfileDataURL (ServerPartT IO) (Either ClckFormError ())
updatePassword
    where
      label' :: Text -> ClckForm ProfileDataURL ()
      label' :: Text -> ClckForm ProfileDataURL ()
label' Text
str      = (Text
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     ()
forall (m :: * -> *) (x :: * -> *) input error.
(Monad m, XMLGenerator x, StringType x ~ Text,
 EmbedAsAttr x (Attr Text FormId), EmbedAsChild x Text) =>
Text -> Form m input error [XMLGenT x (XMLType x)] () ()
labelText Text
str Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  ()
-> [Attr Text Text]
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     ()
forall (x :: * -> *) attr (m :: * -> *) input error proof a.
(EmbedAsAttr x attr, XMLGenerator x, StringType x ~ Text, Monad m,
 Functor m) =>
Form m input error [XMLGenT x (XMLType x)] proof a
-> attr -> Form m input error [XMLGenT x (XMLType x)] proof a
`setAttrs` [(Text
"class"Text -> Text -> Attr Text Text
forall n a. n -> a -> Attr n a
:=Text
"control-label") :: Attr Text Text])
--       divHorizontal   = mapView (\xml -> [[hsx|<div class="form-horizontal"><% xml %></div>|]])
      divControlGroup :: Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControlGroup = ([XMLGenT
    (ClckT ProfileDataURL (ServerPartT IO))
    (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
 -> [XMLGenT
       (ClckT ProfileDataURL (ServerPartT IO))
       (XMLType (ClckT ProfileDataURL (ServerPartT IO)))])
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
forall (m :: * -> *) view view' input error proof a.
(Monad m, Functor m) =>
(view -> view')
-> Form m input error view proof a
-> Form m input error view' proof a
mapView (\[XMLGenT
   (ClckT ProfileDataURL (ServerPartT IO))
   (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
xml -> [[hsx|<div class="control-group"><% xml %></div>|]])
      divControls :: Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControls     = ([XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
 -> [XMLGenT
       (ClckT ProfileDataURL (ServerPartT IO))
       (XMLType (ClckT ProfileDataURL (ServerPartT IO)))])
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
     proof
     a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
forall (m :: * -> *) view view' input error proof a.
(Monad m, Functor m) =>
(view -> view')
-> Form m input error view proof a
-> Form m input error view' proof a
mapView (\[XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
xml -> [[hsx|<div class="controls"><% xml %></div>|]])

      updatePassword :: Text.Text -> Clck ProfileDataURL (Either ClckFormError ())
      updatePassword :: Text
-> ClckT ProfileDataURL (ServerPartT IO) (Either ClckFormError ())
updatePassword Text
newPw
        | Text -> Bool
Text.null Text
newPw = Either ClckFormError ()
-> ClckT ProfileDataURL (ServerPartT IO) (Either ClckFormError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either ClckFormError ()
forall a b. b -> Either a b
Right ())
        | Bool
otherwise =
            do HashedPass
hp <- Text -> ClckT ProfileDataURL (ServerPartT IO) HashedPass
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Text -> m HashedPass
mkHashedPass Text
newPw
               SetPassword
-> ClckT ProfileDataURL (ServerPartT IO) (EventResult SetPassword)
forall event (m :: * -> *).
(UpdateEvent event, GetAcidState m (EventState event), Functor m,
 MonadIO m, MonadState ClckState m) =>
event -> m (EventResult event)
update (UserId -> HashedPass -> SetPassword
SetPassword UserId
userid HashedPass
hp)
               Either ClckFormError ()
-> ClckT ProfileDataURL (ServerPartT IO) (Either ClckFormError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either ClckFormError ()
forall a b. b -> Either a b
Right ())

profileDataFormlet :: ProfileData -> ClckForm ProfileDataURL ()
profileDataFormlet :: ProfileData -> ClckForm ProfileDataURL ()
profileDataFormlet pd :: ProfileData
pd@ProfileData{Maybe DisplayName
Set Role
Map Text Text
UserId
attributes :: ProfileData -> Map Text Text
roles :: ProfileData -> Set Role
displayName :: ProfileData -> Maybe DisplayName
dataFor :: ProfileData -> UserId
attributes :: Map Text Text
roles :: Set Role
displayName :: Maybe DisplayName
dataFor :: UserId
..} =
    (Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
  ()
  [Role]
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     [Role]
forall (m :: * -> *) (x :: * -> *) c input error proof a.
(Monad m, Functor m, XMLGenerator x, StringType x ~ Text,
 EmbedAsChild x c) =>
Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
fieldset (Form
   (ClckT ProfileDataURL (ServerPartT IO))
   [Input]
   ClckFormError
   [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
   ()
   [Role]
 -> Form
      (ClckT ProfileDataURL (ServerPartT IO))
      [Input]
      ClckFormError
      [XMLGenT
         (ClckT ProfileDataURL (ServerPartT IO))
         (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
      ()
      [Role])
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
     ()
     [Role]
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     [Role]
forall a b. (a -> b) -> a -> b
$
      (Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  [Role]
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     [Role]
forall input error proof a.
Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControlGroup (Form
   (ClckT ProfileDataURL (ServerPartT IO))
   [Input]
   ClckFormError
   [XMLGenT
      (ClckT ProfileDataURL (ServerPartT IO))
      (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
   ()
   [Role]
 -> Form
      (ClckT ProfileDataURL (ServerPartT IO))
      [Input]
      ClckFormError
      [XMLGenT
         (ClckT ProfileDataURL (ServerPartT IO))
         (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
      ()
      [Role])
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     [Role]
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     [Role]
forall a b. (a -> b) -> a -> b
$
        (Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  [Role]
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     [Role]
forall input error proof a.
Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControls ([(Role, String)]
-> (Role -> Bool)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     [Role]
forall (m :: * -> *) error input (x :: * -> *) lbl a.
(Functor m, Monad m, FormError error, ErrorInputType error ~ input,
 FormInput input, XMLGenerator x, StringType x ~ Text,
 EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) =>
[(a, lbl)]
-> (a -> Bool) -> Form m input error [XMLGenT x (XMLType x)] () [a]
inputCheckboxes [ (Role
r, Role -> String
forall a. Show a => a -> String
show Role
r) | Role
r <- [Role
forall a. Bounded a => a
minBound .. Role
forall a. Bounded a => a
maxBound]] (\Role
r -> Role -> Set Role -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Role
r Set Role
roles)) Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  [Role]
-> Attr Text Text
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     [Role]
forall (x :: * -> *) attr (m :: * -> *) input error proof a.
(EmbedAsAttr x attr, XMLGenerator x, StringType x ~ Text, Monad m,
 Functor m) =>
Form m input error [XMLGenT x (XMLType x)] proof a
-> attr -> Form m input error [XMLGenT x (XMLType x)] proof a
`setAttrs` ((Text
"class" Text -> Text -> Attr Text Text
forall n a. n -> a -> Attr n a
:= Text
"form-check") :: Attr Text Text)))
      Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
  ()
  [Role]
-> ClckForm ProfileDataURL (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
     ()
     [Role]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall input error proof a.
Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControlGroup (Form
   (ClckT ProfileDataURL (ServerPartT IO))
   [Input]
   ClckFormError
   [XMLGenT
      (ClckT ProfileDataURL (ServerPartT IO))
      (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
   ()
   (Maybe Text)
 -> Form
      (ClckT ProfileDataURL (ServerPartT IO))
      [Input]
      ClckFormError
      [XMLGenT
         (ClckT ProfileDataURL (ServerPartT IO))
         (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
      ()
      (Maybe Text))
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall input error proof a.
Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControls (Form
   (ClckT ProfileDataURL (ServerPartT IO))
   [Input]
   ClckFormError
   [XMLGenT
      (ClckT ProfileDataURL (ServerPartT IO))
      (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
   ()
   (Maybe Text)
 -> Form
      (ClckT ProfileDataURL (ServerPartT IO))
      [Input]
      ClckFormError
      [XMLGenT
         (ClckT ProfileDataURL (ServerPartT IO))
         (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
      ()
      (Maybe Text))
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall (m :: * -> *) input error (x :: * -> *).
(Monad m, FormInput input, FormError error,
 ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text,
 EmbedAsAttr x (Attr Text FormId),
 EmbedAsAttr x (Attr Text Text)) =>
Text -> Form m input error [XMLGenT x (XMLType x)] () (Maybe Text)
inputSubmit Text
"Update Roles"  Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  (Maybe Text)
-> [Attr Text Text]
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     (Maybe Text)
forall (x :: * -> *) attr (m :: * -> *) input error proof a.
(EmbedAsAttr x attr, XMLGenerator x, StringType x ~ Text, Monad m,
 Functor m) =>
Form m input error [XMLGenT x (XMLType x)] proof a
-> attr -> Form m input error [XMLGenT x (XMLType x)] proof a
`setAttrs` [(Text
"class" Text -> Text -> Attr Text Text
forall n a. n -> a -> Attr n a
:= Text
"btn") :: Attr Text Text])
    ) Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
  ()
  [Role]
-> ([Role]
    -> ClckT ProfileDataURL (ServerPartT IO) (Either ClckFormError ()))
-> ClckForm ProfileDataURL ()
forall (m :: * -> *) input error view anyProof a b.
Monad m =>
Form m input error view anyProof a
-> (a -> m (Either error b)) -> Form m input error view () b
`transformEitherM` [Role]
-> ClckT ProfileDataURL (ServerPartT IO) (Either ClckFormError ())
updateProfileData
    where
      label' :: Text -> ClckForm ProfileDataURL ()
      label' :: Text -> ClckForm ProfileDataURL ()
label' Text
str      = (Text
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     ()
forall (m :: * -> *) (x :: * -> *) input error.
(Monad m, XMLGenerator x, StringType x ~ Text,
 EmbedAsAttr x (Attr Text FormId), EmbedAsChild x Text) =>
Text -> Form m input error [XMLGenT x (XMLType x)] () ()
labelText Text
str Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  ()
-> [Attr Text Text]
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     ()
forall (x :: * -> *) attr (m :: * -> *) input error proof a.
(EmbedAsAttr x attr, XMLGenerator x, StringType x ~ Text, Monad m,
 Functor m) =>
Form m input error [XMLGenT x (XMLType x)] proof a
-> attr -> Form m input error [XMLGenT x (XMLType x)] proof a
`setAttrs` [(Text
"class"Text -> Text -> Attr Text Text
forall n a. n -> a -> Attr n a
:=Text
"control-label") :: Attr Text Text])
--       divHorizontal   = mapView (\xml -> [[hsx|<div class="form-horizontal"><% xml %></div>|]])
      divControlGroup :: Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControlGroup = ([XMLGenT
    (ClckT ProfileDataURL (ServerPartT IO))
    (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
 -> [XMLGenT
       (ClckT ProfileDataURL (ServerPartT IO))
       (XMLType (ClckT ProfileDataURL (ServerPartT IO)))])
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
forall (m :: * -> *) view view' input error proof a.
(Monad m, Functor m) =>
(view -> view')
-> Form m input error view proof a
-> Form m input error view' proof a
mapView (\[XMLGenT
   (ClckT ProfileDataURL (ServerPartT IO))
   (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
xml -> [[hsx|<div class="control-group"><% xml %></div>|]])
      divControls :: Form
  (ClckT ProfileDataURL (ServerPartT IO))
  input
  error
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  proof
  a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
divControls     = ([XMLGenT
    (ClckT ProfileDataURL (ServerPartT IO))
    (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
 -> [XMLGenT
       (ClckT ProfileDataURL (ServerPartT IO))
       (XMLType (ClckT ProfileDataURL (ServerPartT IO)))])
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     input
     error
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     proof
     a
forall (m :: * -> *) view view' input error proof a.
(Monad m, Functor m) =>
(view -> view')
-> Form m input error view proof a
-> Form m input error view' proof a
mapView (\[XMLGenT
   (ClckT ProfileDataURL (ServerPartT IO))
   (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
xml -> [[hsx|<div class="controls"><% xml %></div>|]])

      updateProfileData :: [Role] -> Clck ProfileDataURL (Either ClckFormError ())
      updateProfileData :: [Role]
-> ClckT ProfileDataURL (ServerPartT IO) (Either ClckFormError ())
updateProfileData [Role]
roles' =
        do let newPd :: ProfileData
newPd = ProfileData
pd { roles :: Set Role
roles    = [Role] -> Set Role
forall a. Ord a => [a] -> Set a
Set.fromList [Role]
roles'
                          }
           SetProfileData
-> ClckT
     ProfileDataURL (ServerPartT IO) (EventResult SetProfileData)
forall event (m :: * -> *).
(UpdateEvent event, GetAcidState m (EventState event), Functor m,
 MonadIO m, MonadState ClckState m) =>
event -> m (EventResult event)
update (ProfileData -> SetProfileData
SetProfileData ProfileData
newPd)
           Either ClckFormError ()
-> ClckT ProfileDataURL (ServerPartT IO) (Either ClckFormError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either ClckFormError ()
forall a b. b -> Either a b
Right ())

--       ((li $ labelText "roles:")            ++> ((li $ inputCheckboxes [ (r, show r) | r <- [minBound .. maxBound]] (\r -> Set.member r roles)) `setAttrs` (("class" := "form-check") :: Attr Text Text))