{-# 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 ()
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)
import HSP.XMLGenerator
import HSP.XML
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)

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) %>
               </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

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
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
     ()
     (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
$ Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
  ()
  (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 (Form
   (ClckT ProfileDataURL (ServerPartT IO))
   [Input]
   ClckFormError
   [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
   ()
   (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)) XML]
     ()
     (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]
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT (ClckT ProfileDataURL (ServerPartT IO)) XML]
     ()
     (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))