Add group routes
This commit is contained in:
parent
ac893b6040
commit
bc66463776
21 changed files with 397 additions and 93 deletions
|
@ -21,25 +21,36 @@
|
||||||
/robots.txt RobotsR GET
|
/robots.txt RobotsR GET
|
||||||
|
|
||||||
-- ----------------------------------------------------------------------------
|
-- ----------------------------------------------------------------------------
|
||||||
-- User login
|
-- Current user
|
||||||
-- ----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
/auth AuthR Auth getAuth
|
|
||||||
|
|
||||||
-- ----------------------------------------------------------------------------
|
|
||||||
-- Everything else...
|
|
||||||
-- ----------------------------------------------------------------------------
|
-- ----------------------------------------------------------------------------
|
||||||
|
|
||||||
/ HomeR GET
|
/ HomeR GET
|
||||||
|
|
||||||
/s PeopleR GET POST
|
/auth AuthR Auth getAuth
|
||||||
/s/!new PersonNewR GET
|
|
||||||
/s/#ShrIdent PersonR GET
|
-- ----------------------------------------------------------------------------
|
||||||
|
-- People
|
||||||
|
-- ----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
/s SharersR GET
|
||||||
|
/s/#ShrIdent SharerR GET
|
||||||
|
|
||||||
|
/p PeopleR GET POST
|
||||||
|
/p/!new PersonNewR GET
|
||||||
|
/p/#ShrIdent PersonR GET
|
||||||
|
|
||||||
|
/g GroupsR GET POST
|
||||||
|
/g/!new GroupNewR GET
|
||||||
|
/g/#ShrIdent GroupR GET
|
||||||
|
|
||||||
/k KeysR GET POST
|
/k KeysR GET POST
|
||||||
/k/!new KeyNewR GET
|
/k/!new KeyNewR GET
|
||||||
/k/#KyIdent KeyR GET DELETE POST
|
/k/#KyIdent KeyR GET DELETE POST
|
||||||
|
|
||||||
|
-- ----------------------------------------------------------------------------
|
||||||
|
-- Projects
|
||||||
|
-- ----------------------------------------------------------------------------
|
||||||
|
|
||||||
/s/#ShrIdent/r ReposR GET POST
|
/s/#ShrIdent/r ReposR GET POST
|
||||||
/s/#ShrIdent/r/!new RepoNewR GET
|
/s/#ShrIdent/r/!new RepoNewR GET
|
||||||
/s/#ShrIdent/r/#RpIdent RepoR GET DELETE POST
|
/s/#ShrIdent/r/#RpIdent RepoR GET DELETE POST
|
||||||
|
|
|
@ -53,11 +53,13 @@ import Yesod.Default.Main (LogFunc)
|
||||||
-- Don't forget to add new modules to your cabal file!
|
-- Don't forget to add new modules to your cabal file!
|
||||||
import Vervis.Handler.Common
|
import Vervis.Handler.Common
|
||||||
import Vervis.Handler.Git
|
import Vervis.Handler.Git
|
||||||
|
import Vervis.Handler.Group
|
||||||
import Vervis.Handler.Home
|
import Vervis.Handler.Home
|
||||||
import Vervis.Handler.Key
|
import Vervis.Handler.Key
|
||||||
import Vervis.Handler.Person
|
import Vervis.Handler.Person
|
||||||
import Vervis.Handler.Project
|
import Vervis.Handler.Project
|
||||||
import Vervis.Handler.Repo
|
import Vervis.Handler.Repo
|
||||||
|
import Vervis.Handler.Sharer
|
||||||
import Vervis.Handler.Ticket
|
import Vervis.Handler.Ticket
|
||||||
|
|
||||||
import Vervis.Ssh (runSsh)
|
import Vervis.Ssh (runSsh)
|
||||||
|
|
|
@ -14,8 +14,7 @@
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Vervis.Field.Person
|
module Vervis.Field.Person
|
||||||
( loginField
|
( passField
|
||||||
, passField
|
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -27,35 +26,6 @@ import Database.Esqueleto
|
||||||
import Data.Char.Local (isAsciiLetter)
|
import Data.Char.Local (isAsciiLetter)
|
||||||
import Vervis.Model.Ident (text2shr)
|
import Vervis.Model.Ident (text2shr)
|
||||||
|
|
||||||
checkLoginTemplate :: Field Handler Text -> Field Handler Text
|
|
||||||
checkLoginTemplate =
|
|
||||||
let first = isAsciiLetter
|
|
||||||
rest c = isAsciiLetter c || isDigit c || c `elem` ("-._" :: String)
|
|
||||||
ok t =
|
|
||||||
case uncons t of
|
|
||||||
Just (c, r) -> first c && all rest r
|
|
||||||
Nothing -> False
|
|
||||||
msg :: Text
|
|
||||||
msg =
|
|
||||||
"The first character must be a letter, and every other character \
|
|
||||||
\must be a letter, a digit, ‘.’ (period) , ‘-’ (dash) or ‘_’ \
|
|
||||||
\(underscore)."
|
|
||||||
in checkBool ok msg
|
|
||||||
|
|
||||||
checkLoginUnique :: Field Handler Text -> Field Handler Text
|
|
||||||
checkLoginUnique = checkM $ \ login -> do
|
|
||||||
let login' = text2shr login
|
|
||||||
sames <- runDB $ select $ from $ \ sharer -> do
|
|
||||||
where_ $ lower_ (sharer ^. SharerIdent) ==. lower_ (val login')
|
|
||||||
limit 1
|
|
||||||
return ()
|
|
||||||
return $ if null sames
|
|
||||||
then Right login
|
|
||||||
else Left ("This username is already in use" :: Text)
|
|
||||||
|
|
||||||
loginField :: Field Handler Text
|
|
||||||
loginField = checkLoginUnique . checkLoginTemplate $ textField
|
|
||||||
|
|
||||||
checkPassLength :: Field Handler Text -> Field Handler Text
|
checkPassLength :: Field Handler Text -> Field Handler Text
|
||||||
checkPassLength =
|
checkPassLength =
|
||||||
let msg :: Text
|
let msg :: Text
|
||||||
|
|
66
src/Vervis/Field/Sharer.hs
Normal file
66
src/Vervis/Field/Sharer.hs
Normal file
|
@ -0,0 +1,66 @@
|
||||||
|
{- 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.Sharer
|
||||||
|
( sharerIdentField
|
||||||
|
, newSharerIdentField
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
|
||||||
|
import Data.Char (isDigit)
|
||||||
|
import Data.Maybe (isJust)
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Database.Esqueleto
|
||||||
|
import Yesod.Form.Fields (textField)
|
||||||
|
import Yesod.Form.Functions (checkBool, checkM, convertField)
|
||||||
|
import Yesod.Form.Types (Field)
|
||||||
|
import Yesod.Persist.Core (runDB)
|
||||||
|
|
||||||
|
import qualified Data.Text as T (null, all, find, split)
|
||||||
|
|
||||||
|
import Data.Char.Local (isAsciiLetter)
|
||||||
|
import Vervis.Foundation (Handler)
|
||||||
|
import Vervis.Model
|
||||||
|
import Vervis.Model.Ident (ShrIdent, shr2text, text2shr)
|
||||||
|
|
||||||
|
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
|
||||||
|
containsLetter = isJust . T.find isAsciiLetter
|
||||||
|
ok t =
|
||||||
|
let ws = T.split (== '-') t
|
||||||
|
in containsLetter t && all wordOk ws
|
||||||
|
msg :: Text
|
||||||
|
msg = "Expecting words of letters and digits, separated by hyphens"
|
||||||
|
in checkBool ok msg
|
||||||
|
|
||||||
|
checkUniqueCI :: Field Handler ShrIdent -> Field Handler ShrIdent
|
||||||
|
checkUniqueCI = checkM $ \ shar -> do
|
||||||
|
sames <- runDB $ select $ from $ \ sharer -> do
|
||||||
|
where_ $ lower_ (sharer ^. SharerIdent) ==. lower_ (val shar)
|
||||||
|
limit 1
|
||||||
|
return ()
|
||||||
|
return $ if null sames
|
||||||
|
then Right shar
|
||||||
|
else Left ("This sharer name is already in use" :: Text)
|
||||||
|
|
||||||
|
sharerIdentField :: Field Handler ShrIdent
|
||||||
|
sharerIdentField = convertField text2shr shr2text $ checkTemplate textField
|
||||||
|
|
||||||
|
newSharerIdentField :: Field Handler ShrIdent
|
||||||
|
newSharerIdentField = checkUniqueCI sharerIdentField
|
44
src/Vervis/Form/Group.hs
Normal file
44
src/Vervis/Form/Group.hs
Normal file
|
@ -0,0 +1,44 @@
|
||||||
|
{- 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.Form.Group
|
||||||
|
( NewGroup (..)
|
||||||
|
, newGroupForm
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Yesod.Form.Fields (textField)
|
||||||
|
import Yesod.Form.Functions (aopt, areq, renderDivs)
|
||||||
|
import Yesod.Form.Types (AForm)
|
||||||
|
|
||||||
|
import Vervis.Field.Sharer (newSharerIdentField)
|
||||||
|
import Vervis.Foundation (Handler, Form)
|
||||||
|
import Vervis.Model.Ident (ShrIdent)
|
||||||
|
|
||||||
|
data NewGroup = NewGroup
|
||||||
|
{ ngIdent :: ShrIdent
|
||||||
|
, ngName :: Maybe Text
|
||||||
|
}
|
||||||
|
|
||||||
|
newGroupAForm :: AForm Handler NewGroup
|
||||||
|
newGroupAForm = NewGroup
|
||||||
|
<$> areq newSharerIdentField "Name*" Nothing
|
||||||
|
<*> aopt textField "Full name" Nothing
|
||||||
|
|
||||||
|
newGroupForm :: Form NewGroup
|
||||||
|
newGroupForm = renderDivs newGroupAForm
|
|
@ -14,28 +14,30 @@
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Vervis.Form.Person
|
module Vervis.Form.Person
|
||||||
( PersonNew (..)
|
( NewPerson (..)
|
||||||
, formPersonNew
|
, newPersonForm
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Vervis.Import
|
import Vervis.Import
|
||||||
|
|
||||||
import Vervis.Field.Person
|
import Vervis.Field.Person
|
||||||
|
import Vervis.Field.Sharer
|
||||||
|
import Vervis.Model.Ident (ShrIdent)
|
||||||
|
|
||||||
data PersonNew = PersonNew
|
data NewPerson = NewPerson
|
||||||
{ uLogin :: Text
|
{ npLogin :: ShrIdent
|
||||||
, uPass :: Text
|
, npPass :: Text
|
||||||
, uName :: Maybe Text
|
, npName :: Maybe Text
|
||||||
, uEmail :: Maybe Text
|
, npEmail :: Maybe Text
|
||||||
}
|
}
|
||||||
|
|
||||||
newPersonAForm :: AForm Handler PersonNew
|
newPersonAForm :: AForm Handler NewPerson
|
||||||
newPersonAForm = PersonNew
|
newPersonAForm = NewPerson
|
||||||
<$> areq loginField "Username*" Nothing
|
<$> areq newSharerIdentField "Username*" Nothing
|
||||||
<*> areq passField "Password*" Nothing
|
<*> areq passField "Password*" Nothing
|
||||||
<*> aopt textField "Full name" Nothing
|
<*> aopt textField "Full name" Nothing
|
||||||
<*> aopt emailField "E-mail" Nothing
|
<*> aopt emailField "E-mail" Nothing
|
||||||
|
|
||||||
formPersonNew :: Form PersonNew
|
newPersonForm :: Form NewPerson
|
||||||
formPersonNew = renderDivs newPersonAForm
|
newPersonForm = renderDivs newPersonAForm
|
||||||
|
|
|
@ -246,7 +246,15 @@ loggedInAs ident msg = do
|
||||||
|
|
||||||
instance YesodBreadcrumbs App where
|
instance YesodBreadcrumbs App where
|
||||||
breadcrumb route = return $ case route of
|
breadcrumb route = return $ case route of
|
||||||
|
StaticR _ -> ("", Nothing)
|
||||||
|
FaviconR -> ("", Nothing)
|
||||||
|
RobotsR -> ("", Nothing)
|
||||||
|
|
||||||
HomeR -> ("Home", Nothing)
|
HomeR -> ("Home", Nothing)
|
||||||
|
AuthR _ -> ("Auth", Nothing)
|
||||||
|
|
||||||
|
SharersR -> ("Sharers", Just HomeR)
|
||||||
|
SharerR shar -> (shr2text shar, Just SharersR)
|
||||||
|
|
||||||
PeopleR -> ("People", Just HomeR)
|
PeopleR -> ("People", Just HomeR)
|
||||||
PersonNewR -> ("New", Just PeopleR)
|
PersonNewR -> ("New", Just PeopleR)
|
||||||
|
@ -270,6 +278,10 @@ instance YesodBreadcrumbs App where
|
||||||
, Just $ RepoHeadChangesR shar repo
|
, Just $ RepoHeadChangesR shar repo
|
||||||
)
|
)
|
||||||
|
|
||||||
|
DarcsDownloadR _ _ _ -> ("", Nothing)
|
||||||
|
|
||||||
|
GitRefDiscoverR _ _ -> ("", Nothing)
|
||||||
|
|
||||||
ProjectsR shar -> ("Projects", Just $ PersonR shar)
|
ProjectsR shar -> ("Projects", Just $ PersonR shar)
|
||||||
ProjectNewR shar -> ("New", Just $ ProjectsR shar)
|
ProjectNewR shar -> ("New", Just $ ProjectsR shar)
|
||||||
ProjectR shar proj -> ( prj2text proj
|
ProjectR shar proj -> ( prj2text proj
|
||||||
|
@ -286,5 +298,18 @@ instance YesodBreadcrumbs App where
|
||||||
TicketEditR shar proj num -> ( "Edit"
|
TicketEditR shar proj num -> ( "Edit"
|
||||||
, Just $ TicketR shar proj num
|
, Just $ TicketR shar proj num
|
||||||
)
|
)
|
||||||
|
TicketDiscussionR shar proj num -> ( "Discussion"
|
||||||
_ -> ("", Nothing)
|
, Just $ TicketR shar proj num
|
||||||
|
)
|
||||||
|
TicketMessageR shar proj t c -> ( T.pack $ '#' : show c
|
||||||
|
, Just $
|
||||||
|
TicketDiscussionR shar proj t
|
||||||
|
)
|
||||||
|
TicketTopReplyR shar proj num -> ( "New topic"
|
||||||
|
, Just $
|
||||||
|
TicketDiscussionR shar proj num
|
||||||
|
)
|
||||||
|
TicketReplyR shar proj num cnum -> ( "Reply"
|
||||||
|
, Just $
|
||||||
|
TicketMessageR shar proj num cnum
|
||||||
|
)
|
||||||
|
|
87
src/Vervis/Handler/Group.hs
Normal file
87
src/Vervis/Handler/Group.hs
Normal file
|
@ -0,0 +1,87 @@
|
||||||
|
{- 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.Handler.Group
|
||||||
|
( getGroupsR
|
||||||
|
, postGroupsR
|
||||||
|
, getGroupNewR
|
||||||
|
, getGroupR
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
|
||||||
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
import Data.Time.Clock (getCurrentTime)
|
||||||
|
import Database.Esqueleto
|
||||||
|
import Text.Blaze.Html (Html)
|
||||||
|
import Yesod.Core (defaultLayout, setMessage)
|
||||||
|
import Yesod.Core.Handler (redirect)
|
||||||
|
import Yesod.Form.Functions (runFormPost)
|
||||||
|
import Yesod.Form.Types (FormResult (..))
|
||||||
|
import Yesod.Persist.Core (runDB, getBy404)
|
||||||
|
|
||||||
|
import Vervis.Form.Group
|
||||||
|
import Vervis.Foundation
|
||||||
|
import Vervis.Model
|
||||||
|
import Vervis.Model.Ident (ShrIdent)
|
||||||
|
import Vervis.Settings (widgetFile)
|
||||||
|
import Vervis.Widget.Sharer (groupLinkW)
|
||||||
|
|
||||||
|
getGroupsR :: Handler Html
|
||||||
|
getGroupsR = do
|
||||||
|
groups <- runDB $ select $ from $ \ (sharer, group) -> do
|
||||||
|
where_ $ sharer ^. SharerId ==. group ^. GroupIdent
|
||||||
|
orderBy [asc $ sharer ^. SharerIdent]
|
||||||
|
return sharer
|
||||||
|
defaultLayout $(widgetFile "group/list")
|
||||||
|
|
||||||
|
postGroupsR :: Handler Html
|
||||||
|
postGroupsR = do
|
||||||
|
((result, widget), enctype) <- runFormPost newGroupForm
|
||||||
|
case result of
|
||||||
|
FormSuccess ng -> do
|
||||||
|
now <- liftIO getCurrentTime
|
||||||
|
runDB $ do
|
||||||
|
let sharer = Sharer
|
||||||
|
{ sharerIdent = ngIdent ng
|
||||||
|
, sharerName = ngName ng
|
||||||
|
, sharerCreated = now
|
||||||
|
}
|
||||||
|
sid <- insert sharer
|
||||||
|
let group = Group
|
||||||
|
{ groupIdent = sid
|
||||||
|
}
|
||||||
|
insert_ group
|
||||||
|
redirect $ GroupR $ ngIdent ng
|
||||||
|
FormMissing -> do
|
||||||
|
setMessage "Field(s) missing"
|
||||||
|
defaultLayout $(widgetFile "group/new")
|
||||||
|
FormFailure _l -> do
|
||||||
|
setMessage "Group creation failed, see errors below"
|
||||||
|
defaultLayout $(widgetFile "group/new")
|
||||||
|
|
||||||
|
getGroupNewR :: Handler Html
|
||||||
|
getGroupNewR = do
|
||||||
|
((_result, widget), enctype) <- runFormPost newGroupForm
|
||||||
|
defaultLayout $(widgetFile "group/new")
|
||||||
|
|
||||||
|
getGroupR :: ShrIdent -> Handler Html
|
||||||
|
getGroupR shar = do
|
||||||
|
group <- runDB $ do
|
||||||
|
Entity sid _s <- getBy404 $ UniqueSharer shar
|
||||||
|
Entity _gid g <- getBy404 $ UniqueGroup sid
|
||||||
|
return g
|
||||||
|
defaultLayout $(widgetFile "group/one")
|
|
@ -47,24 +47,24 @@ postPeopleR = do
|
||||||
regEnabled <- getsYesod $ appRegister . appSettings
|
regEnabled <- getsYesod $ appRegister . appSettings
|
||||||
if regEnabled
|
if regEnabled
|
||||||
then do
|
then do
|
||||||
((result, widget), enctype) <- runFormPost formPersonNew
|
((result, widget), enctype) <- runFormPost newPersonForm
|
||||||
case result of
|
case result of
|
||||||
FormSuccess pn -> do
|
FormSuccess np -> do
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
runDB $ do
|
runDB $ do
|
||||||
let sharer = Sharer
|
let sharer = Sharer
|
||||||
{ sharerIdent = text2shr $ uLogin pn
|
{ sharerIdent = npLogin np
|
||||||
, sharerName = uName pn
|
, sharerName = npName np
|
||||||
, sharerCreated = now
|
, sharerCreated = now
|
||||||
}
|
}
|
||||||
sid <- insert sharer
|
sid <- insert sharer
|
||||||
let person = Person
|
let person = Person
|
||||||
{ personIdent = sid
|
{ personIdent = sid
|
||||||
, personLogin = uLogin pn
|
, personLogin = shr2text $ npLogin np
|
||||||
, personHash = Nothing
|
, personHash = Nothing
|
||||||
, personEmail = uEmail pn
|
, personEmail = npEmail np
|
||||||
}
|
}
|
||||||
person' <- setPassword (uPass pn) person
|
person' <- setPassword (npPass np) person
|
||||||
insert_ person'
|
insert_ person'
|
||||||
redirectUltDest HomeR
|
redirectUltDest HomeR
|
||||||
FormMissing -> do
|
FormMissing -> do
|
||||||
|
@ -77,18 +77,12 @@ postPeopleR = do
|
||||||
|
|
||||||
getPersonNewR :: Handler Html
|
getPersonNewR :: Handler Html
|
||||||
getPersonNewR = do
|
getPersonNewR = do
|
||||||
mpid <- maybeAuthId
|
regEnabled <- getsYesod $ appRegister . appSettings
|
||||||
if isJust mpid
|
if regEnabled
|
||||||
then redirect HomeR
|
then do
|
||||||
else do
|
((_result, widget), enctype) <- runFormPost newPersonForm
|
||||||
regEnabled <- appRegister . appSettings <$> getYesod
|
defaultLayout $(widgetFile "person-new")
|
||||||
if regEnabled
|
else notFound
|
||||||
then do
|
|
||||||
((_result, widget), enctype) <- runFormPost formPersonNew
|
|
||||||
defaultLayout $ do
|
|
||||||
setTitle "Vervis > People > New"
|
|
||||||
$(widgetFile "person-new")
|
|
||||||
else notFound
|
|
||||||
|
|
||||||
getPersonR :: ShrIdent -> Handler Html
|
getPersonR :: ShrIdent -> Handler Html
|
||||||
getPersonR ident = do
|
getPersonR ident = do
|
||||||
|
|
|
@ -13,18 +13,21 @@
|
||||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Vervis.Widget.Person
|
module Vervis.Handler.Sharer
|
||||||
( sharerLinkW
|
( getSharersR
|
||||||
|
, getSharerR
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
import Vervis.Foundation
|
import Text.Blaze.Html (Html)
|
||||||
import Vervis.Model
|
|
||||||
import Vervis.Model.Ident (shr2text)
|
|
||||||
import Vervis.Settings (widgetFile)
|
|
||||||
|
|
||||||
sharerLinkW :: Sharer -> Widget
|
import Vervis.Foundation (Handler)
|
||||||
sharerLinkW sharer = $(widgetFile "sharer-link")
|
import Vervis.Model.Ident (ShrIdent)
|
||||||
|
|
||||||
|
getSharersR :: Handler Html
|
||||||
|
getSharersR = error "TODO"
|
||||||
|
|
||||||
|
getSharerR :: ShrIdent -> Handler Html
|
||||||
|
getSharerR shar = error "TODO"
|
|
@ -63,7 +63,7 @@ import Vervis.Render (renderSourceT)
|
||||||
import Vervis.Settings (widgetFile)
|
import Vervis.Settings (widgetFile)
|
||||||
import Vervis.TicketFilter (filterTickets)
|
import Vervis.TicketFilter (filterTickets)
|
||||||
import Vervis.Widget.Discussion (discussionW)
|
import Vervis.Widget.Discussion (discussionW)
|
||||||
import Vervis.Widget.Person (sharerLinkW)
|
import Vervis.Widget.Sharer (personLinkW)
|
||||||
|
|
||||||
getTicketsR :: ShrIdent -> PrjIdent -> Handler Html
|
getTicketsR :: ShrIdent -> PrjIdent -> Handler Html
|
||||||
getTicketsR shar proj = do
|
getTicketsR shar proj = do
|
||||||
|
|
|
@ -42,7 +42,7 @@ import Vervis.MediaType (MediaType (Markdown))
|
||||||
import Vervis.Model
|
import Vervis.Model
|
||||||
import Vervis.Render (renderSourceT)
|
import Vervis.Render (renderSourceT)
|
||||||
import Vervis.Settings (widgetFile)
|
import Vervis.Settings (widgetFile)
|
||||||
import Vervis.Widget.Person (sharerLinkW)
|
import Vervis.Widget.Sharer (personLinkW)
|
||||||
|
|
||||||
messageW :: UTCTime -> Sharer -> Message -> (Int -> Route App) -> Widget
|
messageW :: UTCTime -> Sharer -> Message -> (Int -> Route App) -> Widget
|
||||||
messageW now shr msg reply =
|
messageW now shr msg reply =
|
||||||
|
|
42
src/Vervis/Widget/Sharer.hs
Normal file
42
src/Vervis/Widget/Sharer.hs
Normal file
|
@ -0,0 +1,42 @@
|
||||||
|
{- 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.Widget.Sharer
|
||||||
|
( sharerLinkW
|
||||||
|
, personLinkW
|
||||||
|
, groupLinkW
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
|
||||||
|
import Yesod.Core (Route)
|
||||||
|
|
||||||
|
import Vervis.Foundation
|
||||||
|
import Vervis.Model
|
||||||
|
import Vervis.Model.Ident (ShrIdent, shr2text)
|
||||||
|
import Vervis.Settings (widgetFile)
|
||||||
|
|
||||||
|
link :: (ShrIdent -> Route App) -> Sharer -> Widget
|
||||||
|
link route sharer = $(widgetFile "sharer-link")
|
||||||
|
|
||||||
|
sharerLinkW :: Sharer -> Widget
|
||||||
|
sharerLinkW = link SharerR
|
||||||
|
|
||||||
|
personLinkW :: Sharer -> Widget
|
||||||
|
personLinkW = link PersonR
|
||||||
|
|
||||||
|
groupLinkW :: Sharer -> Widget
|
||||||
|
groupLinkW = link GroupR
|
|
@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
$# with this software. If not, see
|
$# with this software. If not, see
|
||||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
^{sharerLinkW shr}
|
^{personLinkW shr}
|
||||||
<div>
|
<div>
|
||||||
#{showTime $ messageCreated msg}
|
#{showTime $ messageCreated msg}
|
||||||
<div>
|
<div>
|
||||||
|
|
21
templates/group/list.hamlet
Normal file
21
templates/group/list.hamlet
Normal file
|
@ -0,0 +1,21 @@
|
||||||
|
$# 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>
|
||||||
|
These are the groups registered in this Vervis instance.
|
||||||
|
|
||||||
|
<ul>
|
||||||
|
$forall Entity _sid sharer <- groups
|
||||||
|
<li>
|
||||||
|
^{groupLinkW sharer}
|
17
templates/group/new.hamlet
Normal file
17
templates/group/new.hamlet
Normal 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=@{GroupsR} enctype=#{enctype}>
|
||||||
|
^{widget}
|
||||||
|
<input type=submit>
|
16
templates/group/one.hamlet
Normal file
16
templates/group/one.hamlet
Normal file
|
@ -0,0 +1,16 @@
|
||||||
|
$# 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>
|
||||||
|
TODO list the group's members here, and later also roles etc.
|
|
@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
|
||||||
$# with this software. If not, see
|
$# with this software. If not, see
|
||||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
<a href=@{PersonR $ sharerIdent sharer}>
|
<a href=@{route $ sharerIdent sharer}>
|
||||||
$maybe name <- sharerName sharer
|
$maybe name <- sharerName sharer
|
||||||
#{name}
|
#{name}
|
||||||
$nothing
|
$nothing
|
||||||
|
|
|
@ -32,7 +32,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
<td>
|
<td>
|
||||||
<a href=@{TicketR shar proj number}>#{number}
|
<a href=@{TicketR shar proj number}>#{number}
|
||||||
<td>
|
<td>
|
||||||
^{sharerLinkW author}
|
^{personLinkW author}
|
||||||
<td>
|
<td>
|
||||||
<a href=@{TicketR shar proj number}>#{title}
|
<a href=@{TicketR shar proj number}>#{title}
|
||||||
<td>
|
<td>
|
||||||
|
|
|
@ -21,13 +21,13 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
Created on #{formatTime defaultTimeLocale "%F" $ ticketCreated ticket} by
|
Created on #{formatTime defaultTimeLocale "%F" $ ticketCreated ticket} by
|
||||||
^{sharerLinkW author}
|
^{personLinkW author}
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
Status:
|
Status:
|
||||||
$if ticketDone ticket
|
$if ticketDone ticket
|
||||||
Closed on #{formatTime defaultTimeLocale "%F" $ ticketClosed ticket} by
|
Closed on #{formatTime defaultTimeLocale "%F" $ ticketClosed ticket} by
|
||||||
^{sharerLinkW closer}
|
^{personLinkW closer}
|
||||||
$else
|
$else
|
||||||
Open
|
Open
|
||||||
|
|
||||||
|
|
|
@ -83,7 +83,9 @@ library
|
||||||
Vervis.Field.Person
|
Vervis.Field.Person
|
||||||
Vervis.Field.Project
|
Vervis.Field.Project
|
||||||
Vervis.Field.Repo
|
Vervis.Field.Repo
|
||||||
|
Vervis.Field.Sharer
|
||||||
Vervis.Form.Discussion
|
Vervis.Form.Discussion
|
||||||
|
Vervis.Form.Group
|
||||||
Vervis.Form.Key
|
Vervis.Form.Key
|
||||||
Vervis.Form.Person
|
Vervis.Form.Person
|
||||||
Vervis.Form.Project
|
Vervis.Form.Project
|
||||||
|
@ -96,6 +98,7 @@ library
|
||||||
Vervis.Handler.Common
|
Vervis.Handler.Common
|
||||||
Vervis.Handler.Discussion
|
Vervis.Handler.Discussion
|
||||||
Vervis.Handler.Git
|
Vervis.Handler.Git
|
||||||
|
Vervis.Handler.Group
|
||||||
Vervis.Handler.Home
|
Vervis.Handler.Home
|
||||||
Vervis.Handler.Key
|
Vervis.Handler.Key
|
||||||
Vervis.Handler.Person
|
Vervis.Handler.Person
|
||||||
|
@ -103,6 +106,7 @@ library
|
||||||
Vervis.Handler.Repo
|
Vervis.Handler.Repo
|
||||||
Vervis.Handler.Repo.Darcs
|
Vervis.Handler.Repo.Darcs
|
||||||
Vervis.Handler.Repo.Git
|
Vervis.Handler.Repo.Git
|
||||||
|
Vervis.Handler.Sharer
|
||||||
Vervis.Handler.Ticket
|
Vervis.Handler.Ticket
|
||||||
Vervis.Import
|
Vervis.Import
|
||||||
Vervis.Import.NoFoundation
|
Vervis.Import.NoFoundation
|
||||||
|
@ -122,8 +126,8 @@ library
|
||||||
Vervis.TicketFilter
|
Vervis.TicketFilter
|
||||||
Vervis.Widget
|
Vervis.Widget
|
||||||
Vervis.Widget.Discussion
|
Vervis.Widget.Discussion
|
||||||
Vervis.Widget.Person
|
|
||||||
Vervis.Widget.Repo
|
Vervis.Widget.Repo
|
||||||
|
Vervis.Widget.Sharer
|
||||||
-- other-modules:
|
-- other-modules:
|
||||||
default-extensions: TemplateHaskell
|
default-extensions: TemplateHaskell
|
||||||
QuasiQuotes
|
QuasiQuotes
|
||||||
|
|
Loading…
Reference in a new issue