vervis/src/Vervis/Persist.hs

{- 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 Data.Text (Text)
import Database.Esqueleto ((^.), (&&.), (==.))
import Database.Persist hiding ((==.))
import Database.Persist.Sqlite hiding ((==.))
import Database.Persist.TH

import qualified Database.Esqueleto as E

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|

IrcChannel
    network Text
    name    Text

Sharer
    ident Text       --CI
    name  Text Maybe

    UniqueIdent ident

Person
    ident SharerId
    hash  Text     Maybe
    email Text     Maybe

    UniquePersonIdent ident

Group
    ident SharerId

    UniqueGroupIdent ident

Project
    ident  Text       --CI
    sharer SharerId
    name   Text     Maybe
    desc   Text     Maybe

    UniqueProject ident sharer

Repo
    ident   Text       --CI
    project ProjectId
    irc     IrcChannelId Maybe
    ml      Text         Maybe

    UniqueRepo ident project

PersonInGroup
    person PersonId
    group  GroupId

    UniquePersonInGroup person group

|]

mainViewQuery :: IO ()
mainViewQuery = runSqlite ":memory:" $ do
    runMigration migrateAll

    --create some sharers
    cindyId <- insert $ Sharer "cindy" Nothing
    bobId <- insert $ Sharer "bob" Nothing
    aliceId <- insert $ Sharer "alice" Nothing

    --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

    --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

    rows <- 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 $ mapM_ print rows