Finish route change, it builds now

I used this chance to make some name changes, add some utils, tweak some
imports, remove more `setTitle`s and so on. I also made person, repo,
key and project creation forms verify CI-uniqueness.

config/models

@@ -13,10 +13,10 @@
 -- <http://creativecommons.org/publicdomain/zero/1.0/>.
 
 Sharer
-    ident TextCI
-    name  Text   Maybe
+    ident ShrIdent
+    name  Text     Maybe
 
-    UniqueSharerIdent ident
+    UniqueSharer ident
 
 Person
     ident SharerId
@@ -28,12 +28,12 @@ Person
     UniquePersonLogin login
 
 SshKey
+    ident   KyIdent
     person  PersonId
-    name    Text
     algo    ByteString
     content ByteString
 
-    UniqueSshKey person name
+    UniqueSshKey person ident
 
 Group
     ident SharerId
@@ -41,7 +41,7 @@ Group
     UniqueGroupIdent ident
 
 Project
-    ident      TextCI
+    ident      PrjIdent
     sharer     SharerId
     name       Text     Maybe
     desc       Text     Maybe
@@ -50,7 +50,7 @@ Project
     UniqueProject ident sharer
 
 Repo
-    ident      TextCI
+    ident      RpIdent
     sharer     SharerId
     vcs        VersionControlSystem       default='VCSGit'
     project    ProjectId            Maybe

src/Data/CaseInsensitive/Local.hs

@@ -0,0 +1,48 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+-- | CI views for avoiding ambiguity in the meaning of some typeclass
+-- instances, and allow two instances to coexist. For example, does 'show' show
+-- the original or the case-folded version? Using CI views, it's easy to
+-- specify that.
+--
+-- Note that some of the instances provided here, i.e. instances 'CI' already
+-- has, are reused directly by both views. If you aren't sure about a specific
+-- instance, check the source.
+module Data.CaseInsensitive.Local
+    ( AsOriginal (..)
+    , mkOrig
+    , AsCaseFolded (..)
+    , mkFolded
+    )
+where
+
+import Prelude
+
+import Data.CaseInsensitive
+import Data.Hashable (Hashable)
+import Data.String (IsString)
+
+newtype AsOriginal s = AsOriginal { unOriginal :: CI s }
+    deriving (Eq, Ord, Read, Show, IsString, Monoid, Hashable, FoldCase)
+
+mkOrig :: FoldCase s => s -> AsOriginal s
+mkOrig = AsOriginal . mk
+
+newtype AsCaseFolded s = AsCaseFolded { unCaseFolded :: CI s }
+    deriving (Eq, Ord, Read, Show, IsString, Monoid, Hashable, FoldCase)
+
+mkFolded :: FoldCase s => s -> AsCaseFolded s
+mkFolded = AsCaseFolded . mk

src/Database/Esqueleto/Local.hs

@@ -25,4 +25,6 @@ import Database.Esqueleto
 
 import qualified Data.CaseInsensitive as CI
 
-instance SqlString s => SqlString (CI s)
+import Database.Persist.Class.Local ()
+
+instance (SqlString s, CI.FoldCase s) => SqlString (CI s)

src/Formatting/CaseInsensitive.hs

@@ -0,0 +1,33 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+module Formatting.CaseInsensitive
+    ( ciOrig
+    , ciFolded
+    )
+where
+
+import Prelude
+
+import Data.CaseInsensitive
+import Data.Text (Text)
+import Data.Text.Lazy.Builder (fromText)
+import Formatting
+
+ciOrig :: Format r (CI Text -> r)
+ciOrig = later $ fromText . original
+
+ciFolded :: Format r (CI Text -> r)
+ciFolded = later $ fromText . foldedCase

src/Text/Blaze/Local.hs

@@ -25,6 +25,12 @@ import Text.Blaze
 
 import qualified Data.CaseInsensitive as CI
 
-instance ToMarkup s => ToMarkup (CI s) where
-    toMarkup = toMarkup . CI.original
-    preEscapedToMarkup = preEscapedToMarkup . CI.original
+import qualified Data.CaseInsensitive.Local as CIL
+
+instance ToMarkup s => ToMarkup (CIL.AsOriginal s) where
+    toMarkup = toMarkup . CI.original . CIL.unOriginal
+    preEscapedToMarkup = preEscapedToMarkup . CI.original . CIL.unOriginal
+
+instance ToMarkup s => ToMarkup (CIL.AsCaseFolded s) where
+    toMarkup = toMarkup . CI.foldedCase . CIL.unCaseFolded
+    preEscapedToMarkup = preEscapedToMarkup . CI.foldedCase . CIL.unCaseFolded

src/Vervis/Field/Key.hs

@@ -29,6 +29,7 @@ import Data.Maybe (isNothing)
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
+import Database.Esqueleto
 import Database.Persist (checkUnique)
 import Yesod.Form.Fields (textField)
 import Yesod.Form.Functions (check, checkBool, checkM, convertField)
@@ -42,6 +43,7 @@ import Data.Char.Local (isAsciiLetter)
 import Network.SSH.Local (supportedKeyAlgos)
 import Vervis.Foundation
 import Vervis.Model
+import Vervis.Model.Ident (text2ky)
 
 mkBsField :: Field Handler Text -> Field Handler ByteString
 mkBsField = convertField encodeUtf8 (decodeUtf8With lenientDecode)
@@ -50,16 +52,16 @@ bsField :: Field Handler ByteString
 bsField = mkBsField textField
 
 checkNameUnique :: PersonId -> Field Handler Text -> Field Handler Text
-checkNameUnique pid = checkM $ \ name -> runDB $ do
-    let key = SshKey
-            { sshKeyPerson  = pid
-            , sshKeyName    = name
-            , sshKeyAlgo    = mempty
-            , sshKeyContent = mempty
-            }
-    muk <- checkUnique key
-    return $ if isNothing muk
-        then Right name
+checkNameUnique pid = checkM $ \ ident -> do
+    let ident' = text2ky ident
+    sames <- runDB $ select $ from $ \ key -> do
+        where_ $
+            key ^. SshKeyPerson         ==. val pid             &&.
+            lower_ (key ^. SshKeyIdent) ==. lower_ (val ident')
+        limit 1
+        return ()
+    return $ if null sames
+        then Right ident
         else Left ("You already have a key with this label" :: Text)
 
 nameField :: PersonId -> Field Handler Text

src/Vervis/Field/Person.hs

@@ -25,6 +25,7 @@ import Data.Char (isDigit)
 import Database.Esqueleto
 
 import Data.Char.Local (isAsciiLetter)
+import Vervis.Model.Ident (text2shr)
 
 checkLoginTemplate :: Field Handler Text -> Field Handler Text
 checkLoginTemplate =
@@ -43,8 +44,9 @@ checkLoginTemplate =
 
 checkLoginUnique :: Field Handler Text -> Field Handler Text
 checkLoginUnique = checkM $ \ login -> do
+    let login' = text2shr login
     sames <- runDB $ select $ from $ \ sharer -> do
-        where_ $ lower_ (sharer ^. SharerIdent) ==. lower_ (val login)
+        where_ $ lower_ (sharer ^. SharerIdent) ==. lower_ (val login')
         limit 1
         return ()
     return $ if null sames

src/Vervis/Field/Project.hs

@@ -18,11 +18,14 @@ module Vervis.Field.Project
     )
 where
 
-import Vervis.Import
+import Vervis.Import hiding ((==.))
 
 import Data.Char (isDigit)
 import Data.Char.Local (isAsciiLetter)
 import Data.Text (split)
+import Database.Esqueleto
+
+import Vervis.Model.Ident (text2prj)
 
 checkIdentTemplate :: Field Handler Text -> Field Handler Text
 checkIdentTemplate =
@@ -37,15 +40,14 @@ checkIdentTemplate =
 
 checkIdentUnique :: SharerId -> Field Handler Text -> Field Handler Text
 checkIdentUnique sid = checkM $ \ ident -> do
-    let project = Project
-            { projectIdent      = ident
-            , projectSharer     = sid
-            , projectName       = Nothing
-            , projectDesc       = Nothing
-            , projectNextTicket = 0
-            }
-    mup <- runDB $ checkUnique project
-    return $ if isNothing mup
+    let ident' = text2prj ident
+    sames <- runDB $ select $ from $ \ project -> do
+        where_ $
+            project ^. ProjectSharer         ==. val sid             &&.
+            lower_ (project ^. ProjectIdent) ==. lower_ (val ident')
+        limit 1
+        return ()
+    return $ if null sames
         then Right ident
         else Left ("You already have a project by that name" :: Text)
 

src/Vervis/Field/Repo.hs

@@ -18,11 +18,14 @@ module Vervis.Field.Repo
     )
 where
 
-import Vervis.Import
+import Vervis.Import hiding ((==.))
 
 import Data.Char (isDigit)
 import Data.Char.Local (isAsciiLetter)
 import Data.Text (split)
+import Database.Esqueleto
+
+import Vervis.Model.Ident (text2rp)
 
 checkIdentTemplate :: Field Handler Text -> Field Handler Text
 checkIdentTemplate =
@@ -38,8 +41,14 @@ checkIdentTemplate =
 -- | Make sure the sharer doesn't already have a repo by the same name.
 checkIdentUnique :: SharerId -> Field Handler Text -> Field Handler Text
 checkIdentUnique sid = checkM $ \ ident -> do
-    mrepo <- runDB $ getBy $ UniqueRepo ident sid
-    return $ if isNothing mrepo
+    let ident' = text2rp ident
+    sames <- runDB $ select $ from $ \ repo -> do
+        where_ $
+            repo ^. RepoSharer         ==. val sid             &&.
+            lower_ (repo ^. RepoIdent) ==. lower_ (val ident')
+        limit 1
+        return ()
+    return $ if null sames
         then Right ident
         else Left ("You already have a repo by that name" :: Text)
 

src/Vervis/Form/Key.hs

@@ -21,11 +21,12 @@ where
 import Vervis.Import
 
 import Vervis.Field.Key
+import Vervis.Model.Ident (text2ky)
 
 newKeyAForm :: PersonId -> AForm Handler SshKey
 newKeyAForm pid = SshKey
-    <$> pure pid
-    <*> areq (nameField pid) "Name*"      Nothing
+    <$> (text2ky <$> areq (nameField pid) "Name*"      Nothing)
+    <*> pure pid
     <*> areq algoField       "Algorithm*" Nothing
     <*> areq contentField    "Content*"   Nothing
 

src/Vervis/Form/Person.hs

@@ -26,13 +26,15 @@ import Vervis.Field.Person
 data PersonNew = PersonNew
     { uLogin :: Text
     , uPass  :: Text
+    , uName  :: Maybe Text
     , uEmail :: Maybe Text
     }
 
 newPersonAForm :: AForm Handler PersonNew
 newPersonAForm = PersonNew
-    <$> areq loginField "Username" Nothing
-    <*> areq passField "Password" Nothing
+    <$> areq loginField "Username*" Nothing
+    <*> areq passField "Password*" Nothing
+    <*> aopt textField "Full name" Nothing
     <*> aopt emailField "E-mail" Nothing
 
 formPersonNew :: Form PersonNew

src/Vervis/Form/Project.hs

@@ -21,10 +21,11 @@ where
 import Vervis.Import
 
 import Vervis.Field.Project
+import Vervis.Model.Ident (text2prj)
 
 newProjectAForm :: SharerId -> AForm Handler Project
 newProjectAForm sid = Project
-    <$> areq (mkIdentField sid) "Identifier*" Nothing
+    <$> (text2prj <$> areq (mkIdentField sid) "Identifier*" Nothing)
     <*> pure sid
     <*> aopt textField "Name" Nothing
     <*> aopt textField "Description" Nothing

src/Vervis/Form/Repo.hs

@@ -22,11 +22,12 @@ where
 
 import Vervis.Import
 import Vervis.Field.Repo
+import Vervis.Model.Ident (prj2text, text2rp)
 import Vervis.Model.Repo
 
 newRepoAForm :: SharerId -> Maybe ProjectId -> AForm Handler Repo
 newRepoAForm sid mpid = Repo
-    <$> areq (mkIdentField sid) "Identifier*" Nothing
+    <$> (text2rp <$> areq (mkIdentField sid) "Identifier*" Nothing)
     <*> pure sid
     <*> areq (selectFieldList vcsList) "Version control system*" Nothing
     <*> aopt selectProject "Project" (Just mpid)
@@ -40,8 +41,8 @@ newRepoAForm sid mpid = Repo
         ]
     selectProject =
         selectField $
-        optionsPersistKey
-            [ProjectSharer ==. sid] [Asc ProjectIdent] projectIdent
+        optionsPersistKey [ProjectSharer ==. sid] [Asc ProjectIdent] $
+        prj2text . projectIdent
 
 newRepoForm :: SharerId -> Maybe ProjectId -> Form Repo
 newRepoForm sid mpid = renderDivs $ newRepoAForm sid mpid

src/Vervis/Formatting.hs

@@ -0,0 +1,58 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+module Vervis.Formatting
+    ( sharer
+    , sharerl
+    , key
+    , keyl
+    , project
+    , projectl
+    , repo
+    , repol
+    )
+where
+
+import Prelude
+
+import Data.CaseInsensitive
+import Data.Text.Lazy.Builder (fromText)
+import Formatting
+
+import Vervis.Model.Ident
+
+sharer :: Format r (ShrIdent -> r)
+sharer = later $ fromText . original . unShrIdent
+
+sharerl :: Format r (ShrIdent -> r)
+sharerl = later $ fromText . foldedCase . unShrIdent
+
+key :: Format r (KyIdent -> r)
+key = later $ fromText . original . unKyIdent
+
+keyl :: Format r (KyIdent -> r)
+keyl = later $ fromText . foldedCase . unKyIdent
+
+project :: Format r (PrjIdent -> r)
+project = later $ fromText . original . unPrjIdent
+
+projectl :: Format r (PrjIdent -> r)
+projectl = later $ fromText . foldedCase . unPrjIdent
+
+repo :: Format r (RpIdent -> r)
+repo = later $ fromText . original . unRpIdent
+
+repol :: Format r (RpIdent -> r)
+repol = later $ fromText . foldedCase . unRpIdent

src/Vervis/Foundation.hs

@@ -120,12 +120,9 @@ instance Yesod App where
         loggedInAs user "You can’t create projects for other users"
     isAuthorized (RepoNewR user) _ =
         loggedInAs user "You can’t create repos for other users"
-    isAuthorized (KeysR user) _ =
-        loggedInAs user "You can’t watch keys of other users"
-    isAuthorized (KeyR user _key) _ =
-        loggedInAs user "You can’t watch keys of other users"
-    isAuthorized (KeyNewR user) _ =
-        loggedInAs user "You can’t add keys for other users"
+    isAuthorized KeysR _ = loggedIn
+    isAuthorized (KeyR _key) _ = loggedIn
+    isAuthorized KeyNewR _ = loggedIn
     isAuthorized (RepoR shar _) True =
         loggedInAs shar "You can’t modify repos for other users"
     isAuthorized (TicketNewR _ _) _ = loggedIn
@@ -191,22 +188,6 @@ instance YesodAuth App where
         return $ case mpid of
             Nothing             -> UserError $ IdentifierNotFound ident
             Just (Entity pid _) -> Authenticated pid
-        {-ps <- select $ from $ \ (sharer, person) -> do
-            where_ $
-                sharer ^. SharerIdent ==. val ident &&.
-                sharer ^. SharerId ==. person ^. PersonIdent
-            return (person ^. PersonId, person ^. PersonHash)-}
-        {-case x of
-            Just (Entity uid _) -> return $ Authenticated uid
-            Nothing -> Authenticated <$> insert User
-                { userIdent = credsIdent creds
-                , userPassword = Nothing
-                }-}
-        {-return $ case ps of
-            []             -> UserError $ IdentifierNotFound ident
-            [(pid, phash)] -> 
-            _              -> ServerError "Data model error, non-unique ident"
-        -}
 
     -- You can add other plugins like BrowserID, email or OAuth here
     authPlugins _ = [authHashDB $ Just . UniquePersonLogin]
@@ -245,7 +226,7 @@ loggedIn = do
         Nothing   -> return AuthenticationRequired
         Just _pid -> return Authorized
 
-loggedInAs :: Text -> Text -> Handler AuthResult
+loggedInAs :: ShrIdent -> Text -> Handler AuthResult
 loggedInAs ident msg = do
     mp <- maybeAuth
     case mp of
@@ -269,15 +250,15 @@ instance YesodBreadcrumbs App where
 
         PeopleR                          -> ("People", Just HomeR)
         PersonNewR                       -> ("New", Just PeopleR)
-        PersonR shar                     -> (shar, Just PeopleR)
+        PersonR shar                     -> (shr2text shar, Just PeopleR)
 
-        KeysR shar                       -> ("Keys", Just $ PersonR shar)
-        KeyNewR shar                     -> ("New", Just $ KeysR shar)
-        KeyR shar key                    -> (key, Just $ KeysR shar)
+        KeysR                            -> ("Keys", Just HomeR)
+        KeyNewR                          -> ("New", Just KeysR)
+        KeyR key                         -> (ky2text key, Just KeysR)
 
         ReposR shar                      -> ("Repos", Just $ PersonR shar)
         RepoNewR shar                    -> ("New", Just $ ReposR shar)
-        RepoR shar repo                  -> (repo, Just $ ReposR shar)
+        RepoR shar repo                  -> (rp2text repo, Just $ ReposR shar)
         RepoSourceR shar repo []         -> ("Files", Just $ RepoR shar repo)
         RepoSourceR shar repo refdir     -> ( last refdir
                                             , Just $
@@ -291,7 +272,9 @@ instance YesodBreadcrumbs App where
 
         ProjectsR shar                   -> ("Projects", Just $ PersonR shar)
         ProjectNewR shar                 -> ("New", Just $ ProjectsR shar)
-        ProjectR shar proj               -> (proj, Just $ ProjectsR shar)
+        ProjectR shar proj               -> ( prj2text proj
+                                            , Just $ ProjectsR shar
+                                            )
 
         TicketsR shar proj               -> ( "Tickets"
                                             , Just $ ProjectR shar proj

src/Vervis/Handler/Git.hs

@@ -37,11 +37,12 @@ import Yesod.Core.Handler
 import Vervis.BinaryBody (decodeRequestBody)
 import Vervis.Content
 import Vervis.Foundation (Handler)
+import Vervis.Model.Ident
 import Vervis.Path (askRepoDir)
 
 getGitRefDiscoverR :: ShrIdent -> RpIdent -> Handler GitRefDiscovery
 getGitRefDiscoverR shar repo = do
-    path <- askRepoDir sharer repo
+    path <- askRepoDir shar repo
     let pathG = fromString path
     seemsThere <- liftIO $ isRepo pathG
     if seemsThere

src/Vervis/Handler/Home.hs

@@ -25,6 +25,7 @@ import Vervis.GitOld
 
 import qualified Database.Esqueleto as E ((==.))
 
+import Vervis.Model.Ident
 import Vervis.Model.Repo
 import Vervis.Path
 
@@ -46,18 +47,16 @@ intro = do
                     , repo ^. RepoIdent
                     , repo ^. RepoVcs
                     )
-        root <- askRepoRootDir
-        liftIO $ forM repos $
+        forM repos $
             \ (Value sharer, Value mproj, Value repo, Value vcs) -> do
                 ago <- case vcs of
                     VCSDarcs -> return "[Not implemented yet]"
                     VCSGit -> do
-                        let path =
-                                root </> unpack sharer </> unpack repo
-                        mdt <- lastChange path
+                        path <- askRepoDir sharer repo
+                        mdt <- liftIO $ lastChange path
                         case mdt of
                             Nothing -> return "never"
-                            Just dt -> timeAgo dt
+                            Just dt -> liftIO $ timeAgo dt
                 return (sharer, mproj, repo, vcs, ago)
     defaultLayout $ do
         setTitle "Welcome to Vervis!"

src/Vervis/Handler/Key.hs

@@ -32,6 +32,7 @@ import Data.Text.Encoding (decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
 import Database.Persist
 import Text.Blaze.Html (Html, toHtml)
+import Yesod.Auth (requireAuthId)
 import Yesod.Core (defaultLayout)
 import Yesod.Core.Handler
 import Yesod.Core.Widget (setTitle)
@@ -42,14 +43,15 @@ import Yesod.Persist.Core (runDB, getBy404)
 import Vervis.Form.Key
 import Vervis.Foundation
 import Vervis.Model
+import Vervis.Model.Ident
 import Vervis.Settings
 
 getKeysR :: Handler Html
 getKeysR = do
     pid <- requireAuthId
     keys <- runDB $ do
-        ks <- selectList [SshKeyPerson ==. pid] [Asc SshKeyName]
-        return $ map (\ (Entity _ k) -> sshKeyName k) ks
+        ks <- selectList [SshKeyPerson ==. pid] [Asc SshKeyIdent]
+        return $ map (\ (Entity _ k) -> sshKeyIdent k) ks
     defaultLayout $(widgetFile "key/list")
 
 postKeysR :: Handler Html
@@ -84,6 +86,7 @@ getKeyR tag = do
 
 deleteKeyR :: KyIdent -> Handler Html
 deleteKeyR tag = do
+    pid <- requireAuthId
     runDB $ do
         Entity kid _k <- getBy404 $ UniqueSshKey pid tag
         delete kid

src/Vervis/Handler/Person.hs

@@ -30,6 +30,8 @@ import Vervis.Form.Person
 import Text.Blaze.Html (toHtml)
 import Yesod.Auth.HashDB (setPassword)
 
+import Vervis.Model.Ident
+
 -- | Get list of users
 getPeopleR :: Handler Html
 getPeopleR = do
@@ -37,14 +39,12 @@ getPeopleR = do
         where_ $ sharer ^. SharerId ==. person ^. PersonIdent
         orderBy [asc $ sharer ^. SharerIdent]
         return $ sharer ^. SharerIdent
-    defaultLayout $ do
-        setTitle "Vervis > People"
-        $(widgetFile "people")
+    defaultLayout $(widgetFile "people")
 
 -- | Create new user
 postPeopleR :: Handler Html
 postPeopleR = do
-    regEnabled <- appRegister . appSettings <$> getYesod
+    regEnabled <- getsYesod $ appRegister . appSettings
     if regEnabled
         then do
             ((result, widget), enctype) <- runFormPost formPersonNew
@@ -52,8 +52,8 @@ postPeopleR = do
                 FormSuccess pn -> do
                     runDB $ do
                         let sharer = Sharer
-                                { sharerIdent = uLogin pn
-                                , sharerName  = Nothing
+                                { sharerIdent = text2shr $ uLogin pn
+                                , sharerName  = uName pn
                                 }
                         sid <- insert sharer
                         let person = Person
@@ -68,15 +68,10 @@ postPeopleR = do
                 FormMissing -> do
                     setMessage "Field(s) missing"
                     defaultLayout $(widgetFile "person-new")
-                FormFailure l -> do
-                    setMessage $ toHtml $ intercalate "; " l
+                FormFailure _l -> do
+                    setMessage "User registration failed, see errors below"
                     defaultLayout $(widgetFile "person-new")
         else notFound
-    --TODO NEXT:
-    -- * Maybe make the form return Form Person and just insert defaults (using
-    -- 'pure') for the remaining Person fields? Then, maybe the same form can
-    -- be used to generate the RESTful JSON API query that adds a Person with
-    -- their entire details. Dunno if it matters, just could be good/nice/cool.
 
 getPersonNewR :: Handler Html
 getPersonNewR = do
@@ -96,7 +91,7 @@ getPersonNewR = do
 getPersonR :: ShrIdent -> Handler Html
 getPersonR ident = do
     person <- runDB $ do
-        Entity sid _s <- getBy404 $ UniqueSharerIdent ident
+        Entity sid _s <- getBy404 $ UniqueSharer ident
         Entity _pid p <- getBy404 $ UniquePersonIdent sid
         return p
     defaultLayout $(widgetFile "person")

src/Vervis/Handler/Project.hs

@@ -39,6 +39,7 @@ import qualified Database.Esqueleto as E
 import Vervis.Form.Project
 import Vervis.Foundation
 import Vervis.Model
+import Vervis.Model.Ident
 import Vervis.Model.Repo
 import Vervis.Settings
 
@@ -79,7 +80,7 @@ getProjectNewR ident = do
 getProjectR :: ShrIdent -> PrjIdent -> Handler Html
 getProjectR shar proj = do
     (project, repos) <- runDB $ do
-        Entity sid _s <- getBy404 $ UniqueSharerIdent shar
+        Entity sid _s <- getBy404 $ UniqueSharer shar
         Entity pid p <- getBy404 $ UniqueProject proj sid
         rs <- selectList [RepoProject ==. Just pid] [Asc RepoIdent]
         return (p, rs)

src/Vervis/Handler/Repo.hs

@@ -29,6 +29,8 @@ where
 
 import Prelude
 
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Logger (logWarn)
 import Data.Git.Graph
 import Data.Git.Harder
 import Data.Git.Named (RefName (..))
@@ -40,15 +42,24 @@ import Data.Git.Types (Blob (..), Commit (..), Person (..), entName)
 import Data.Graph.Inductive.Graph (noNodes)
 import Data.Graph.Inductive.Query.Topsort
 import Data.List (inits)
-import Data.Text (unpack)
+import Data.Text (Text, unpack)
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
 import Database.Esqueleto hiding (delete, (%))
+import Database.Persist (delete)
 import Data.Hourglass (timeConvert)
 import Formatting (sformat, stext, (%))
 import System.Directory
 import System.Hourglass (dateCurrent)
+import Text.Blaze.Html (Html)
+import Yesod.Auth (requireAuth)
+import Yesod.Core (defaultLayout, setMessage)
+import Yesod.Core.Handler (lookupPostParam, redirect, notFound)
+import Yesod.Form.Functions (runFormPost)
+import Yesod.Form.Types (FormResult (..))
+import Yesod.Persist.Core (runDB, getBy404)
 
+import qualified Data.CaseInsensitive as CI (foldedCase)
 import qualified Data.DList as D
 import qualified Data.Set as S (member)
 import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With)
@@ -63,6 +74,7 @@ import Vervis.Handler.Repo.Git
 import Vervis.Path
 import Vervis.MediaType (chooseMediaType)
 import Vervis.Model
+import Vervis.Model.Ident
 import Vervis.Model.Repo
 import Vervis.Paginate
 import Vervis.Readme
@@ -76,6 +88,7 @@ import qualified Darcs.Local.Repository as D (createRepo)
 import qualified Data.ByteString.Lazy as BL (ByteString)
 import qualified Data.Git.Local as G (createRepo)
 import qualified Vervis.Darcs as D (readSourceView, readChangesView)
+import qualified Vervis.Formatting as F
 import qualified Vervis.Git as G (readSourceView, readChangesView, listRefs)
 
 getReposR :: ShrIdent -> Handler Html
@@ -86,7 +99,7 @@ getReposR user = do
             sharer ^. SharerId ==. repo ^. RepoSharer
         orderBy [asc $ repo ^. RepoIdent]
         return $ repo ^. RepoIdent
-    defaultLayout $(widgetFile "repo/repos")
+    defaultLayout $(widgetFile "repo/list")
 
 postReposR :: ShrIdent -> Handler Html
 postReposR user = do
@@ -98,7 +111,8 @@ postReposR user = do
             parent <- askSharerDir user
             liftIO $ do
                 createDirectoryIfMissing True parent
-                let repoName = unpack $ repoIdent repo
+                let repoName =
+                        unpack $ CI.foldedCase $ unRpIdent $ repoIdent repo
                 case repoVcs repo of
                     VCSDarcs -> D.createRepo parent repoName
                     VCSGit   -> G.createRepo parent repoName
@@ -107,21 +121,21 @@ postReposR user = do
             redirect $ ReposR user
         FormMissing -> do
             setMessage "Field(s) missing"
-            defaultLayout $(widgetFile "repo/repo-new")
+            defaultLayout $(widgetFile "repo/new")
         FormFailure _l -> do
             setMessage "Repo creation failed, see errors below"
-            defaultLayout $(widgetFile "repo/repo-new")
+            defaultLayout $(widgetFile "repo/new")
 
 getRepoNewR :: ShrIdent -> Handler Html
 getRepoNewR user = do
     Entity _pid person <- requireAuth
     let sid = personIdent person
     ((_result, widget), enctype) <- runFormPost $ newRepoForm sid Nothing
-    defaultLayout $(widgetFile "repo/repo-new")
+    defaultLayout $(widgetFile "repo/new")
 
 selectRepo :: ShrIdent -> RpIdent -> AppDB Repo
 selectRepo shar repo = do
-    Entity sid _s <- getBy404 $ UniqueSharerIdent shar
+    Entity sid _s <- getBy404 $ UniqueSharer shar
     Entity _rid r <- getBy404 $ UniqueRepo repo sid
     return r
 
@@ -137,7 +151,7 @@ getRepoR shar repo = do
 deleteRepoR :: ShrIdent -> RpIdent -> Handler Html
 deleteRepoR shar repo = do
     runDB $ do
-        Entity sid _s <- getBy404 $ UniqueSharerIdent shar
+        Entity sid _s <- getBy404 $ UniqueSharer shar
         Entity rid _r <- getBy404 $ UniqueRepo repo sid
         delete rid
     path <- askRepoDir shar repo
@@ -146,7 +160,7 @@ deleteRepoR shar repo = do
         then liftIO $ removeDirectoryRecursive path
         else
             $logWarn $ sformat
-                ( "Deleted repo " % stext % "/" % stext
+                ( "Deleted repo " % F.sharer % "/" % F.repo
                 % " from DB but repo dir doesn't exist"
                 )
                 shar repo

src/Vervis/Handler/Repo/Darcs.hs

@@ -23,13 +23,19 @@ where
 
 import Prelude
 
+import Control.Monad.IO.Class (liftIO)
 import Data.List (inits)
-import Data.Text (unpack)
+import Data.Maybe (fromMaybe)
+import Data.Text (Text, unpack)
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
 import Database.Esqueleto
-import System.FilePath (joinPath)
+import System.FilePath ((</>), joinPath)
 import System.Directory (doesFileExist)
+import Text.Blaze.Html (Html)
+import Yesod.Core (defaultLayout, setTitle)
+import Yesod.Core.Content (TypedContent, typeOctet)
+import Yesod.Core.Handler (sendFile, notFound)
 
 import qualified Data.DList as D
 import qualified Data.Set as S (member)
@@ -43,6 +49,7 @@ import Vervis.Foundation
 import Vervis.Path
 import Vervis.MediaType (chooseMediaType)
 import Vervis.Model
+import Vervis.Model.Ident
 import Vervis.Model.Repo
 import Vervis.Paginate
 import Vervis.Readme
@@ -65,10 +72,7 @@ getDarcsRepoSource repository user repo dir = do
         Just sv -> do
             let parent = if null dir then [] else init dir
                 dirs = zip parent (tail $ inits parent)
-            defaultLayout $ do
-                setTitle $ toHtml $ intercalate " > "
-                    ["Vervis", "People", user, "Repos", repo]
-                $(widgetFile "repo/source-darcs")
+            defaultLayout $(widgetFile "repo/source-darcs")
 
 getDarcsRepoHeadChanges :: ShrIdent -> RpIdent -> Handler Html
 getDarcsRepoHeadChanges shar repo = do

src/Vervis/Handler/Repo/Git.hs

@@ -22,6 +22,7 @@ where
 
 import Prelude
 
+import Control.Monad.IO.Class (liftIO)
 import Data.Git.Graph
 import Data.Git.Harder
 import Data.Git.Named (RefName (..))
@@ -33,13 +34,17 @@ import Data.Git.Types (Blob (..), Commit (..), Person (..), entName)
 import Data.Graph.Inductive.Graph (noNodes)
 import Data.Graph.Inductive.Query.Topsort
 import Data.List (inits)
-import Data.Text (unpack)
+import Data.Maybe (fromMaybe)
+import Data.Text (Text, unpack)
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
 import Database.Esqueleto
 import Data.Hourglass (timeConvert)
 import System.Directory (createDirectoryIfMissing)
 import System.Hourglass (dateCurrent)
+import Text.Blaze.Html (Html)
+import Yesod.Core (defaultLayout)
+import Yesod.Core.Handler (notFound)
 
 import qualified Data.DList as D
 import qualified Data.Set as S (member)
@@ -53,6 +58,7 @@ import Vervis.Foundation
 import Vervis.Path
 import Vervis.MediaType (chooseMediaType)
 import Vervis.Model
+import Vervis.Model.Ident
 import Vervis.Model.Repo
 import Vervis.Paginate
 import Vervis.Readme

src/Vervis/Handler/Ticket.hs

@@ -58,10 +58,12 @@ import Vervis.Foundation
 import Vervis.Handler.Discussion
 import Vervis.MediaType (MediaType (Markdown))
 import Vervis.Model
+import Vervis.Model.Ident
 import Vervis.Render (renderSourceT)
 import Vervis.Settings (widgetFile)
 import Vervis.TicketFilter (filterTickets)
 import Vervis.Widget.Discussion (discussionW)
+import Vervis.Widget.Person (sharerLinkW)
 
 getTicketsR :: ShrIdent -> PrjIdent -> Handler Html
 getTicketsR shar proj = do
@@ -81,8 +83,7 @@ getTicketsR shar proj = do
         orderBy [asc $ ticket ^. TicketNumber]
         return
             ( ticket ^. TicketNumber
-            , sharer ^. SharerIdent
-            , sharer ^. SharerName
+            , sharer
             , ticket ^. TicketTitle
             , ticket ^. TicketDone
             )
@@ -97,7 +98,7 @@ postTicketsR shar proj = do
             now <- liftIO getCurrentTime
             tnum <- runDB $ do
                 Entity pid project <- do
-                    Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
+                    Entity sid _sharer <- getBy404 $ UniqueSharer shar
                     getBy404 $ UniqueProject proj sid
                 update pid [ProjectNextTicket +=. 1]
                 let discussion = Discussion
@@ -135,7 +136,7 @@ getTicketNewR shar proj = do
 getTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html
 getTicketR shar proj num = do
     (author, closer, ticket) <- runDB $ do
-        Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
+        Entity sid _sharer <- getBy404 $ UniqueSharer shar
         Entity pid _project <- getBy404 $ UniqueProject proj sid
         Entity _tid ticket <- getBy404 $ UniqueTicket pid num
         person <- get404 $ ticketCreator ticket
@@ -158,7 +159,7 @@ getTicketR shar proj num = do
 putTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html
 putTicketR shar proj num = do
     Entity tid ticket <- runDB $ do
-        Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
+        Entity sid _sharer <- getBy404 $ UniqueSharer shar
         Entity pid _project <- getBy404 $ UniqueProject proj sid
         getBy404 $ UniqueTicket pid num
     user <- requireAuthId
@@ -192,7 +193,7 @@ postTicketR shar proj num = do
 getTicketEditR :: ShrIdent -> PrjIdent -> Int -> Handler Html
 getTicketEditR shar proj num = do
     Entity _tid ticket <- runDB $ do
-        Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
+        Entity sid _sharer <- getBy404 $ UniqueSharer shar
         Entity pid _project <- getBy404 $ UniqueProject proj sid
         getBy404 $ UniqueTicket pid num
     user <- requireAuthId
@@ -201,7 +202,7 @@ getTicketEditR shar proj num = do
 
 selectDiscussionId :: ShrIdent -> PrjIdent -> Int -> AppDB DiscussionId
 selectDiscussionId shar proj tnum = do
-    Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
+    Entity sid _sharer <- getBy404 $ UniqueSharer shar
     Entity pid _project <- getBy404 $ UniqueProject proj sid
     Entity _tid ticket <- getBy404 $ UniqueTicket pid tnum
     return $ ticketDiscuss ticket

src/Vervis/Model/Ident.hs

@@ -17,9 +17,17 @@
 -- and handlers.
 module Vervis.Model.Ident
     ( ShrIdent (..)
+    , shr2text
+    , text2shr
     , KyIdent (..)
+    , ky2text
+    , text2ky
     , PrjIdent (..)
+    , prj2text
+    , text2prj
     , RpIdent (..)
+    , rp2text
+    , text2rp
     )
 where
 
@@ -32,19 +40,49 @@ import Database.Persist.Class (PersistField)
 import Database.Persist.Sql (PersistFieldSql)
 import Web.PathPieces (PathPiece)
 
+import qualified Data.CaseInsensitive as CI
+
 import Database.Esqueleto.Local ()
 import Database.Persist.Class.Local ()
 import Database.Persist.Sql.Local ()
 import Web.PathPieces.Local ()
 
-newtype ShrIdent = ShrIdent { unSharIdent :: CI Text }
-    deriving (PersistField, PersistFieldSql, SqlString, PathPiece)
+newtype ShrIdent = ShrIdent { unShrIdent :: CI Text }
+    deriving
+        (Eq, Show, Read, PersistField, PersistFieldSql, SqlString, PathPiece)
+
+shr2text :: ShrIdent -> Text
+shr2text = CI.original . unShrIdent
+
+text2shr :: Text -> ShrIdent
+text2shr = ShrIdent . CI.mk
 
 newtype KyIdent = KyIdent { unKyIdent :: CI Text }
-    deriving (PersistField, PersistFieldSql, SqlString, PathPiece)
+    deriving
+        (Eq, Show, Read, PersistField, PersistFieldSql, SqlString, PathPiece)
+
+ky2text :: KyIdent -> Text
+ky2text = CI.original . unKyIdent
+
+text2ky :: Text -> KyIdent
+text2ky = KyIdent . CI.mk
 
 newtype PrjIdent = PrjIdent { unPrjIdent :: CI Text }
-    deriving (PersistField, PersistFieldSql, SqlString, PathPiece)
+    deriving
+        (Eq, Show, Read, PersistField, PersistFieldSql, SqlString, PathPiece)
+
+prj2text :: PrjIdent -> Text
+prj2text = CI.original . unPrjIdent
+
+text2prj :: Text -> PrjIdent
+text2prj = PrjIdent . CI.mk
 
 newtype RpIdent = RpIdent { unRpIdent :: CI Text }
-    deriving (PersistField, PersistFieldSql, SqlString, PathPiece)
+    deriving
+        (Eq, Show, Read, PersistField, PersistFieldSql, SqlString, PathPiece)
+
+rp2text :: RpIdent -> Text
+rp2text = CI.original . unRpIdent
+
+text2rp :: Text -> RpIdent
+text2rp = RpIdent . CI.mk

src/Vervis/Widget/Discussion.hs

@@ -42,6 +42,7 @@ import Vervis.MediaType (MediaType (Markdown))
 import Vervis.Model
 import Vervis.Render (renderSourceT)
 import Vervis.Settings (widgetFile)
+import Vervis.Widget.Person (sharerLinkW)
 
 messageW :: UTCTime -> Sharer -> Message -> (Int -> Route App) -> Widget
 messageW now shr msg reply =

src/Vervis/Widget/Person.hs

@@ -0,0 +1,30 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+module Vervis.Widget.Person
+    ( sharerLinkW
+    )
+where
+
+import Prelude
+
+import Vervis.Foundation
+import Vervis.Model
+import Vervis.Model.Ident (shr2text)
+import Vervis.Settings (widgetFile)
+
+sharerLinkW :: Sharer -> Widget
+sharerLinkW sharer = $(widgetFile "sharer-link")
+

src/Vervis/Widget/Repo.hs

@@ -28,9 +28,10 @@ import qualified Data.Text as T (take)
 
 import Vervis.Changes
 import Vervis.Foundation
+import Vervis.Model.Ident
 import Vervis.Settings (widgetFile)
 
-refSelectW :: Text -> Text -> Set Text -> Set Text -> Widget
+refSelectW :: ShrIdent -> RpIdent -> Set Text -> Set Text -> Widget
 refSelectW shar repo branches tags = $(widgetFile "repo/widget/ref-select")
 
 changesW :: Foldable f => f LogEntry -> Widget

templates/discussion/widget/message.hamlet

@@ -12,9 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
-<div>
-  <a href=@{PersonR $ sharerIdent shr}>
-    #{fromMaybe (sharerIdent shr) $ sharerName shr}
+^{sharerLinkW shr}
 <div>
   #{showTime $ messageCreated msg}
 <div>

templates/homepage.hamlet

@@ -32,14 +32,14 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
   $forall (sharer, mproj, repo, vcs, ago) <- rows
     <tr>
       <td>
-        <a href=@{PersonR sharer}>#{sharer}
+        <a href=@{PersonR sharer}>#{shr2text sharer}
       <td>
         $maybe proj <- mproj
-          <a href=@{ProjectR sharer proj}>#{proj}
+          <a href=@{ProjectR sharer proj}>#{prj2text proj}
         $nothing
           (none)
       <td>
-        <a href=@{RepoR sharer repo}>#{repo}
+        <a href=@{RepoR sharer repo}>#{rp2text repo}
       <td>
         $case vcs
           $of VCSDarcs

templates/key/list.hamlet

@@ -12,11 +12,11 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
-<p>These are the SSH keys for user #{user}.
+<p>These are your SSH keys.
 
 <ul>
   $forall key <- keys
     <li>
-      <a href=@{KeyR user key}>#{key}
+      <a href=@{KeyR key}>#{ky2text key}
   <li>
-    <a href=@{KeyNewR user}>Add new…
+    <a href=@{KeyNewR}>Add new…

templates/key/new.hamlet

@@ -14,6 +14,6 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
 Enter the details and click "Submit" to add a new SSH key.
 
-<form method=POST action=@{KeysR user} enctype=#{enctype}>
+<form method=POST action=@{KeysR} enctype=#{enctype}>
   ^{widget}
   <input type=submit>

templates/key/one.hamlet

@@ -13,7 +13,7 @@ $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
 <p>
-  <form method=POST action=@{KeyR user tag}>
+  <form method=POST action=@{KeyR tag}>
     <input type=hidden name=_method value=DELETE>
     <input type=submit value="Delete this key">
 

templates/people.hamlet

@@ -18,4 +18,4 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 <ul>
   $forall Value ident <- people
     <li>
-      <a href=@{PersonR ident}>#{ident}
+      <a href=@{PersonR ident}>#{shr2text ident}

templates/personal-overview.hamlet

@@ -22,11 +22,11 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 <ul>
   $forall project <- projects
     <li>
-      <a href=@{ProjectR ident project}>#{project}
+      <a href=@{ProjectR ident project}>#{prj2text project}
   <li>
     <a href=@{ProjectNewR ident}>Create new…
 
 <h2>SSH Keys
 
 <p>
-  See <a href=@{KeysR ident}>keys</a>.
+  See <a href=@{KeysR}>keys</a>.

templates/project/list.hamlet

@@ -12,9 +12,9 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
-<p>These are projects shared by #{ident}.
+<p>These are projects shared by #{shr2text ident}.
 
 <ul>
   $forall E.Value project <- projects
     <li>
-      <a href=@{ProjectR ident project}>#{project}
+      <a href=@{ProjectR ident project}>#{prj2text project}

templates/project/one.hamlet

@@ -12,7 +12,9 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
-<p>This is the project page for <b>#{proj}</b>, shared by <b>#{shar}</b>.
+<p>
+  This is the project page for <b>#{prj2text proj}</b>, shared by
+  <b>#{shr2text shar}</b>.
 
 <ul>
   <li>
@@ -35,7 +37,8 @@ $else
     $forall Entity _ repository <- repos
       <tr>
         <td>
-          <a href=@{RepoR shar $ repoIdent repository}>#{repoIdent repository}
+          <a href=@{RepoR shar $ repoIdent repository}>
+            #{rp2text $ repoIdent repository}
         <td>
           $case repoVcs repository
             $of VCSDarcs

templates/repo/list.hamlet

@@ -12,11 +12,11 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
 $# with this software. If not, see
 $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
-<p>These are the repositories shared by #{user}.
+<p>These are the repositories shared by #{shr2text user}.
 
 <ul>
   $forall Value repo <- repos
     <li>
-      <a href=@{RepoR user repo}>#{repo}
+      <a href=@{RepoR user repo}>#{rp2text repo}
   <li>
     <a href=@{RepoNewR user}>Create new…

templates/sharer-link.hamlet

@@ -0,0 +1,19 @@
+$# This file is part of Vervis.
+$#
+$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+$#
+$# ♡ Copying is an act of love. Please copy, reuse and share.
+$#
+$# The author(s) have dedicated all copyright and related and neighboring
+$# rights to this software to the public domain worldwide. This software is
+$# distributed without any warranty.
+$#
+$# You should have received a copy of the CC0 Public Domain Dedication along
+$# with this software. If not, see
+$# <http://creativecommons.org/publicdomain/zero/1.0/>.
+
+<a href=@{PersonR $ sharerIdent sharer}>
+  $maybe name <- sharerName sharer
+    #{name}
+  $nothing
+    #{shr2text $ sharerIdent sharer}

templates/ticket/list.hamlet

@@ -26,13 +26,13 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
     <th>Title
     <th>Done
   $forall
-  (Value number, Value authorIdent, Value mAuthorName, Value title, Value done)
+  (Value number, Entity _ author, Value title, Value done)
   <- rows
     <tr>
       <td>
         <a href=@{TicketR shar proj number}>#{number}
       <td>
-        <a href=@{PersonR authorIdent}>#{fromMaybe authorIdent mAuthorName}
+        ^{sharerLinkW author}
       <td>
         <a href=@{TicketR shar proj number}>#{title}
       <td>

templates/ticket/one.hamlet

@@ -21,13 +21,13 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
 <p>
   Created on #{formatTime defaultTimeLocale "%F" $ ticketCreated ticket} by
-  #{fromMaybe (sharerIdent author) $ sharerName author}
+  ^{sharerLinkW author}
 
 <p>
   Status:
   $if ticketDone ticket
     Closed on #{formatTime defaultTimeLocale "%F" $ ticketClosed ticket} by
-    #{fromMaybe (sharerIdent closer) $ sharerName closer}
+    ^{sharerLinkW closer}
   $else
     Open
 

vervis.cabal

@@ -47,6 +47,7 @@ library
                        Data.Binary.Local
                        Data.ByteString.Char8.Local
                        Data.ByteString.Local
+                       Data.CaseInsensitive.Local
                        Data.Char.Local
                        Data.Either.Local
                        Data.EventTime.Local
@@ -64,7 +65,9 @@ library
                        Database.Persist.Class.Local
                        Database.Persist.Sql.Local
                        Development.DarcsRev
+                       Formatting.CaseInsensitive
                        Network.SSH.Local
+                       Text.Blaze.Local
                        Text.FilePath.Local
                        Text.Jasmine.Local
                        Web.PathPieces.Local
@@ -86,6 +89,7 @@ library
                        Vervis.Form.Project
                        Vervis.Form.Repo
                        Vervis.Form.Ticket
+                       Vervis.Formatting
                        Vervis.Foundation
                        Vervis.Git
                        Vervis.GitOld
@@ -118,6 +122,7 @@ library
                        Vervis.TicketFilter
                        Vervis.Widget
                        Vervis.Widget.Discussion
+                       Vervis.Widget.Person
                        Vervis.Widget.Repo
   -- other-modules:       
   default-extensions:  TemplateHaskell