forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Field enums aren't useful if you can't define values

Browse source
This commit is contained in:
fr33domlover 2016-08-08 17:05:09 +00:00
parent 7ee28b97d2
commit 17643c6d49
12 changed files with 202 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
config/models
View file

@ -180,6 +180,13 @@ WorkflowFieldEnum
UniqueWorkflowFieldEnum workflow ident
WorkflowFieldEnumCtor
enum WorkflowFieldEnumId
name Text
desc Text Maybe
UniqueWorkflowFieldEnumCtor enum name
Ticket
project ProjectId
number Int

3
config/routes
View file

@ -105,6 +105,9 @@
/s/#ShrIdent/w/#WflIdent/e WorkflowEnumsR GET POST
/s/#ShrIdent/w/#WflIdent/e/!new WorkflowEnumNewR GET
/s/#ShrIdent/w/#WflIdent/e/#EnmIdent WorkflowEnumR GET DELETE POST
/s/#ShrIdent/w/#WflIdent/e/#EnmIdent/c WorkflowEnumCtorsR GET POST
/s/#ShrIdent/w/#WflIdent/e/#EnmIdent/c/!new WorkflowEnumCtorNewR GET
/s/#ShrIdent/w/#WflIdent/e/#EnmIdent/c/#Text WorkflowEnumCtorR PUT DELETE POST
/s/#ShrIdent/p/#PrjIdent/t TicketsR GET POST
/s/#ShrIdent/p/#PrjIdent/t/!tree TicketTreeR GET

25
src/Vervis/Field/Workflow.hs
View file

@ -17,12 +17,13 @@ module Vervis.Field.Workflow
( newWorkflowIdentField
, newFieldIdentField
, newEnumIdentField
, newCtorNameField
)
where
import Vervis.Import hiding ((==.))
import Data.Char (isDigit)
import Data.Char (isDigit, isAlphaNum)
import Data.Char.Local (isAsciiLetter)
import Data.Text (split)
import Database.Esqueleto
@ -96,3 +97,25 @@ 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

15
src/Vervis/Form/Workflow.hs
View file

@ -20,6 +20,8 @@ module Vervis.Form.Workflow
, newFieldForm
, NewEnum (..)
, newEnumForm
, NewCtor (..)
, newCtorForm
)
where
@ -80,3 +82,16 @@ newEnumAForm wid = NewEnum
newEnumForm :: WorkflowId -> Form NewEnum
newEnumForm wid = renderDivs $ newEnumAForm wid
data NewCtor = NewCtor
{ ncName :: Text
, ncDesc :: Maybe Text
}
newCtorAForm :: WorkflowFieldEnumId -> AForm Handler NewCtor
newCtorAForm eid = NewCtor
<$> areq (newCtorNameField eid) "name*" Nothing
<*> aopt textField "Description" Nothing
newCtorForm :: WorkflowFieldEnumId -> Form NewCtor
newCtorForm eid = renderDivs $ newCtorAForm eid

16
src/Vervis/Foundation.hs
View file

@ -174,6 +174,9 @@ instance Yesod App where
(WorkflowEnumsR shr _ , _ ) -> personOrGroupAdmin shr
(WorkflowEnumNewR shr _ , _ ) -> personOrGroupAdmin shr
(WorkflowEnumR shr _ _ , _ ) -> personOrGroupAdmin shr
(WorkflowEnumCtorsR shr _ _ , _ ) -> personOrGroupAdmin shr
(WorkflowEnumCtorNewR shr _ _ , _ ) -> personOrGroupAdmin shr
(WorkflowEnumCtorR shr _ _ _ , _ ) -> personOrGroupAdmin shr
(TicketsR shar _ , True) -> person shar
(TicketNewR _ _ , _ ) -> personAny
@ -489,9 +492,20 @@ instance YesodBreadcrumbs App where
WorkflowEnumNewR shr wfl -> ( "New"
, Just $ WorkflowEnumsR shr wfl
)
WorkflowEnumR shr wfl fld -> ( enm2text fld
WorkflowEnumR shr wfl enm -> ( enm2text enm
, Just $ WorkflowEnumsR shr wfl
)
WorkflowEnumCtorsR shr wfl enm -> ( "Ctors"
, Just $ WorkflowEnumR shr wfl enm
)
WorkflowEnumCtorNewR shr wfl enm -> ( "New"
, Just $
WorkflowEnumCtorsR shr wfl enm
)
WorkflowEnumCtorR shr wfl enm c -> ( c
, Just $
WorkflowEnumCtorsR shr wfl enm
)
TicketsR shar proj -> ( "Tickets"
, Just $ ProjectR shar proj

73
src/Vervis/Handler/Workflow.hs
View file

@ -35,6 +35,13 @@ module Vervis.Handler.Workflow
, getWorkflowEnumR
, deleteWorkflowEnumR
, postWorkflowEnumR
-- * Ctor
, getWorkflowEnumCtorsR
, postWorkflowEnumCtorsR
, getWorkflowEnumCtorNewR
, putWorkflowEnumCtorR
, deleteWorkflowEnumCtorR
, postWorkflowEnumCtorR
)
where
@ -247,3 +254,69 @@ postWorkflowEnumR shr wfl enm = do
case mmethod of
Just "DELETE" -> deleteWorkflowEnumR shr wfl enm
_ -> notFound
-------------------------------------------------------------------------------
-- Ctor
-------------------------------------------------------------------------------
getWorkflowEnumCtorsR :: ShrIdent -> WflIdent -> EnmIdent -> Handler Html
getWorkflowEnumCtorsR shr wfl enm = do
cs <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
Entity eid _ <- getBy404 $ UniqueWorkflowFieldEnum wid enm
selectList [WorkflowFieldEnumCtorEnum ==. eid] []
defaultLayout $(widgetFile "workflow/enum/ctor/list")
postWorkflowEnumCtorsR :: ShrIdent -> WflIdent -> EnmIdent -> Handler Html
postWorkflowEnumCtorsR shr wfl enm = do
eid <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
Entity eid _ <- getBy404 $ UniqueWorkflowFieldEnum wid enm
return eid
((result, widget), etype) <- runFormPost $ newCtorForm eid
case result of
FormSuccess nc -> do
let ctor = WorkflowFieldEnumCtor
{ workflowFieldEnumCtorEnum = eid
, workflowFieldEnumCtorName = ncName nc
, workflowFieldEnumCtorDesc = ncDesc nc
}
runDB $ insert_ ctor
setMessage "Workflow field enum ctor added."
redirect $ WorkflowEnumCtorsR shr wfl enm
FormMissing -> do
setMessage "Field(s) missing"
defaultLayout $(widgetFile "workflow/enum/ctor/new")
FormFailure _l -> do
setMessage "Workflow field enum ctor creation failed, see below"
defaultLayout $(widgetFile "workflow/enum/ctor/new")
getWorkflowEnumCtorNewR :: ShrIdent -> WflIdent -> EnmIdent -> Handler Html
getWorkflowEnumCtorNewR shr wfl enm = do
eid <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
Entity eid _ <- getBy404 $ UniqueWorkflowFieldEnum wid enm
return eid
((_result, widget), etype) <- runFormPost $ newCtorForm eid
defaultLayout $(widgetFile "workflow/enum/ctor/new")
putWorkflowEnumCtorR
:: ShrIdent -> WflIdent -> EnmIdent -> Text -> Handler Html
putWorkflowEnumCtorR shr wfl enm ctor = error "Not implemented yet"
deleteWorkflowEnumCtorR
:: ShrIdent -> WflIdent -> EnmIdent -> Text -> Handler Html
deleteWorkflowEnumCtorR shr wfl enm ctor =
error "Not implemented, not sure whether to allow it"
postWorkflowEnumCtorR
:: ShrIdent -> WflIdent -> EnmIdent -> Text -> Handler Html
postWorkflowEnumCtorR shr wfl enm ctor = do
mmethod <- lookupPostParam "_method"
case mmethod of
Just "PUT" -> putWorkflowEnumCtorR shr wfl enm ctor
Just "DELETE" -> deleteWorkflowEnumCtorR shr wfl enm ctor
_ -> notFound

33
templates/workflow/enum/ctor/list.hamlet Normal file
View file

@ -0,0 +1,33 @@
$# 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/>.
<p>
<a href=@{WorkflowEnumCtorNewR shr wfl enm}>
Add…
<ul>
$forall Entity _cid c <- cs
$with name <- workflowFieldEnumCtorName c
<li>
<div>
#{name}
<div>
#{fromMaybe "(none)" $ workflowFieldEnumCtorDesc c}
<div>
<form method="POST" action=@{WorkflowEnumCtorR shr wfl enm name}>
<input type="hidden" name="_method" value="PUT">
<input type="submit" value="Edit this ctor">
<form method="POST" action=@{WorkflowEnumCtorR shr wfl enm name}>
<input type="hidden" name="_method" value="DELETE">
<input type="submit" value="Delete this ctor">

17
templates/workflow/enum/ctor/new.hamlet Normal file
View file

@ -0,0 +1,17 @@
$# 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/>.
<form method="POST" action=@{WorkflowEnumCtorsR shr wfl enm} enctype=#{etype}>
^{widget}
<input type="submit">

4
templates/workflow/enum/list.hamlet
View file

@ -12,6 +12,10 @@ $# 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/>.
<p>
<a href=@{WorkflowEnumNewR shr wfl}>
Add…
<ul>
$forall Entity _eid e <- es
<li>

3
templates/workflow/enum/one.hamlet
View file

@ -22,3 +22,6 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
Display name: #{workflowFieldEnumName e}
<li>
Description: #{fromMaybe "(none)" $ workflowFieldEnumDesc e}
<li>
<a href=@{WorkflowEnumCtorsR shr wfl enm}>
Ctors

4
templates/workflow/field/list.hamlet
View file

@ -12,6 +12,10 @@ $# 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/>.
<p>
<a href=@{WorkflowFieldNewR shr wfl}>
Add…
<ul>
$forall Entity _fid f <- fs
<li>

4
templates/workflow/list.hamlet
View file

@ -12,6 +12,10 @@ $# 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/>.
<p>
<a href=@{WorkflowNewR shr}>
Add…
<ul>
$forall Entity _wid w <- ws
<li>