Experimental changes to Vervis.
Clone
HTTPS:
darcs clone https://vervis.peers.community/repos/KrXYo
SSH:
darcs clone USERNAME@vervis.peers.community:KrXYo
Tags
TODO
Persist.hs
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | {- 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/>.
-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Vervis.Persist
--(
--)
where
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Resource (runResourceT)
import Control.Monad.Logger (runStderrLoggingT)
import Data.Text (Text)
import Data.Traversable (forM)
import Database.Esqueleto ((^.), (&&.), (==.))
import Database.Persist hiding ((==.))
import Database.Persist.Sqlite hiding ((==.))
import Database.Persist.TH
import Vervis.Git
import Yesod hiding ((==.))
import qualified Data.Text as T
import qualified Database.Esqueleto as E
getHomeR :: Handler Html
getHomeR = do
rows <- runDB $ do
repos <- E.select $ E.from $ \ (sharer, project, repo) -> do
E.where_ $
project ^. ProjectSharer ==. sharer ^. SharerId &&.
repo ^. RepoProject ==. project ^. ProjectId
E.orderBy
[ E.asc $ sharer ^. SharerIdent
, E.asc $ project ^. ProjectIdent
, E.asc $ repo ^. RepoIdent
]
return
( sharer ^. SharerIdent
, project ^. ProjectIdent
, repo ^. RepoIdent
)
liftIO $ forM repos $ \ (E.Value sharer, E.Value project, E.Value repo) -> do
let path =
T.unpack $
T.intercalate "/"
[ "state2"
, sharer
, project
, repo
]
dt <- lastChange path
ago <- timeAgo dt
return (sharer, project, repo, T.pack ago)
mainView :: IO ()
mainView =
runStderrLoggingT $
withSqlitePool "test.db3" openConnectionCount $
\ pool -> liftIO $ do
runResourceT $ flip runSqlPool pool $ do
runMigration migrateAll
cindyId <- insert $ Sharer "cindy" Nothing
bobId <- insert $ Sharer "bob" Nothing
aliceId <- insert $ Sharer "alice" Nothing
proj4Id <- insert $ Project "proj4" cindyId Nothing Nothing
proj2Id <- insert $ Project "proj2" aliceId Nothing Nothing
proj6Id <- insert $ Project "proj6" cindyId Nothing Nothing
proj3Id <- insert $ Project "proj3" bobId Nothing Nothing
proj5Id <- insert $ Project "proj5" cindyId Nothing Nothing
proj1Id <- insert $ Project "proj1" aliceId Nothing Nothing
insert_ $ Repo "repo8" proj5Id Nothing Nothing
insert_ $ Repo "repo1" proj1Id Nothing Nothing
insert_ $ Repo "repo6" proj4Id Nothing Nothing
insert_ $ Repo "repo3" proj3Id Nothing Nothing
insert_ $ Repo "repo4" proj3Id Nothing Nothing
insert_ $ Repo "repo10" proj6Id Nothing Nothing
insert_ $ Repo "repo5" proj4Id Nothing Nothing
insert_ $ Repo "repo7" proj5Id Nothing Nothing
insert_ $ Repo "repo2" proj2Id Nothing Nothing
insert_ $ Repo "repo9" proj5Id Nothing Nothing
insert_ $ Repo "repo11" proj6Id Nothing Nothing
insert_ $ Repo "repo12" proj6Id Nothing Nothing
warp 3000 $ MainView pool
|