class DisplayAble added to display anything

messages/de.msg

@@ -68,4 +68,5 @@ Name: Name
 MatrikelNr: Matrikelnummer
 Theme: Oberflächen Design
 Favoriten: Anzahl gespeicherter Favoriten
-
+Plugin: Plugin
+Ident: Identifizierung

src/Handler/Profile.hs

@@ -20,20 +20,33 @@ getProfileR :: Handler Html
 getProfileR = do
     (uid, User{..}) <- requireAuthPair
     mr <- getMessageRender
-    (admin_rights,lecturer_rights) <- runDB $ (,) <$>
+    (admin_rights,lecturer_rights,studies) <- runDB $ (,,) <$>
             (E.select $ E.from $ \(adright `E.InnerJoin` school) -> do
                 E.where_ $ adright ^. UserAdminUser E.==. E.val uid
                 E.on $ adright ^. UserAdminSchool E.==. school ^. SchoolId
                 return (school ^. SchoolName)     
             ) 
-            <*> 
+            <*>
             (E.select $ E.from $ \(lecright `E.InnerJoin` school) -> do
                 E.where_ $ lecright ^. UserLecturerUser E.==. E.val uid
                 E.on $ lecright ^. UserLecturerSchool E.==. school ^. SchoolId
-                return (school ^. SchoolName)     
-            )        
+                return (school ^. SchoolName)
+            )
+            <*>
+            (E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
+                E.where_ $ studyfeat ^. StudyFeaturesUser E.==. E.val uid
+                E.on $ studyfeat ^. StudyFeaturesField  E.==. studyterms  ^. StudyTermsId
+                E.on $ studyfeat ^. StudyFeaturesDegree E.==. studydegree ^. StudyDegreeId
+                return  (studydegree ^. StudyDegreeName
+                        ,studyterms  ^. StudyTermsName
+                        ,studyfeat   ^. StudyFeaturesType
+                        ,studyfeat   ^. StudyFeaturesSemester)
+            )
+
     let userData =
           [ (MsgName        ,  userDisplayName   )
+          , (MsgIdent       ,  userIdent )
+          , (MsgPlugin      ,  userPlugin        )
           , (MsgMatrikelNr  ,  fromMaybe "" userMatrikelnummer)
           , (MsgEMail       ,  userEmail         )
           , (MsgFavoriten   ,  pack $ show userMaxFavourites)

src/Utils.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, UndecidableInstances #-}
 {-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-}
 {-# LANGUAGE QuasiQuotes #-}
 
@@ -28,6 +29,8 @@ import Control.Monad.Trans.Maybe (MaybeT(..))
 import Control.Monad.Catch
 
 
+import qualified Database.Esqueleto as E (Value, unValue)
+
 -----------
 -- Yesod --
 -----------
@@ -78,6 +81,28 @@ uncamel = ("theme-" ++) . reverse . foldl helper []
       | otherwise = c : acc
 
 
+-- Convert anything to Text, and I don't care how
+class DisplayAble a where
+  display :: a -> Text
+
+instance DisplayAble Text where
+  display = id
+
+instance DisplayAble String where
+  display = pack
+
+instance DisplayAble a => DisplayAble (Maybe a) where
+  display Nothing  = ""
+  display (Just x) = display x
+
+instance DisplayAble a => DisplayAble (E.Value a) where
+  display = display . E.unValue
+
+-- The easy way out of UndecidableInstances (TypeFamilies would have been proper, but are much more complicated)
+instance {-# OVERLAPPABLE #-} Show a => DisplayAble a where
+  display = pack . show
+
+
 
 ------------
 -- Tuples --
@@ -90,6 +115,10 @@ snd3 (_,y,_) = y
 trd3 :: (a,b,c) -> c
 trd3 (_,_,z) = z
 
+-- Further projections are available via TemplateHaskell, defined in Utils.Common:
+-- $(projN n m) :: (t1,..,tn) -> tm (for m<=n)
+-- snd3 = $(projNI 3 2)
+
 
 
 ----------

templates/profile.hamlet

@@ -14,17 +14,26 @@
         Administrator für die Institute
       <ul>
         $forall institute <- admin_rights
-          <li>#{E.unValue institute}
+          <li>#{display institute}
     $if not $ null lecturer_rights
       <h1>
         Lehrberechtigung für die Institute
       <ul>
         $forall institute <- lecturer_rights
-          <li>#{E.unValue institute}
+          <li>#{display institute}
     <p>
       <h1>
         Benutzerdaten
       ^{userTable}
+      <h2>
+        Studiengänge
+        <ul>
+          $forall (degree,field,fieldtype,semester) <- studies
+            <li>#{display degree}
+                #{display field}
+                #{display fieldtype}
+                #{display semester}
+
       <em> TODO: Mehr Daten in Tabelle anzeigen!
       <h2>
         Alle Benutzerbezogenen Daten (Abgaben, Klausurnoten, etc.)