sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 19:44:50 +09:00
Code Issues Activity

YesodBreadcrumbs instance

Browse source
This commit is contained in:
fr33domlover 2016-05-02 10:03:29 +00:00
parent 9d3b7b686f
commit 434e1cbc7d
1 changed files with 44 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
src/Vervis/Foundation.hs
View file

@ -15,7 +15,9 @@
module Vervis.Foundation where
import Vervis.Import.NoFoundation
import Prelude (init, last)
import Vervis.Import.NoFoundation hiding (last)
import Database.Persist.Sql (ConnectionPool, runSqlPool)
import Text.Hamlet (hamletFile)
import Text.Jasmine (minifym)
@ -26,6 +28,7 @@ import Yesod.Core.Types (Logger)
import qualified Yesod.Core.Unsafe as Unsafe
--import qualified Data.CaseInsensitive as CI
import Data.Text as T (pack)
--import qualified Data.Text.Encoding as TE
-- | The foundation datatype for your application. This can be a good place to
@ -246,3 +249,43 @@ loggedInAs ident msg = do
if ident == sharerIdent sharer
then return Authorized
else return $ Unauthorized msg
instance YesodBreadcrumbs App where
breadcrumb route = return $ case route of
HomeR -> ("Home", Nothing)
PeopleR -> ("People", Just HomeR)
PersonNewR -> ("New", Just PeopleR)
PersonR shar -> (shar, Just PeopleR)
KeysR shar -> ("Keys", Just $ PersonR shar)
KeyNewR shar -> ("New", Just $ KeysR shar)
KeyR shar key -> (key, Just $ KeysR shar)
ReposR shar -> ("Repos", Just $ PersonR shar)
RepoNewR shar -> ("New", Just $ ReposR shar)
RepoR shar repo -> (repo, Just $ ReposR shar)
RepoSourceR shar repo branch [] -> ("Files", Just $ RepoR shar repo)
RepoSourceR shar repo branch dir -> ( last dir
, Just $
RepoSourceR shar repo branch $
init dir
)
RepoCommitsR shar repo -> ("History", Just $ RepoR shar repo)
ProjectsR shar -> ("Projects", Just $ PersonR shar)
ProjectNewR shar -> ("New", Just $ ProjectsR shar)
ProjectR shar proj -> (proj, Just $ ProjectsR shar)
TicketsR shar proj -> ( "Tickets"
, Just $ ProjectR shar proj
)
TicketNewR shar proj -> ("New", Just $ TicketsR shar proj)
TicketR shar proj num -> ( T.pack $ '#' : show num
, Just $ TicketsR shar proj
)
TicketEditR shar proj num -> ( "Edit"
, Just $ TicketR shar proj num
)
_ -> ("", Nothing)