Experimental changes to Vervis.

[[ 🗃 ^KrXYo vervis ]] :: [📥 Inbox] [📤 Outbox] [🐤 Followers] [🤝 Collaborators] [🛠 Changes]

Clone

HTTPS: darcs clone https://vervis.peers.community/repos/KrXYo

SSH: darcs clone USERNAME@vervis.peers.community:KrXYo

Tags

TODO

src / Vervis / Field /

Workflow.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121

{- 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.Workflow
    ( newWorkflowIdentField
    , newFieldIdentField
    , newEnumIdentField
    , newCtorNameField
    )
where

import Vervis.Import hiding ((==.))

import Data.Char (isDigit, isAlphaNum)
import Data.Char.Local (isAsciiLetter)
import Data.Text (split)
import Database.Esqueleto

import Vervis.Model.Ident

checkTemplate :: Field Handler Text -> Field Handler Text
checkTemplate =
    let charOk c = isAsciiLetter c || isDigit c
        wordOk w = (not . null) w && all charOk w
        identOk t = (not . null) t && all wordOk (split (== '-') t)
        msg :: Text
        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

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
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 . null) 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
[See repo JSON]