{- This file is part of Vervis. - - Written in 2016, 2019 by fr33domlover . - - ♡ 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 - . -} module Vervis.Handler.Home ( getHomeR ) where import Database.Esqueleto hiding ((==.)) import Yesod.Auth.Account (newAccountR) import Data.Time.Clock import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Traversable import Database.Persist import Time.Types (Elapsed (..), Seconds (..)) import Yesod.Auth import Yesod.Core import Yesod.Persist.Core import qualified Database.Esqueleto as E ((==.)) import Data.EventTime.Local import Vervis.Darcs import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Repo import Vervis.Path import Vervis.Settings import qualified Vervis.Git as G import qualified Vervis.Darcs as D intro :: Handler Html intro = do rows <- do repos <- runDB $ select $ from $ \ (repo `LeftOuterJoin` project `InnerJoin` sharer) -> do on $ repo ^. RepoSharer E.==. sharer ^. SharerId on $ repo ^. RepoProject E.==. project ?. ProjectId orderBy [ asc $ sharer ^. SharerIdent , asc $ project ?. ProjectIdent , asc $ repo ^. RepoIdent ] return ( sharer ^. SharerIdent , project ?. ProjectIdent , repo ^. RepoIdent , repo ^. RepoVcs ) now <- liftIO getCurrentTime forM repos $ \ (Value sharer, Value mproj, Value repo, Value vcs) -> do path <- askRepoDir sharer repo mlast <- case vcs of VCSDarcs -> liftIO $ D.lastChange path now VCSGit -> do mt <- liftIO $ G.lastCommitTime path return $ Just $ case mt of Nothing -> Never Just t -> intervalToEventTime $ FriendlyConvert $ now `diffUTCTime` t return (sharer, mproj, repo, vcs, mlast) defaultLayout $ do setTitle "Welcome to Vervis!" $(widgetFile "homepage") personalOverview :: Entity Person -> Handler Html personalOverview (Entity _pid person) = do (ident, projects) <- runDB $ do let sid = personIdent person sharer <- get404 sid projs <- selectList [ProjectSharer ==. sid] [Asc ProjectIdent] let pi (Entity _ proj) = projectIdent proj return (sharerIdent sharer, map pi projs) defaultLayout $ do setTitle "Vervis > Overview" $(widgetFile "personal-overview") getHomeR :: Handler Html getHomeR = do mp <- maybeAuth case mp of Just p -> personalOverview p Nothing -> intro