[add profile data to demo
Jeremy Shaw <jeremy@seereason.com>**20110418213043
 Ignore-this: c54bb1d6b0de58345306202ed4807534
] addfile ./demo/ProfileData.hs
addfile ./demo/demo.cabal
hunk ./demo/Main.hs 24
+import ProfileData
hunk ./demo/Main.hs 26
+import System.Environment
hunk ./demo/Main.hs 41
-    type Dependencies DemoState = AuthState :+: ProfileState :+: End
+    type Dependencies DemoState = AuthState :+: ProfileState :+: ProfileDataState :+: End
hunk ./demo/Main.hs 48
-    do state <- startSystemState (Proxy :: Proxy DemoState)
-       tid <- forkIO $ simpleHTTP validateConf (setValidatorSP printResponse $ impl "http://www.n-heptane.com:8000/")
+    do [baseURI] <- getArgs
+       state <- startSystemState (Proxy :: Proxy DemoState)
+       tid <- forkIO $ simpleHTTP validateConf (setValidatorSP printResponse $ impl baseURI)
hunk ./demo/Main.hs 83
-    msum [ do r <- implSite_ baseURI "web/" (spec (Just "http://*.n-heptane.com:8000/"))
+    msum [ do r <- implSite_ baseURI "web/" (spec (Just baseURI))
hunk ./demo/Main.hs 100
+-- TODO: use urlTemplate
hunk ./demo/Main.hs 107
-      (U_Profile profile) -> nestURL U_Profile $ handleProfile defaultTemplate' profile
+      (U_Profile profile) -> do postPickedURL <- showURL (U_ProfileData CreateNewProfileData)
+                                nestURL U_Profile $ handleProfile defaultTemplate' postPickedURL profile
+      (U_ProfileData profileDataURL) ->
+                             do handleProfileData profileDataURL
hunk ./demo/Pages/Home.hs 4
+import Data.Maybe
+import qualified Data.Text as Text
hunk ./demo/Pages/Home.hs 10
+import Happstack.State
hunk ./demo/Pages/Home.hs 13
+import ProfileData
hunk ./demo/Pages/Home.hs 25
-         (Just (UserId uid)) ->
+         (Just uid) -> do 
+             mpd <- query (AskProfileData uid)
hunk ./demo/Pages/Home.hs 29
-                <p>You are logged in as <% show uid %>. You can logout <a href=(U_Auth A_Logout)>here</a>. You can add an additional auth method <a href=(U_Auth A_AddAuth)>here</a>.</p>
+                <p>You are logged in as <% show uid %>.</p> 
+                <p>You can logout <a href=(U_Auth A_Logout)>here</a>.</p>
+                <p>You can add an additional auth method <a href=(U_Auth A_AddAuth)>here</a>.</p>
+                <p>Your message is: <% fromMaybe (Text.pack "profile data missing.") (fmap profileMsg mpd) %></p>
hunk ./demo/ProfileData.hs 1
+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, TemplateHaskell, MultiParamTypeClasses, RecordWildCards, TypeFamilies #-}
+module ProfileData where
+
+import Control.Monad.Reader
+import Control.Monad.State
+import Data.Generics
+import Happstack.State
+import Happstack.Auth.Core.Profile
+import Happstack.Data.IxSet        (IxSet, (@=), getOne, inferIxSet, noCalcs)
+import Happstack.Server
+import qualified Happstack.Data.IxSet  as IxSet
+import Data.Text                   (Text)
+import qualified Data.Text         as Text
+import Web.Routes.TH
+
+data ProfileData = 
+    ProfileData { dataFor :: UserId
+                , profileMsg :: Text
+                }
+    deriving (Eq, Ord, Read, Show, Typeable, Data)
+
+instance Version ProfileData
+$(deriveSerialize ''ProfileData)
+
+$(inferIxSet "ProfilesData" ''ProfileData 'noCalcs [''UserId, ''Text])
+
+data ProfileDataState =
+    ProfileDataState { profilesData :: ProfilesData }
+    deriving (Eq, Ord, Read, Show, Typeable, Data)
+instance Version ProfileDataState
+$(deriveSerialize ''ProfileDataState)
+
+newProfileData :: UserId -> Text -> Update ProfileDataState ProfileData
+newProfileData uid msg =
+    do pds@(ProfileDataState {..}) <- get       
+       let profileData = ProfileData uid msg
+       put $ pds { profilesData = IxSet.insert profileData profilesData }
+       return profileData
+
+askProfileData :: UserId -> Query ProfileDataState (Maybe ProfileData)
+askProfileData uid =
+    do ProfileDataState{..} <- ask
+       return $ getOne $ profilesData @= uid
+
+$(mkMethods ''ProfileDataState 
+                [ 'newProfileData
+                , 'askProfileData
+                ]
+ )
+
+instance Component ProfileDataState where
+    type Dependencies ProfileDataState = End
+    initialValue = ProfileDataState { profilesData = IxSet.empty }
+
+data ProfileDataURL 
+    = CreateNewProfileData 
+    | ViewProfileData UserId
+      deriving (Eq, Ord, Read, Show, Data, Typeable)
+
+$(derivePathInfo ''ProfileDataURL)
+
+handleProfileData url =
+    case url of
+      CreateNewProfileData ->
+          do mUserId <- getUserId
+             case mUserId of
+               Nothing -> internalServerError $ toResponse $ "not logged in."
+               (Just userId) ->
+                   do update (NewProfileData userId (Text.pack "this is the default message."))
+                      seeOther "/" (toResponse "/")
+      (ViewProfileData uid) ->
+          do mProfileData <- query (AskProfileData uid)
+             ok $ toResponse $ show mProfileData
hunk ./demo/SiteURL.hs 6
+import ProfileData
hunk ./demo/SiteURL.hs 14
+    | U_ProfileData ProfileDataURL