1
0
Fork 0
mirror of https://code.naskya.net/repos/ndqEd synced 2025-02-18 01:27:18 +09:00
vervis/src/Vervis/Field/Workflow.hs

128 lines
4.4 KiB
Haskell
Raw Normal View History

{- This file is part of Vervis.
-
- Written in 2016, 2019 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.Workflow
( newWorkflowIdentField
2016-08-08 14:01:06 +00:00
, newFieldIdentField
, newEnumIdentField
, newCtorNameField
)
where
import Data.Char (isDigit, isAlphaNum)
import Data.Char.Local (isAsciiLetter)
import Data.Text (Text)
import Database.Esqueleto
import Yesod.Form.Fields
import Yesod.Form.Functions
import Yesod.Form.Types
import Yesod.Persist.Core
import qualified Data.Text as T
import Vervis.Foundation
import Vervis.Model
2016-08-08 14:01:06 +00:00
import Vervis.Model.Ident
checkTemplate :: Field Handler Text -> Field Handler Text
checkTemplate =
let charOk c = isAsciiLetter c || isDigit c
wordOk w = (not . T.null) w && T.all charOk w
identOk t = (not . T.null) t && all wordOk (T.split (== '-') t)
msg :: Text
2016-08-08 14:01:06 +00:00
msg = "The identifier must be a sequence of one or more words \
\separated by hyphens (-), and each such word may contain \
\ASCII letters and digits."
in checkBool identOk msg
2016-08-08 14:01:06 +00:00
checkWflUniqueCI
:: SharerId -> Field Handler WflIdent -> Field Handler WflIdent
checkWflUniqueCI sid = checkM $ \ wfl -> do
sames <- runDB $ select $ from $ \ workflow -> do
where_ $
workflow ^. WorkflowSharer ==. val sid &&.
lower_ (workflow ^. WorkflowIdent) ==. lower_ (val wfl)
limit 1
return ()
return $ if null sames
then Right wfl
else Left ("You already have a workflow by that name" :: Text)
workflowIdentField :: Field Handler WflIdent
workflowIdentField = convertField text2wfl wfl2text $ checkTemplate textField
newWorkflowIdentField :: SharerId -> Field Handler WflIdent
2016-08-08 14:01:06 +00:00
newWorkflowIdentField sid = checkWflUniqueCI sid workflowIdentField
checkFldUniqueCI
:: WorkflowId -> Field Handler FldIdent -> Field Handler FldIdent
checkFldUniqueCI wid = checkM $ \ fld -> do
sames <- runDB $ select $ from $ \ field -> do
where_ $
field ^. WorkflowFieldWorkflow ==. val wid &&.
lower_ (field ^. WorkflowFieldIdent) ==. lower_ (val fld)
limit 1
return ()
return $ if null sames
then Right fld
else Left ("There is already a field by that name" :: Text)
fieldIdentField :: Field Handler FldIdent
fieldIdentField = convertField text2fld fld2text $ checkTemplate textField
newFieldIdentField :: WorkflowId -> Field Handler FldIdent
newFieldIdentField wid = checkFldUniqueCI wid fieldIdentField
checkEnmUniqueCI
:: WorkflowId -> Field Handler EnmIdent -> Field Handler EnmIdent
checkEnmUniqueCI wid = checkM $ \ enm -> do
sames <- runDB $ select $ from $ \ enum -> do
where_ $
enum ^. WorkflowFieldEnumWorkflow ==. val wid &&.
lower_ (enum ^. WorkflowFieldEnumIdent) ==. lower_ (val enm)
limit 1
return ()
return $ if null sames
then Right enm
else Left ("There is already an enum by that name" :: Text)
enumIdentField :: Field Handler EnmIdent
enumIdentField = convertField text2enm enm2text $ checkTemplate textField
newEnumIdentField :: WorkflowId -> Field Handler EnmIdent
newEnumIdentField wid = checkEnmUniqueCI wid enumIdentField
checkCtorName :: Field Handler Text -> Field Handler Text
checkCtorName =
let charOk c = isAlphaNum c || c == ' '
nameOk t = (not . T.null) t && T.all charOk t
msg :: Text
msg = "The name may contain only letters, digits and spaces."
in checkBool nameOk msg
checkCtorUnique
:: WorkflowFieldEnumId -> Field Handler Text -> Field Handler Text
checkCtorUnique eid = checkM $ \ name -> do
mc <- runDB $ getBy $ UniqueWorkflowFieldEnumCtor eid name
return $ case mc of
Nothing -> Right name
Just _ -> Left ("There is already an enum ctor by that name" :: Text)
ctorNameField :: Field Handler Text
ctorNameField = checkCtorName textField
newCtorNameField :: WorkflowFieldEnumId -> Field Handler Text
newCtorNameField eid = checkCtorUnique eid ctorNameField