{-# LANGUAGE RecordWildCards #-} module Clckwrks.ProfileData.Route where import Clckwrks import Clckwrks.ProfileData.Acid import Clckwrks.ProfileData.EditProfileData (editProfileDataPage) import Clckwrks.ProfileData.EditNewProfileData (editNewProfileDataPage) import Clckwrks.ProfileData.EditProfileDataFor (editProfileDataForPage) import Clckwrks.ProfileData.URL (ProfileDataURL(..)) import Clckwrks.ProfileData.Types import Control.Monad.State (get) import Data.Set (singleton) import Data.Text (Text) routeProfileData :: ProfileDataURL -> Clck ProfileDataURL Response routeProfileData :: ProfileDataURL -> Clck ProfileDataURL Response routeProfileData ProfileDataURL url = case ProfileDataURL url of ProfileDataURL CreateNewProfileData -> do Maybe UserId mUserId <- ClckT ProfileDataURL (ServerPartT IO) (Maybe UserId) forall (m :: * -> *) url. Happstack m => ClckT url m (Maybe UserId) getUserId case Maybe UserId mUserId 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 $ [Char] -> Response forall a. ToMessage a => a -> Response toResponse ([Char] -> Response) -> [Char] -> Response forall a b. (a -> b) -> a -> b $ [Char] "not logged in." (Just UserId userId) -> do (ProfileData _, Bool new) <- NewProfileData -> ClckT ProfileDataURL (ServerPartT IO) (EventResult NewProfileData) forall event (m :: * -> *). (UpdateEvent event, GetAcidState m (EventState event), Functor m, MonadIO m, MonadState ClckState m) => event -> m (EventResult event) update (ProfileData -> NewProfileData NewProfileData (UserId -> ProfileData defaultProfileDataFor UserId userId)) if Bool new then 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 EditNewProfileData else do Maybe Text mRedirect <- GetLoginRedirect -> ClckT ProfileDataURL (ServerPartT IO) (EventResult GetLoginRedirect) forall event (m :: * -> *). (QueryEvent event, GetAcidState m (EventState event), Functor m, MonadIO m, MonadState ClckState m) => event -> m (EventResult event) query GetLoginRedirect GetLoginRedirect case Maybe Text mRedirect of (Just Text url) -> Text -> Response -> Clck ProfileDataURL Response forall (m :: * -> *) uri res. (FilterMonad Response m, ToSURI uri) => uri -> res -> m res seeOther Text url (() -> Response forall a. ToMessage a => a -> Response toResponse ()) Maybe Text Nothing -> do Maybe [Char] mRedirectCookie <- ClckT ProfileDataURL (ServerPartT IO) (Maybe [Char]) forall (m :: * -> *). Happstack m => m (Maybe [Char]) getRedirectCookie case Maybe [Char] mRedirectCookie of (Just [Char] u) -> [Char] -> Response -> Clck ProfileDataURL Response forall (m :: * -> *) uri res. (FilterMonad Response m, ToSURI uri) => uri -> res -> m res seeOther [Char] u (() -> Response forall a. ToMessage a => a -> Response toResponse ()) Maybe [Char] Nothing -> 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 EditProfileData ProfileDataURL EditProfileData -> do ProfileDataURL -> Clck ProfileDataURL Response editProfileDataPage ProfileDataURL url ProfileDataURL EditNewProfileData -> do ProfileDataURL -> Clck ProfileDataURL Response editNewProfileDataPage ProfileDataURL url EditProfileDataFor UserId u -> do ProfileDataURL -> UserId -> Clck ProfileDataURL Response editProfileDataForPage ProfileDataURL url UserId u