2016-08-08 11:05:19 +00:00
|
|
|
|
{- This file is part of Vervis.
|
|
|
|
|
-
|
2019-06-15 08:24:08 +00:00
|
|
|
|
- Written in 2016, 2019 by fr33domlover <fr33domlover@riseup.net>.
|
2016-08-08 11:05:19 +00:00
|
|
|
|
-
|
|
|
|
|
- ♡ 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
|
2016-08-08 14:48:38 +00:00
|
|
|
|
, newEnumIdentField
|
2016-08-08 17:05:09 +00:00
|
|
|
|
, newCtorNameField
|
2016-08-08 11:05:19 +00:00
|
|
|
|
)
|
|
|
|
|
where
|
|
|
|
|
|
2016-08-08 17:05:09 +00:00
|
|
|
|
import Data.Char (isDigit, isAlphaNum)
|
2016-08-08 11:05:19 +00:00
|
|
|
|
import Data.Char.Local (isAsciiLetter)
|
2019-06-15 08:24:08 +00:00
|
|
|
|
import Data.Text (Text)
|
2016-08-08 11:05:19 +00:00
|
|
|
|
import Database.Esqueleto
|
2019-06-15 08:24:08 +00:00
|
|
|
|
import Yesod.Form.Fields
|
|
|
|
|
import Yesod.Form.Functions
|
|
|
|
|
import Yesod.Form.Types
|
|
|
|
|
import Yesod.Persist.Core
|
|
|
|
|
|
|
|
|
|
import qualified Data.Text as T
|
2016-08-08 11:05:19 +00:00
|
|
|
|
|
2019-06-15 08:24:08 +00:00
|
|
|
|
import Vervis.Foundation
|
|
|
|
|
import Vervis.Model
|
2016-08-08 14:01:06 +00:00
|
|
|
|
import Vervis.Model.Ident
|
2016-08-08 11:05:19 +00:00
|
|
|
|
|
|
|
|
|
checkTemplate :: Field Handler Text -> Field Handler Text
|
|
|
|
|
checkTemplate =
|
|
|
|
|
let charOk c = isAsciiLetter c || isDigit c
|
2019-06-15 08:24:08 +00:00
|
|
|
|
wordOk w = (not . T.null) w && T.all charOk w
|
|
|
|
|
identOk t = (not . T.null) t && all wordOk (T.split (== '-') t)
|
2016-08-08 11:05:19 +00:00
|
|
|
|
msg :: Text
|
2016-08-08 14:01:06 +00:00
|
|
|
|
msg = "The identifier must be a sequence of one or more words \
|
2016-08-08 11:05:19 +00:00
|
|
|
|
\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
|
2016-08-08 11:05:19 +00:00
|
|
|
|
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
|
2016-08-08 14:48:38 +00:00
|
|
|
|
|
|
|
|
|
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
|
2016-08-08 17:05:09 +00:00
|
|
|
|
|
|
|
|
|
checkCtorName :: Field Handler Text -> Field Handler Text
|
|
|
|
|
checkCtorName =
|
|
|
|
|
let charOk c = isAlphaNum c || c == ' '
|
2019-06-15 08:24:08 +00:00
|
|
|
|
nameOk t = (not . T.null) t && T.all charOk t
|
2016-08-08 17:05:09 +00:00
|
|
|
|
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
|