Commit fe886b3b authored by Ibnu Daru Aji's avatar Ibnu Daru Aji

Added database models and its integration to web app.

parent ec1bf496
......@@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: 08696098b1b731323e73e7ce93701cbb0163a441a1968de5ea78ab37d19644b7
-- hash: ac82d237ef701a1dbc867cec1e99eb5d5bb8ad007265c41dc76968c2c000666f
name: Cirkeltrek
version: 0.0.0
......@@ -14,6 +14,8 @@ library
Application
Foundation
Home
Model
Model.Grouping
Settings
other-modules:
Paths_Cirkeltrek
......
......@@ -3,7 +3,6 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Application where
......@@ -21,6 +20,7 @@ import Yesod.Default.Config2
import Yesod.Static
import Home
import Model
import Settings (ApplicationSettings (..),
configSettingsYmlValue)
......@@ -44,6 +44,7 @@ makeFoundation appSettings = do
createPostgresqlPool
(pgConnStr $ appDatabaseConf appSettings)
(pgPoolSize $ appDatabaseConf appSettings)
runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
return $ mkFoundation pool
warpSettings :: App -> Settings
......
......@@ -57,3 +57,10 @@ instance Yesod App where
^{widget}
|]
withUrlRenderer $(hamletFile "templates/wrapper.hamlet")
instance YesodPersist App where
type YesodPersistBackend App = SqlBackend
runDB action = do
master <- getYesod
runSqlPool action $ appConnectionPool master
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitParams #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Model where
import ClassyPrelude.Yesod
import Database.Persist.TH
import Model.Grouping
share
[mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateAll"]
[persistLowerCase|
Categories
name Text
UniqueCatName name
deriving Show Eq
Forums
categoryId CategoriesId
name Text
descriptions Text Maybe
topicsCount Int default=0
repliesCount Int default=0
lastPost UTCTime Maybe
lastPostId PostsId Maybe
lastPoster Text Maybe
deriving Show Eq
Topics
forumId ForumsId
poster Text
subject Text
repliesCount Int default=0
startTime UTCTime
lastPost UTCTime Maybe
lastPostId PostsId Maybe
lastPoster Text Maybe
isLocked Bool default=false
deriving Show Eq
Posts
topicId TopicsId
number Int
username Text
userId UsersId
time UTCTime
content Text
deriving Show Eq
Groups
grouping Grouping
UniqueGrouping grouping
deriving Show Eq Read
Permissions
groupId GroupsId
permissionName Text
banUser Bool
lockDiscussion Bool
read Bool
reply Bool
createTopic Bool
deriving Show Eq
Users
groupId GroupsId
username Text
email Text
password Text Maybe
joinTime UTCTime
topicsStarted Int default=0
repliesPosted Int default=0
UniqueUsername username
UniqueEmail email
deriving Show Eq
Banneds
username Text
ip Text Maybe
message Text Maybe
executor UsersId
stillInEffect Bool
deriving Show Eq
Reports
postId PostsId
topicId TopicsId
forumId ForumsId
reportedBy UsersId
created UTCTime
message Text
zapped UTCTime Maybe
zappedBy UsersId Maybe
deriving Show Eq
|]
{-# LANGUAGE TemplateHaskell #-}
module Model.Grouping where
import Database.Persist.TH
data Grouping
= Administrator
| Moderator
| Member
| Banned
deriving (Show, Eq, Read, Ord)
derivePersistField "Grouping"
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment