Breadcrumbs widget in default layout

This commit is contained in:
fr33domlover 2016-05-02 14:16:51 +00:00
parent e8befc41ee
commit 13d814034c
6 changed files with 84 additions and 3 deletions

View file

@ -17,7 +17,6 @@ module Vervis.Foundation where
import Prelude (init, last)
import Vervis.Import.NoFoundation hiding (last)
import Database.Persist.Sql (ConnectionPool, runSqlPool)
import Text.Hamlet (hamletFile)
import Text.Jasmine (minifym)
@ -31,6 +30,9 @@ import qualified Yesod.Core.Unsafe as Unsafe
import Data.Text as T (pack)
--import qualified Data.Text.Encoding as TE
import Vervis.Import.NoFoundation hiding (last)
import Vervis.Widget (breadcrumbBar)
-- | The foundation datatype for your application. This can be a good place to
-- keep settings and values requiring initialization before your application
-- starts running, such as database connections. Every handler will have

33
src/Vervis/Widget.hs 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/>.
-}
-- | Various custom widgets.
module Vervis.Widget
( breadcrumbBar
)
where
import Prelude
import Yesod.Core (YesodBreadcrumbs, breadcrumbs)
import Yesod.Core.Widget
import Vervis.Settings (widgetFile)
import Vervis.Style
breadcrumbBar :: YesodBreadcrumbs site => WidgetT site IO ()
breadcrumbBar = do
(current, bcs) <- handlerToWidget breadcrumbs
$(widgetFile "breadcrumbs")

View file

@ -0,0 +1,22 @@
/* 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/>.
*/
.parents
color: #{dark yellow}
font: 160% monospace
.title
color: #{dark yellow}
font: 160% monospace

View file

@ -0,0 +1,20 @@
$# 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/>.
<span class="parents">
$forall (route, title) <- bcs
<a href=@{route}>#{title}
:: #
<span class="title">
#{current}

View file

@ -13,14 +13,17 @@ $# with this software. If not, see
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
$maybe Entity _pid person <- mperson
<p>
<div>
You are logged in as #{personLogin person}.
<a href=@{AuthR LogoutR}>Log out.
$nothing
<p>
<div>
You are not logged in.
<a href=@{AuthR LoginR}>Log in.
^{breadcrumbBar}
$maybe msg <- mmsg
<div #message>#{msg}
^{widget}

View file

@ -75,6 +75,7 @@ library
Vervis.Path
Vervis.Ssh
Vervis.Style
Vervis.Widget
-- other-modules:
default-extensions: TemplateHaskell
QuasiQuotes