mirror of
https://code.naskya.net/repos/ndqEd
synced 2025-03-20 15:14:54 +09:00
60 lines
2.3 KiB
Haskell
60 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.Repo
|
|||
|
|
( mkIdentField
|
|||
|
|
)
|
|||
|
|
where
|
|||
|
|
|
|||
|
|
import Vervis.Import hiding ((==.))
|
|||
|
|
|
|||
|
|
import Data.Char (isDigit)
|
|||
|
|
import Data.Char.Local (isAsciiLetter)
|
|||
|
|
import Data.Text (split)
|
|||
|
|
import Database.Esqueleto hiding (isNothing)
|
|||
|
|
|
|||
|
|
checkIdentTemplate :: Field Handler Text -> Field Handler Text
|
|||
|
|
checkIdentTemplate =
|
|||
|
|
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 repo 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
|
|||
|
|
|
|||
|
|
-- | Make sure the repo identifier is unique. The DB schema only requires that
|
|||
|
|
-- a repo identifier is unique within its project, but I'd like to enforce a
|
|||
|
|
-- stronger condition: A repo identifier must be unique within its sharer's
|
|||
|
|
-- repos. I'm not yet sure it's a good thing, but it's much easier to maintain
|
|||
|
|
-- now and relax later, than relax now and have problems later when there are
|
|||
|
|
-- already conflicting names.
|
|||
|
|
checkIdentUnique :: SharerId -> Field Handler Text -> Field Handler Text
|
|||
|
|
checkIdentUnique sid = checkM $ \ ident -> do
|
|||
|
|
l <- runDB $ select $ from $ \ (project, repo) -> do
|
|||
|
|
where_ $
|
|||
|
|
project ^. ProjectSharer ==. val sid &&.
|
|||
|
|
repo ^. RepoProject ==. project ^. ProjectId &&.
|
|||
|
|
repo ^. RepoIdent ==. val ident
|
|||
|
|
limit 1
|
|||
|
|
return ()
|
|||
|
|
return $ if isNothing $ listToMaybe l
|
|||
|
|
then Right ident
|
|||
|
|
else Left ("You already have a repo by that name" :: Text)
|
|||
|
|
|
|||
|
|
mkIdentField :: SharerId -> Field Handler Text
|
|||
|
|
mkIdentField sid = checkIdentUnique sid . checkIdentTemplate $ textField
|