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

import Clckwrks
import Clckwrks.Monad              (plugins)
import Clckwrks.Admin.Template     (template)
import Clckwrks.Authenticate.Plugin (AcidStateAuthenticate(..), authenticatePlugin)
import Clckwrks.ProfileData.Acid   (GetProfileData(..), SetProfileData(..))
import Control.Monad.State         (get)
import Control.Monad.Trans         (liftIO)
import qualified Data.Acid         as Acid
import Data.Text                   (pack)
import qualified Data.Text         as Text
import Data.Text.Lazy              (Text)
import Data.Maybe                  (fromMaybe)
import Data.UserId                 (UserId)
import Happstack.Authenticate.Core (Email(..), User(..), GetUserByUserId(..), UpdateUser(..))
import Language.Haskell.HSX.QQ     (hsx)
import Text.Reform                 ((++>), mapView, transformEitherM)
import Text.Reform.HSP.Text        (form, inputText, inputSubmit, labelText, fieldset, ol, li, errorList, setAttrs)
import Text.Reform.Happstack       (reform)
import HSP.XMLGenerator
import HSP.XML
import Web.Plugins.Core            (Plugin(..), getPluginState)

-- FIXME: this currently uses the admin template. Which is sort of right, and sort of not.

editProfileDataPage :: ProfileDataURL -> Clck ProfileDataURL Response
editProfileDataPage :: ProfileDataURL -> Clck ProfileDataURL Response
editProfileDataPage ProfileDataURL
here =
    do Maybe UserId
mUid <- ClckT ProfileDataURL (ServerPartT IO) (Maybe UserId)
forall (m :: * -> *) url. Happstack m => ClckT url m (Maybe UserId)
getUserId
       case Maybe UserId
mUid of
         Maybe UserId
Nothing -> Response -> Clck ProfileDataURL Response
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
internalServerError (Response -> Clck ProfileDataURL Response)
-> Response -> Clck ProfileDataURL Response
forall a b. (a -> b) -> a -> b
$ Text -> Response
forall a. ToMessage a => a -> Response
toResponse (Text -> Response) -> Text -> Response
forall a b. (a -> b) -> a -> b
$ (Text
"Unable to retrieve your userid" :: Text)
         (Just UserId
uid) ->
             do -- pd <- query (GetProfileData uid)
                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)) <- 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 (Plugin
  AuthURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
-> Text
forall url theme n hook config st.
Plugin url theme n hook config st -> Text
pluginName Plugin
  AuthURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
authenticatePlugin)
                ~(Just User
user) <- IO (Maybe User)
-> ClckT ProfileDataURL (ServerPartT IO) (Maybe User)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe User)
 -> ClckT ProfileDataURL (ServerPartT IO) (Maybe User))
-> IO (Maybe User)
-> ClckT ProfileDataURL (ServerPartT IO) (Maybe User)
forall a b. (a -> b) -> a -> b
$ AcidState (EventState GetUserByUserId)
-> GetUserByUserId -> IO (EventResult GetUserByUserId)
forall event.
QueryEvent event =>
AcidState (EventState event) -> event -> IO (EventResult event)
Acid.query AcidState (EventState GetUserByUserId)
AcidState AuthenticateState
authenticateState (UserId -> GetUserByUserId
GetUserByUserId UserId
uid)
                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)
                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
-> ()
-> GenChildList (ClckT ProfileDataURL (ServerPartT IO))
-> 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" () (GenChildList (ClckT ProfileDataURL (ServerPartT IO))
 -> Clck ProfileDataURL Response)
-> GenChildList (ClckT ProfileDataURL (ServerPartT IO))
-> Clck ProfileDataURL Response
forall a b. (a -> b) -> a -> b
$ [hsx|
                  <%>
                    <% reform (form action) "epd" updated Nothing (profileDataFormlet user pd) %>
--                    <div ng-controller="UsernamePasswordCtrl">
--                     <up-change-password />
--                    </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

profileDataFormlet :: User -> ProfileData -> ClckForm ProfileDataURL ()
profileDataFormlet :: User -> ProfileData -> ClckForm ProfileDataURL ()
profileDataFormlet u :: User
u@User{Maybe Email
Username
UserId
_userId :: User -> UserId
_username :: User -> Username
_email :: User -> Maybe Email
_email :: Maybe Email
_username :: Username
_userId :: UserId
..} ProfileData
pd =
    Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  ()
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     ()
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
divHorizontal (Form
   (ClckT ProfileDataURL (ServerPartT IO))
   [Input]
   ClckFormError
   [XMLGenT
      (ClckT ProfileDataURL (ServerPartT IO))
      (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
   ()
   ()
 -> Form
      (ClckT ProfileDataURL (ServerPartT IO))
      [Input]
      ClckFormError
      [XMLGenT
         (ClckT ProfileDataURL (ServerPartT IO))
         (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
      ()
      ())
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     ()
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     ()
forall a b. (a -> b) -> a -> b
$
     Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  ()
forall (m :: * -> *) (x :: * -> *) error input.
(Monad m, XMLGenerator x, StringType x ~ Text,
 EmbedAsChild x error) =>
Form m input error [XMLGenT x (XMLType x)] () ()
errorList Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  ()
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     ()
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     ()
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
++>
          ((,) (Text -> Text -> (Text, 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 -> (Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
divControlGroup (Text -> ClckForm ProfileDataURL ()
label' Text
"Email" 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))
     (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
divControls (Text
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     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)] () Text
inputText (Text -> (Email -> Text) -> Maybe Email -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
Text.empty Email -> Text
_unEmail Maybe Email
_email)))))
               Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  (Text -> (Text, 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, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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
divControlGroup (Text -> ClckForm ProfileDataURL ()
label' Text
"DisplayName" 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))
     (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
divControls (Text
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     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)] () Text
inputText (Text -> (DisplayName -> Text) -> Maybe DisplayName -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
Text.empty DisplayName -> Text
unDisplayName (ProfileData -> Maybe DisplayName
displayName ProfileData
pd))))))
               Form
  (ClckT ProfileDataURL (ServerPartT IO))
  [Input]
  ClckFormError
  [XMLGenT
     (ClckT ProfileDataURL (ServerPartT IO))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  (Text, 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)))]
     ()
     (Text, 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)) 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
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)
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 (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 (String -> Text
pack String
"Update") 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))
     (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
  ()
  (Text, Text)
-> ((Text, Text)
    -> ClckT ProfileDataURL (ServerPartT IO) (Either ClckFormError ()))
-> Form
     (ClckT ProfileDataURL (ServerPartT IO))
     [Input]
     ClckFormError
     [XMLGenT
        (ClckT ProfileDataURL (ServerPartT IO))
        (XMLType (ClckT ProfileDataURL (ServerPartT IO)))]
     ()
     ()
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, Text)
-> 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 :: 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
divHorizontal   = ([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="form-horizontal"><% xml %></div>|]])
    divControlGroup :: 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
divControlGroup = ([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="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 :: (Text.Text, Text.Text) -> Clck ProfileDataURL (Either ClckFormError ())
    updateProfileData :: (Text, Text)
-> ClckT ProfileDataURL (ServerPartT IO) (Either ClckFormError ())
updateProfileData (Text
eml, Text
dn) =
      do let user :: User
user = User
u { _email :: Maybe Email
_email       = if Text -> Bool
Text.null Text
eml then Maybe Email
forall a. Maybe a
Nothing else (Email -> Maybe Email
forall a. a -> Maybe a
Just (Text -> Email
Email Text
eml))
                      }
         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)) <- 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 (Plugin
  AuthURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
-> Text
forall url theme n hook config st.
Plugin url theme n hook config st -> Text
pluginName Plugin
  AuthURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
authenticatePlugin)
         IO () -> ClckT ProfileDataURL (ServerPartT IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClckT ProfileDataURL (ServerPartT IO) ())
-> IO () -> ClckT ProfileDataURL (ServerPartT IO) ()
forall a b. (a -> b) -> a -> b
$ AcidState (EventState UpdateUser)
-> UpdateUser -> IO (EventResult UpdateUser)
forall event.
UpdateEvent event =>
AcidState (EventState event) -> event -> IO (EventResult event)
Acid.update AcidState (EventState UpdateUser)
AcidState AuthenticateState
authenticateState  (User -> UpdateUser
UpdateUser User
user)
         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
_userId)
         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
pd { displayName :: Maybe DisplayName
displayName = if Text -> Bool
Text.null Text
dn then Maybe DisplayName
forall a. Maybe a
Nothing else DisplayName -> Maybe DisplayName
forall a. a -> Maybe a
Just (Text -> DisplayName
DisplayName Text
dn) }))
         Either ClckFormError ()
-> ClckT ProfileDataURL (ServerPartT IO) (Either ClckFormError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ClckFormError ()
 -> ClckT ProfileDataURL (ServerPartT IO) (Either ClckFormError ()))
-> Either ClckFormError ()
-> ClckT ProfileDataURL (ServerPartT IO) (Either ClckFormError ())
forall a b. (a -> b) -> a -> b
$ () -> Either ClckFormError ()
forall a b. b -> Either a b
Right ()