mirror of
https://code.naskya.net/repos/ndqEd
synced 2025-01-12 08:45:07 +09:00
76 lines
2.3 KiB
Haskell
76 lines
2.3 KiB
Haskell
|
{- 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/>.
|
||
|
|
-}
|
||
|
|
|
||
|
|
module Vervis.Field.Role
|
||
|
|
( newRoleIdentField
|
||
|
|
, newOpField
|
||
|
|
)
|
||
|
|
where
|
||
|
|
|
||
|
|
import Prelude
|
||
|
|
|
||
|
|
-- import Control.Monad (void)
|
||
|
|
-- import Control.Monad.Trans.Maybe
|
||
|
|
-- import Data.Char (isDigit)
|
||
|
|
-- import Data.Maybe (isNothing, isJust)
|
||
|
|
import Data.Text (Text)
|
||
|
|
import Database.Esqueleto
|
||
|
|
import Yesod.Form.Fields (textField, selectField, optionsEnum)
|
||
|
|
import Yesod.Form.Functions (checkM, convertField)
|
||
|
|
import Yesod.Form.Types (Field)
|
||
|
|
import Yesod.Persist.Core (runDB)
|
||
|
|
|
||
|
|
-- import qualified Data.Text as T (null, all, find, split)
|
||
|
|
|
||
|
|
-- import Data.Char.Local (isAsciiLetter)
|
||
|
|
import Vervis.Foundation (Handler, AppDB)
|
||
|
|
import Vervis.Model
|
||
|
|
import Vervis.Model.Ident (RlIdent, rl2text, text2rl)
|
||
|
|
import Vervis.Model.Role
|
||
|
|
|
||
|
|
checkUniqueCI :: PersonId -> Field Handler RlIdent -> Field Handler RlIdent
|
||
|
|
checkUniqueCI pid = checkM $ \ rl -> do
|
||
|
|
sames <- runDB $ select $ from $ \ role -> do
|
||
|
|
where_ $
|
||
|
|
role ^. RolePerson ==. val pid &&.
|
||
|
|
lower_ (role ^. RoleIdent) ==. lower_ (val rl)
|
||
|
|
limit 1
|
||
|
|
return ()
|
||
|
|
return $ if null sames
|
||
|
|
then Right rl
|
||
|
|
else Left ("This role name is already in use" :: Text)
|
||
|
|
|
||
|
|
roleIdentField :: Field Handler RlIdent
|
||
|
|
roleIdentField = convertField text2rl rl2text textField
|
||
|
|
|
||
|
|
newRoleIdentField :: PersonId -> Field Handler RlIdent
|
||
|
|
newRoleIdentField pid = checkUniqueCI pid roleIdentField
|
||
|
|
|
||
|
|
opField :: Field Handler Operation
|
||
|
|
opField = selectField optionsEnum
|
||
|
|
|
||
|
|
checkOpNew
|
||
|
|
:: AppDB RoleId -> Field Handler Operation -> Field Handler Operation
|
||
|
|
checkOpNew getrid = checkM $ \ op -> do
|
||
|
|
ma <- runDB $ do
|
||
|
|
rid <- getrid
|
||
|
|
getBy $ UniqueAccess rid op
|
||
|
|
return $ case ma of
|
||
|
|
Nothing -> Right op
|
||
|
|
Just _ -> Left ("Role already has this operation" :: Text)
|
||
|
|
|
||
|
|
newOpField :: AppDB RoleId -> Field Handler Operation
|
||
|
|
newOpField getrid = checkOpNew getrid opField
|