Commit 1a77674b authored by Michael Hanus's avatar Michael Hanus
Browse files

spicey updated w.r.t. new libraries

parent f1c6d679
-------------------------------------------------------------------
--- This library contains some operations to generate web pages
--- rendered with [Bootstrap](http://twitter.github.com/bootstrap/)
---
--- @author Michael Hanus
--- @version January 2016
-------------------------------------------------------------------
module Bootstrap3Style(bootstrapForm,bootstrapPage,titledSideMenu) where
import HTML
--- An HTML form rendered with bootstrap.
--- @param rootdir - the root directory to find styles (in subdirectory `css`
--- of the root) and images (in subdirectory `img` of the root)
--- @param styles - the style files to be included (typically,
--- `bootstrap` and `bootstrap-responsive`), stored in
--- `rootdir/css` with suffix `.css`)
--- @param title - the title of the form
--- @lefttopmenu - the menu shown in the left side of the top navigation bar
--- @righttopmenu - the menu shown in the right side of the top navigation bar
--- (could be empty)
--- @param columns - number of columns for the left-side menu
--- (if columns==0, then the left-side menu is omitted)
--- @param sidemenu - the menu shown at the left-side of the main document
--- (maybe created with 'titledSideMenu')
--- @param header - the main header (rendered with jumbotron style)
--- @param contents - the main contents of the document
--- @param footer - the footer of the document
bootstrapForm :: String -> [String] -> String -> (String,[HtmlExp])
-> [[HtmlExp]] -> [[HtmlExp]] -> Int -> [HtmlExp] -> [HtmlExp]
-> [HtmlExp] -> [HtmlExp] -> HtmlForm
bootstrapForm rootdir styles title brandurltitle lefttopmenu righttopmenu
leftcols sidemenu header contents footer =
HtmlForm title
([formEnc "utf-8",responsiveView,icon] ++
map (\n -> formCSS (rootdir++"/css/"++n++".css")) styles)
(bootstrapBody rootdir brandurltitle lefttopmenu righttopmenu
leftcols sidemenu header contents footer)
where
-- for a better view on handheld devices:
responsiveView =
HeadInclude (HtmlStruct "meta"
[("name","viewport"),
("content","width=device-width, initial-scale=1.0")] [])
icon = HeadInclude (HtmlStruct "link"
[("rel","shortcut icon"),
("href",rootdir++"/img/favicon.ico")] [])
--- An HTML page rendered with bootstrap.
--- @param rootdir - the root directory to find styles (in subdirectory `css`
--- of the root) and images (in subdirectory `img` of the root)
--- @param styles - the style files to be included (typically,
--- `bootstrap` and `bootstrap-responsive`), stored in
--- `rootdir/css` with suffix `.css`)
--- @param title - the title of the form
--- @lefttopmenu - the menu shown in the left side of the top navigation bar
--- @righttopmenu - the menu shown in the right side of the top navigation bar
--- (could be empty)
--- @param columns - number of columns for the left-side menu
--- (if columns==0, then the left-side menu is omitted)
--- @param sidemenu - the menu shown at the left-side of the main document
--- (maybe created with 'titledSideMenu')
--- @param header - the main header (rendered with jumbotron style)
--- @param contents - the main contents of the document
--- @param footer - the footer of the document
bootstrapPage :: String -> [String] -> String -> (String,[HtmlExp])
-> [[HtmlExp]] -> [[HtmlExp]] -> Int -> [HtmlExp] -> [HtmlExp]
-> [HtmlExp] -> [HtmlExp] -> HtmlPage
bootstrapPage rootdir styles title brandurltitle lefttopmenu righttopmenu
leftcols sidemenu header contents footer =
HtmlPage title
([pageEnc "utf-8",responsiveView,icon] ++
map (\n -> pageCSS (rootdir++"/css/"++n++".css")) styles)
(bootstrapBody rootdir brandurltitle lefttopmenu righttopmenu
leftcols sidemenu header contents footer)
where
-- for a better view on handheld devices:
responsiveView =
pageMetaInfo [("name","viewport"),
("content","width=device-width, initial-scale=1.0")]
icon = pageLinkInfo [("rel","shortcut icon"),
("href",rootdir++"/img/favicon.ico")]
--- Create body of HTML page. Used by bootstrapForm and bootstrapPage.
bootstrapBody :: String -> (String,[HtmlExp]) -> [[HtmlExp]]
-> [[HtmlExp]] -> Int -> [HtmlExp] -> [HtmlExp]
-> [HtmlExp] -> [HtmlExp] -> [HtmlExp]
bootstrapBody rootdir brandurltitle lefttopmenu righttopmenu
leftcols sidemenu header contents footer =
topNavigationBar brandurltitle lefttopmenu righttopmenu ++
[blockstyle "container-fluid"
([blockstyle "row"
(if leftcols==0
then [blockstyle (bsCols 12)
(headerRow ++ contents)]
else [blockstyle (bsCols leftcols)
[blockstyle "well nav-sidebar" sidemenu],
blockstyle (bsCols (12-leftcols))
(headerRow ++ contents)])] ++
if null footer
then []
else [hrule, HtmlStruct "footer" [] footer]),
-- JavaScript includes placed at the end so page loads faster:
HtmlStruct "script" [("src",rootdir++"/js/jquery.min.js")] [],
HtmlStruct "script" [("src",rootdir++"/js/bootstrap.min.js")] []]
where
bsCols n = "col-sm-" ++ show n ++ " " ++ "col-md-" ++ show n
-- header row:
headerRow = if null header
then []
else [HtmlStruct "header" [("class","jumbotron")] header]
-- Navigation bar at the top. The first argument is a header element
-- put at the left, the second and third arguments are the left
-- and right menus which will be collapsed if the page is two small.
topNavigationBar :: (String,[HtmlExp]) -> [[HtmlExp]] -> [[HtmlExp]]
-> [HtmlExp]
topNavigationBar (brandurl,brandtitle) leftmenu rightmenu =
[blockstyle "navbar navbar-inverse navbar-fixed-top"
[blockstyle "container-fluid"
[blockstyle "navbar-header"
[HtmlStruct "button"
[("type","button"),("class","navbar-toggle collapsed"),
("data-toggle","collapse"),("data-target","#topnavbar"),
("aria-expanded","false"),("aria-controls","navbar")]
[textstyle "sr-only" "Toggle navigation",
textstyle "icon-bar" "",
textstyle "icon-bar" "",
textstyle "icon-bar" ""],
href brandurl brandtitle `addClass` "navbar-brand"],
HtmlStruct "div" [("id","topnavbar"),
("class","navbar-collapse collapse")]
([ulist leftmenu `addClass` "nav navbar-nav"] ++
if null rightmenu then []
else [ulist rightmenu `addClass` "nav navbar-nav navbar-right"])]]]
-- Create a side menu containing a title and a list of items:
titledSideMenu :: String -> [[HtmlExp]] -> [HtmlExp]
titledSideMenu title items =
(if null title
then []
else [HtmlStruct "small" [] [htxt title]]) ++
[ulist items `addClass` "nav nav-sidebar"]
------------------------------------------------------------------------
-------------------------------------------------------------------
--- This library contains some operations to generate web pages
--- rendered with [Bootstrap](http://twitter.github.com/bootstrap/)
-------------------------------------------------------------------
module BootstrapStyle(bootstrapForm,bootstrapPage,titledSideMenu) where
import HTML
--- An HTML form rendered with bootstrap.
--- @param rootdir - the root directory to find styles (in subdirectory `css`
--- of the root) and images (in subdirectory `img` of the root)
--- @param styles - the style files to be included (typically,
--- `bootstrap` and `bootstrap-responsive`), stored in
--- `rootdir/css` with suffix `.css`)
--- @param title - the title of the form
--- @lefttopmenu - the menu shown in the left side of the top navigation bar
--- @righttopmenu - the menu shown in the right side of the top navigation bar
--- (could be empty)
--- @param columns - number of columns for the left-side menu
--- (if columns==0, then the left-side menu is omitted)
--- @param sidemenu - the menu shown at the left-side of the main document
--- (maybe created with 'titledSideMenu')
--- @param htmlHeader - the main header (rendered with hero-unit style)
--- @param contents - the main contents of the document
--- @param htmlFooter - the footer of the document
bootstrapForm :: String -> [String] -> String -> [[HtmlExp]]
-> [[HtmlExp]] -> Int -> [HtmlExp] -> [HtmlExp]
-> [HtmlExp] -> [HtmlExp] -> HtmlForm
bootstrapForm rootdir styles title lefttopmenu righttopmenu
leftcols sidemenu htmlHeader contents htmlFooter =
HtmlForm title
([formEnc "utf-8",responsiveView,icon] ++
map (\n -> formCSS (rootdir++"/css/"++n++".css")) styles)
(topNavigationBar lefttopmenu righttopmenu ++
[blockstyle "container-fluid"
[blockstyle "row-fluid"
(if leftcols==0
then [headerRow, blockstyle "row-fluid" contents]
else [blockstyle ("span"++show leftcols)
[blockstyle "well sidebar-nav" sidemenu],
blockstyle ("span"++show (12-leftcols))
[headerRow,
blockstyle "row-fluid" contents]]),
hrule,
footer htmlFooter]])
where
-- for a better view on handheld devices:
responsiveView =
HeadInclude (HtmlStruct "meta"
[("name","viewport"),
("content","width=device-width, initial-scale=1.0")] [])
icon = HeadInclude (HtmlStruct "link"
[("rel","shortcut icon"),
("href",rootdir++"/img/favicon.ico")] [])
-- header row:
headerRow = blockstyle "row-fluid"
[header htmlHeader `addAttr` ("class","hero-unit")]
--- An HTML page rendered with bootstrap.
--- @param rootdir - the root directory to find styles (in subdirectory `css`
--- of the root) and images (in subdirectory `img` of the root)
--- @param styles - the style files to be included (typically,
--- `bootstrap` and `bootstrap-responsive`), stored in
--- `rootdir/css` with suffix `.css`)
--- @param title - the title of the form
--- @lefttopmenu - the menu shown in the left side of the top navigation bar
--- @righttopmenu - the menu shown in the right side of the top navigation bar
--- (could be empty)
--- @param columns - number of columns for the left-side menu
--- (if columns==0, then the left-side menu is omitted)
--- @param sidemenu - the menu shown at the left-side of the main document
--- (maybe created with 'titledSideMenu')
--- @param htmlHeader - the main header (rendered with hero-unit style)
--- @param contents - the main contents of the document
--- @param htmlFooter - the footer of the document
bootstrapPage :: String -> [String] -> String -> [[HtmlExp]]
-> [[HtmlExp]] -> Int -> [HtmlExp] -> [HtmlExp]
-> [HtmlExp] -> [HtmlExp] -> HtmlPage
bootstrapPage rootdir styles title lefttopmenu righttopmenu
leftcols sidemenu htmlHeader contents htmlFooter =
HtmlPage title
([pageEnc "utf-8",responsiveView,icon] ++
map (\n -> pageCSS (rootdir ++ "/css/" ++ n ++ ".css")) styles)
(topNavigationBar lefttopmenu righttopmenu ++
(if leftcols == 0
then fluidBlock $ [headerRow, blockstyle "row-fluid" contents]
++ footline
else ([blockstyle "container-fluid" [headerRow]]
++ (fluidBlock $ sidemenuBlock
++ [blockstyle ("span" ++ show (12-leftcols))
contentBlock]
++ footline))))
where
-- for a better view on handheld devices:
responsiveView =
pageMetaInfo [("name","viewport"),
("content","width=device-width, initial-scale=1.0")]
icon = pageLinkInfo [("rel","shortcut icon"),
("href",rootdir++"/img/favicon.ico")]
-- header row:
headerRow = blockstyle "row-fluid"
[header htmlHeader `addAttr` ("class","hero-unit")]
-- content block
contentBlock = [blockstyle "row-fluid" contents]
-- sidemenu block
sidemenuBlock = [nav [blockstyle ("span"++show leftcols)
[blockstyle "well sidebar-nav" sidemenu]]]
-- footline
footline = [hrule, footer htmlFooter]
fluidBlock b = [blockstyle "container-fluid" [blockstyle "row-fluid" b]]
-- Navigation bar at the top:
topNavigationBar :: [[HtmlExp]] -> [[HtmlExp]] -> [HtmlExp]
topNavigationBar leftmenu rightmenu = [nav
[blockstyle "navbar navbar-inverse navbar-fixed-top"
[blockstyle "navbar-inner"
[blockstyle "container-fluid"
([ulist leftmenu `addClass` "nav"] ++
if null rightmenu then []
else [blockstyle "navbar-text pull-right"
[ulist rightmenu `addClass` "nav"]])]]]]
--- Create a side menu containing a title and a list of items:
titledSideMenu :: String -> [[HtmlExp]] -> [HtmlExp]
titledSideMenu title items =
(if null title
then []
else [HtmlStruct "small" [] [htxt title]]) ++
[ulist items `addClass` "nav nav-list"]
------------------------------------------------------------------------
......@@ -2,7 +2,7 @@
--- Operations to generate documentation in HTML format.
---
--- @author Michael Hanus, Jan Tikovsky
--- @version September 2015
--- @version January 2016
----------------------------------------------------------------------
module CurryDocHtml where
......@@ -19,7 +19,7 @@ import qualified FlatCurry.Goodies as FCG
import FilePath
import FileGoodies (lookupFileInPath)
import HTML
import Bootstrap3Style
import Bootstrap3Style (bootstrapPage, glyphicon, homeIcon)
import List
import Char
import Sort
......@@ -702,9 +702,6 @@ rightTopMenu =
--------------------------------------------------------------------------
-- Icons:
homeIcon :: HtmlExp
homeIcon = glyphicon "home"
extLinkIcon :: HtmlExp
extLinkIcon = glyphicon "new-window"
......@@ -727,10 +724,6 @@ nondetIcon = glyphicon "random"
withTitle :: HtmlExp -> String -> HtmlExp
withTitle he t = he `addAttr` ("title",t)
-- Select some glyphicon
glyphicon :: String -> HtmlExp
glyphicon n = textstyle ("glyphicon glyphicon-"++n) ""
--------------------------------------------------------------------------
-- Standard footer information for generated web pages:
curryDocFooter :: CalendarTime -> [HtmlExp]
......
......@@ -14,13 +14,13 @@ TOOL = $(BINDIR)/currydoc
DEPS = CurryDoc.curry CurryDocRead.curry CurryDocHtml.curry \
CurryDocTeX.curry CurryDocCDoc.curry \
CurryDocParams.curry CurryDocConfig.curry \
BootstrapStyle.curry \
$(LIBDIR)/Markdown.curry \
$(LIBDIR)/FlatCurry/FlexRigid.curry \
$(LIBDIR)/CategorizedHtmlList.curry \
$(LIBDIR)/Distribution.curry $(LIBDIR)/PropertyFile.curry \
$(LIBDIR)/FlatCurry/Types.curry $(LIBDIR)/FlatCurry/Files.curry \
$(LIBDIR)/HTML.curry $(LIBDIR)/HtmlParser.curry \
$(LIBDIR)/Bootstrap3Style.curry \
$(CASS)/AnalysisServer.curry \
$(ANADIR)/Deterministic.curry $(ANADIR)/TotallyDefined.curry \
$(ANADIR)/Indeterministic.curry $(ANADIR)/SolutionCompleteness.curry
......
......@@ -8,7 +8,7 @@ import Distribution
systemBanner :: String
systemBanner =
let bannerText = "Spicey Web Framework (Version of 11/01/16)"
let bannerText = "Spicey Web Framework (Version of 13/01/16)"
bannerLine = take (length bannerText) (repeat '-')
in bannerLine ++ "\n" ++ bannerText ++ "\n" ++ bannerLine
......
......@@ -37,12 +37,12 @@ getControllerReference url = getRoutes >>= return . findControllerReference
--- Generates the menu for all route entries put on the top of
--- each page. As a default, all routes specified with URL matcher
--- Exact in the module RouteData, except for "login",
--- `Exact` in the module RouteData, except for "login",
--- are taken as menu entries.
getRouteMenu :: IO HtmlExp
getRouteMenu :: IO [[HtmlExp]]
getRouteMenu = do
routes <- getRoutes
return $ ulist (getLinks routes)
return $ getLinks routes
where
getLinks :: [Route] -> [[HtmlExp]]
getLinks ((name, matcher, _):restroutes) =
......
......@@ -19,13 +19,13 @@ module Spicey (
intToHtml,maybeIntToHtml, floatToHtml, maybeFloatToHtml,
boolToHtml, maybeBoolToHtml, calendarTimeToHtml, maybeCalendarTimeToHtml,
userDefinedToHtml, maybeUserDefinedToHtml,
spHref, spHrefBlock, spHrefInfoBlock,
spButton, spPrimButton, spSmallButton, spTable,
spTable,
setPageMessage, getPageMessage,
saveLastUrl, getLastUrl, getLastUrls
) where
import System
import Bootstrap3Style
import HTML
import ReadNumeric
import KeyDatabase
......@@ -77,8 +77,8 @@ nextControllerForData controller param = do
confirmNextController :: HtmlExp -> (Bool -> Controller) -> _ -> IO HtmlForm
confirmNextController question controller _ = do
getForm [question,
spButton "Yes" (nextController (controller True)),
spButton "No" (nextController (controller False))]
defaultButton "Yes" (nextController (controller True)),
defaultButton "No" (nextController (controller False))]
--- Ask the user for a confirmation and call the corresponding controller.
--- @param question - a question asked
......@@ -87,8 +87,8 @@ confirmNextController question controller _ = do
confirmController :: [HtmlExp] -> Controller -> Controller -> Controller
confirmController question yescontroller nocontroller = do
return $ question ++
[par [spButton "Yes" (nextController yescontroller),
spButton "No" (nextController nocontroller )]]
[par [defaultButton "Yes" (nextController yescontroller),
defaultButton "No" (nextController nocontroller )]]
--- A controller to execute a transaction and proceed with a given
--- controller if the transaction succeeds. Otherwise, the
......@@ -164,7 +164,8 @@ renderWuiForm wuispec initdata controller cancelcontroller title buttontag =
[h1 [htxt title],
blockstyle "editform" [wuihexp],
wuiHandler2button buttontag hdlr `addClass` "btn btn-primary",
spButton "cancel" (nextController (cancelOperation >> cancelcontroller))]
defaultButton "cancel"
(nextController (cancelOperation >> cancelcontroller))]
(hexp,handler) = wuiWithErrorForm wuispec
initdata
......@@ -200,97 +201,60 @@ wUncheckMaybe defval wspec =
wspec
defval
--------------------------------------------------------------------------
-- Define page layout of the application.
--- The title of this application (shown in the header).
spiceyTitle :: String
spiceyTitle = "Spicey Application"
--- Adds the basic page layout to a view.
addLayout :: ViewBlock -> IO ViewBlock
addLayout viewblock = do
routemenu <- getRouteMenu
msg <- getPageMessage
login <- getSessionLogin
lasturl <- getLastUrl
return $
stdNavBar routemenu login ++
[blockstyle "container-fluid" $
[HtmlStruct "header" [("class","jumbotron")] [h1 [htxt spiceyTitle]],
if null msg
then HtmlStruct "header" [("class","pagemessage pagemessage-empty")]
[htxt ("Last page: "++lasturl)]
else HtmlStruct "header" [("class","pagemessage")] [htxt msg],
blockstyle "row"
[blockstyle "col-md-12" viewblock],
hrule,
HtmlStruct "footer" []
[par [htxt "powered by",
href "http://www.informatik.uni-kiel.de/~pakcs/spicey"
[image "images/spicey-logo.png" "Spicey"]
`addAttr` ("target","_blank"),
htxt "Framework"]]]]
-- Standard navigation bar at the top.
-- The first argument is the route menu (a ulist).
-- The second argument is the possible login name.
stdNavBar :: HtmlExp -> Maybe String -> [HtmlExp]
stdNavBar routemenu login =
[blockstyle "navbar navbar-inverse navbar-fixed-top"
[blockstyle "container-fluid"
[navBarHeaderItem,
HtmlStruct "div" [("id","topnavbar"),
("class","navbar-collapse collapse")]
[routemenu `addClass` "nav navbar-nav",
ulist [[href "?login"
(maybe [loginIcon, nbsp, htxt "Login"]
(\n -> [logoutIcon, nbsp, htxt "Logout"
,htxt $ " ("
,style "text-success" [userIcon]
,htxt $ " "++n++")"
])
login)]]
`addClass` "nav navbar-nav navbar-right"]]
]
]
where
navBarHeaderItem =
blockstyle "navbar-header"
[HtmlStruct "button"
[("type","button"),("class","navbar-toggle collapsed"),
("data-toggle","collapse"),("data-target","#topnavbar"),
("aria-expanded","false"),("aria-controls","navbar")]
[textstyle "sr-only" "Toggle navigation",
textstyle "icon-bar" "",
textstyle "icon-bar" "",
textstyle "icon-bar" ""],
href "?" [homeIcon, htxt " Home"] `addClass` "navbar-brand"]
--- The home URL and brand shown at the left top of the main page.
spiceyHomeBrand :: (String, [HtmlExp])
spiceyHomeBrand = ("?", [homeIcon, htxt " Home"])
--- The standard footer of the Spicey page.
spiceyFooter :: [HtmlExp]
spiceyFooter =
[par [htxt "powered by",
href "http://www.informatik.uni-kiel.de/~pakcs/spicey"
[image "images/spicey-logo.png" "Spicey"]
`addAttr` ("target","_blank"),
htxt "Framework"]]
--- Transforms a view into an HTML form by adding the basic page layout.
getForm :: ViewBlock -> IO HtmlForm
getForm viewBlock =
if viewBlock == [HtmlText ""]
getForm viewblock =
if viewblock == [HtmlText ""]
then return $ HtmlForm "forward to Spicey"
[formMetaInfo [("http-equiv","refresh"),
("content","1; url=spicey.cgi")]]
[par [htxt "You will be forwarded..."]]
else do
cookie <- sessionCookie
body <- addLayout viewBlock
return $ HtmlForm spiceyTitle
([responsiveView, cookie, icon] ++
map (\f -> FormCSS $ "css/"++f++".css")
["bootstrap.min","spicey"])
(body ++
map (\f -> HtmlStruct "script" [("src","js/"++f++".js")] [])
["jquery.min","bootstrap.min"])
routemenu <- getRouteMenu
msg <- getPageMessage
login <- getSessionLogin
lasturl <- getLastUrl
cookie <- sessionCookie
return (bootstrapForm "." ["bootstrap.min","spicey"] spiceyTitle
spiceyHomeBrand routemenu (rightTopMenu login)
0 [] [h1 [htxt spiceyTitle]]
(messageLine msg lasturl : viewblock ) spiceyFooter
`addFormParam` cookie)
where
responsiveView =
formMetaInfo [("name","viewport"),
("content","width=device-width, initial-scale=1.0")]
icon = HeadInclude (HtmlStruct "link"
[("rel","shortcut icon"),
("href","favicon.ico")] [])
messageLine msg lasturl =
if null msg
then HtmlStruct "header" [("class","pagemessage pagemessage-empty")]
[htxt ("Last page: "++lasturl)]
else HtmlStruct "header" [("class","pagemessage")] [htxt msg]
rightTopMenu login =
[[href "?login" (maybe [loginIcon, nbsp, htxt "Login"]
(\n -> [logoutIcon, nbsp, htxt "Logout"
,htxt $ " ("
,style "text-success" [userIcon]
,htxt $ " "++n++")"
])
login)]]
-------------------------------------------------------------------------
-- Action performed when a "cancel" button is pressed.
......@@ -361,50 +325,10 @@ maybeUserDefinedToHtml ud = textstyle "type_string" (maybe "" show ud)
--------------------------------------------------------------------------
-- Auxiliary HTML items:
--- Hypertext reference in Spicey (rendered as a block button):
spHref :: String -> [HtmlExp] -> HtmlExp
spHref ref hexps =
href ref hexps `addClass` "btn btn-sm btn-default"
--- Hypertext reference in Spicey (rendered as a block button):
spHrefBlock :: String -> [HtmlExp] -> HtmlExp
spHrefBlock ref hexps =
href ref hexps `addClass` "btn btn-small btn-block"
--- Hypertext reference in Spicey (rendered as an info block button):
spHrefInfoBlock :: String -> [HtmlExp] -> HtmlExp
spHrefInfoBlock ref hexps =
href ref hexps `addClass` "btn btn-info btn-block"
--- Input button in Spicey (rendered as a default button):
spButton :: String -> HtmlHandler -> HtmlExp
spButton label handler =
button label handler `addClass` "btn btn-default"
--- Primary input button in Spicey (rendered as a default primary button):
spPrimButton :: String -> HtmlHandler -> HtmlExp
spPrimButton label handler =
button label handler `addClass` "btn btn-primary"
--- Small input button in Spicey (rendered as a small button):
spSmallButton :: String -> HtmlHandler -> HtmlExp
spSmallButton label handler =
button label handler `addClass` "btn btn-sm btn-default"
--- Standard table in Spicey.
spTable :: [[[HtmlExp]]] -> HtmlExp
spTable items = table items `addClass` "table table-hover table-condensed"
--------------------------------------------------------------------------
-- Icons:
homeIcon = glyphicon "home"
userIcon = glyphicon "user"
loginIcon = glyphicon "log-in"
logoutIcon = glyphicon "log-out"
glyphicon n = textstyle ("glyphicon glyphicon-"++n) ""
--------------------------------------------------------------------------
-- The page messages are implemented by a session store.
-- We define a global variable to store a message which is shown
......
......@@ -8,6 +8,7 @@
module SpiceySystemView(loginView,processListView,historyView)
where
import Bootstrap3Style (defaultButton, primButton)
import UserProcesses
import Processes
import Spicey
......@@ -21,10 +22,10 @@ loginView controller currlogin =
case currlogin of
Nothing -> [h3 [htxt "Login as:"],
textfield loginfield "",
spButton "Login" loginHandler]
defaultButton "Login" loginHandler]
Just _ -> [h3 [htxt "Really logout?"],
spPrimButton "Logout" (logoutHandler True),
spButton "Cancel" (logoutHandler False)]
primButton "Logout" (logoutHandler True),
defaultButton "Cancel" (logoutHandler False)]
where
loginfield free
......
......@@ -32,6 +32,10 @@ dataModuleName = "RoutesData"
mappingModuleName :: String
mappingModuleName = "ControllerMapping"
-- Name of hrefButton operation: