sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-29 04:14:51 +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 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 Database.Persist.Sql (ConnectionPool, runSqlPool)
import Text.Hamlet (hamletFile) import Text.Hamlet (hamletFile)
import Text.Jasmine (minifym) import Text.Jasmine (minifym)
@ -26,6 +28,7 @@ import Yesod.Core.Types (Logger)
import qualified Yesod.Core.Unsafe as Unsafe import qualified Yesod.Core.Unsafe as Unsafe
--import qualified Data.CaseInsensitive as CI --import qualified Data.CaseInsensitive as CI
import Data.Text as T (pack)
--import qualified Data.Text.Encoding as TE --import qualified Data.Text.Encoding as TE
-- | The foundation datatype for your application. This can be a good place to -- | 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 if ident == sharerIdent sharer
then return Authorized then return Authorized
else return $ Unauthorized msg 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)