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

added create category handler. unfinished yet.

parent 143696db
......@@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: e0ee5a254ef7241a3e87a0539079ef691434a9dc90751c9daf2b968912c9042c
-- hash: 40064a7405d71b43fd66e1b51719d76bf74d9ac7f26fbaadf3eed1ba1b13173d
name: Cirkeltrek
version: 0.0.0
......@@ -12,11 +12,16 @@ cabal-version: >= 1.10
library
exposed-modules:
Application
DBOp.CRUDCategory
Flux.AdmCategory
Foundation
Home
Handler.Adm.Category
Handler.Home
Handler.Profile
Import
Import.NoFoundation
Model
Model.Grouping
Profile
Settings
Settings.StaticFiles
other-modules:
......
......@@ -8,9 +8,8 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Application where
import ClassyPrelude.Yesod
import Import hiding (Settings (..))
import Control.Monad
import Control.Monad.Logger
import Database.Persist.Postgresql
import Foundation
......@@ -20,18 +19,15 @@ import Network.Wai (Middleware)
import Network.Wai.Handler.Warp
import Network.Wai.Middleware.RequestLogger
import System.Log.FastLogger
import Yesod.Auth
import Yesod.Core
import Yesod.Core.Types (loggerSet)
import Yesod.Default.Config2
import Yesod.Static
import Home
import Profile
import Model
import Settings (ApplicationSettings (..),
configSettingsYmlValue)
import Handler.Home
import Handler.Profile
import Handler.Adm.Category
mkYesodDispatch "App" resourcesApp
makeFoundation :: ApplicationSettings -> IO App
......
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module DBOp.CRUDCategory where
import Import
insertCategory ::
(BaseBackend backend ~ SqlBackend, PersistStoreWrite backend, MonadIO m)
=> Text
-> ReaderT backend m (Key Categories)
insertCategory catname = do
insert $ Categories catname
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Flux.AdmCategory where
import Import
import DBOp.CRUDCategory
createCategory Administrator catname =
liftHandler $ runDB $ insertCategory catname
createCategory _ _ =
permissionDenied "You're not allowed to do this (category creation)."
......@@ -8,25 +8,19 @@
module Foundation where
import ClassyPrelude.Yesod
import Import.NoFoundation hiding ((&&.), (==.))
import Database.Persist.Sql
import Network.HTTP.Client
import Database.Esqueleto
import Text.Hamlet
import Text.Jasmine
import Yesod.Auth
import Yesod.Auth.HashDB
import Yesod.Auth.Message
import Yesod.Core
import Yesod.Core.Types
import Yesod.Default.Util
import Yesod.Form
import Yesod.Static
import Model
import Settings
import Settings.StaticFiles
data App = App
{ appSettings :: ApplicationSettings
, appConnectionPool :: ConnectionPool
......@@ -38,10 +32,11 @@ data App = App
mkYesodData
"App"
[parseRoutes|
/ HomeR GET
/static StaticR Static appStatic
/auth SigninR Auth getAuth
/profile ProfileR GET
/ HomeR GET
/static StaticR Static appStatic
/auth SigninR Auth getAuth
/profile ProfileR GET
/admin/category AdmCategoryR GET
|]
type Form a = Html -> MForm (HandlerFor App) (FormResult a, Widget)
......@@ -82,7 +77,7 @@ instance Yesod App where
isAuthorized (SigninR _) _ = return Authorized
isAuthorized HomeR _ = return Authorized
isAuthorized (StaticR _) _ = return Authorized
isAuthorized ProfileR _ = isLoggedIn
isAuthorized _ _ = isLoggedIn
isLoggedIn :: Handler AuthResult
isLoggedIn = do
......@@ -91,6 +86,24 @@ isLoggedIn = do
Nothing -> return $ Unauthorized "login please"
Just _ -> return Authorized
getUserAndGrouping :: Handler (Maybe (Key Users, Text, Grouping))
getUserAndGrouping = do
maut <- maybeAuth
case maut of
Nothing -> return Nothing
Just (Entity uid user) -> do
[gro] <-
liftHandler $
runDB $
select $
from $ \(group, user) -> do
where_
(user ^. UsersId ==. val uid
&&. group ^. GroupsId ==. user ^. UsersGroupId)
limit 1
return (group ^. GroupsGrouping)
return $ Just (uid, usersUsername user, unValue gro)
instance YesodPersist App where
type YesodPersistBackend App = SqlBackend
runDB action = do
......
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Handler.Adm.Category where
import Import
import Database.Esqueleto
import Flux.AdmCategory
data CreateCategoryForm = CreateCategoryForm
{ createCategoryFormName :: Text
} deriving (Show)
createCategoryForm :: Form CreateCategoryForm
createCategoryForm =
renderDivs $ CreateCategoryForm <$> areq textField "Category Name" Nothing
data SelectCategoryForm = SelectCategoryForm
{ selectCategoryFormId :: Int64
} deriving (Show)
selectCategoryForm :: [Entity Categories] -> Form SelectCategoryForm
selectCategoryForm cats =
renderDivs $
SelectCategoryForm <$> areq (selectFieldList catlist) "Category" Nothing
where
catlist :: [(Text, Int64)]
catlist =
map (\(Entity cid (Categories name)) -> (name, fromSqlKey $ cid)) cats
getAdmCategoryR :: Handler Html
getAdmCategoryR = do
(widc, enctc) <- generateFormPost createCategoryForm
defaultLayout
[whamlet|
<form enctype=#{enctc}>
^{widc}
<input .button-primary value=create type=submit>
|]
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Home where
module Handler.Home where
import Foundation
import Yesod.Core
import Import
getHomeR :: Handler Html
getHomeR =
......
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Profile where
module Handler.Profile where
import Foundation
import Import
import Database.Persist.Sql
import Yesod.Auth
import Yesod.Core
import Model
getProfileR :: Handler Html
getProfileR = do
......
module Import
( module Import
) where
import Foundation as Import
import Import.NoFoundation as Import
{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Import.NoFoundation
( module Import
) where
import ClassyPrelude.Yesod as Import
import Yesod.Auth as Import
import Yesod.Core.Types as Import (loggerSet)
import Yesod.Default.Config2 as Import
import Model as Import
import Model.Grouping as Import
import Settings as Import
import Settings.StaticFiles as Import
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