Make minimal Yesod app that returns main view as an HTML table

src/Vervis/Persist.hs

@@ -29,6 +29,8 @@ 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 ((^.), (&&.), (==.))
@@ -36,6 +38,7 @@ 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
@@ -88,37 +91,24 @@ PersonInGroup
 
 |]
 
-mainViewQuery :: IO ()
-mainViewQuery = runSqlite ":memory:" $ do
-    runMigration migrateAll
+data MainView = MainView ConnectionPool
 
-    --create some sharers
-    cindyId <- insert $ Sharer "cindy" Nothing
-    bobId <- insert $ Sharer "bob" Nothing
-    aliceId <- insert $ Sharer "alice" Nothing
+mkYesod "MainView" [parseRoutes|
+/ HomeR GET
+|]
 
-    --create some projects
-    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
+instance Yesod MainView
 
-    --create some repos
-    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
+instance YesodPersist MainView where
+    type YesodPersistBackend MainView = SqlBackend
 
+    runDB action = do
+        MainView pool <- getYesod
+        runSqlPool action pool
+
+getHomeR :: Handler Html
+getHomeR = do
+    rows <- runDB $ do
         repos <- E.select $ E.from $ \ (sharer, project, repo) -> do
             E.where_ $
                 project ^. ProjectSharer ==. sharer ^. SharerId &&.
@@ -133,7 +123,7 @@ mainViewQuery = runSqlite ":memory:" $ do
                 , project ^. ProjectIdent
                 , repo ^. RepoIdent
                 )
-    rows <- liftIO $ forM repos $ \ (E.Value sharer, E.Value project, E.Value repo) -> do
+        liftIO $ forM repos $ \ (E.Value sharer, E.Value project, E.Value repo) -> do
             let path =
                     T.unpack $
                     T.intercalate "/"
@@ -146,4 +136,49 @@ mainViewQuery = runSqlite ":memory:" $ do
             ago <- timeAgo dt
             return (sharer, project, repo, T.pack ago)
 
-    liftIO $ mapM_ print rows
+    defaultLayout
+        [whamlet|
+            <table>
+                $forall (sharer, proj, repo, ago) <- rows
+                    <tr>
+                        <td>#{sharer}
+                        <td>#{proj}
+                        <td>#{repo}
+                        <td>#{ago}
+        |]
+
+openConnectionCount :: Int
+openConnectionCount = 10
+
+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

vervis.cabal

@@ -44,13 +44,17 @@ library
                      , json-state
                      , hashable
                      , hourglass
+                     , monad-logger
                      , persistent
                      , persistent-sqlite
                      , persistent-template
+                     , resourcet
                      , text                 >=1
                      , time-units
                      , transformers         >=0.4.2
                      , unordered-containers >=0.2.5
+                     , yesod
+                     , yesod-persistent
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall