mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-31 05:14:54 +09:00
107 lines
4 KiB
Haskell
107 lines
4 KiB
Haskell
{- 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
|