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