{- This file is part of Vervis. - - Written in 2016 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 - . -} {-# 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