diff --git a/src/Foundation.hs b/src/Foundation.hs index 4dcc73a13..f19b46633 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -330,18 +330,20 @@ defaultMenuLayout menu widget = do -- value passed to hamletToRepHtml cannot be a widget, this allows -- you to use normal widget features in default-layout. - pc <- widgetToPageContent $ do - -- addStylesheet $ StaticR css_globals_lucius - $(widgetFile "default-layout") - withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") - where - navbar :: [MenuTypes] -> Maybe (Route UniWorX) -> Widget - navbar menuTypes mcurrentRoute = $(widgetFile "widgets/navbar") - asidenav :: [MenuTypes] -> Maybe (Route UniWorX) -> Widget - asidenav menuTypes mcurrentRoute = $(widgetFile "widgets/asidenav") - breadcrumbsList :: [(Route UniWorX, Text)] -> Text -> Widget - breadcrumbsList parents title = $(widgetFile "widgets/breadcrumbs") + let + navbar :: Widget + navbar = $(widgetFile "widgets/navbar") + asidenav :: Widget + asidenav = $(widgetFile "widgets/asidenav") + breadcrumbs :: Widget + breadcrumbs = $(widgetFile "widgets/breadcrumbs") + pc <- widgetToPageContent $ do + addStylesheetRemote "https://fonts.googleapis.com/css?family=Source+Sans+Pro:300,400,600,800,900" + $(widgetFile "default-layout") + $(widgetFile "standalone/showHide") + $(widgetFile "standalone/sortable") + withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") -- How to run database actions. instance YesodPersist UniWorX where diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index 736d611a0..d8fb47dd1 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -43,12 +43,6 @@ getHomeR :: Handler Html getHomeR = do (btnWdgt, btnEnctype) <- generateFormPost (buttonForm :: Form CreateButton) defaultLayout $ do - addStylesheet $ StaticR css_show_hide_css - addStylesheet $ StaticR css_sortable_css - addStylesheet $ StaticR css_reactive_input_css - addScript $ StaticR js_show_hide_js - addScript $ StaticR js_sortable_js - addScript $ StaticR js_reactive_input_js setTitle "Willkommen zum ReWorX Test!" $(widgetFile "home") diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index b286f7a73..5f0b3905a 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -8,7 +8,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ViewPatterns #-} -module Handler.Utils.Form where +module Handler.Utils.Form where import Import import qualified Data.Char as Char @@ -21,7 +21,7 @@ import qualified Data.Foldable as Foldable import qualified Data.Text as T -- import Yesod.Form.Types import Yesod.Form.Functions (parseHelper) -import Yesod.Form.Bootstrap3 +import Yesod.Form.Bootstrap3 import qualified Text.Blaze.Internal as Blaze (null) @@ -35,7 +35,7 @@ data FormIdentifier = FIDcourse | FIDsheet deriving (Enum, Eq, Ord, Bounded, Read, Show) -identForm :: FormIdentifier -> Form a -> Form a +identForm :: FormIdentifier -> Form a -> Form a identForm fid = identifyForm (T.pack $ show fid) ------------------- @@ -48,7 +48,7 @@ data FormLayout = FormStandard renderAForm :: Monad m => FormLayout -> FormRender m a renderAForm formLayout aform fragment = do (res, (($ []) -> views)) <- aFormToForm aform - let widget = $(widgetFile "form") + let widget = $(widgetFile "widgets/form") return (res, widget) ---------------------------- @@ -67,12 +67,12 @@ class (Enum a, Bounded a, Ord a, PathPiece a) => Button a where cssClass :: a -> ButtonCssClass cssClass _ = BCDefault - - ---Some standard Buttons useful throughout + + +--Some standard Buttons useful throughout data StandardButton = BtnDelete | BtnAbort | BtnSave deriving (Enum, Eq, Ord, Bounded, Read, Show) - + instance PathPiece StandardButton where -- for displaying the button only, not really for paths toPathPiece = showToPathPiece fromPathPiece = readFromPathPiece @@ -81,7 +81,7 @@ instance Button StandardButton where label BtnDelete = "Löschen" label BtnAbort = "Abbrechen" label BtnSave = "Speichern" - + cssClass BtnDelete = BCWarning cssClass BtnAbort = BCDefault cssClass BtnSave = BCPrimary @@ -97,45 +97,45 @@ instance Button SubmitButton where label BtnSubmit = "Submit" cssClass BtnSubmit = BCPrimary - --- -- Looks like a button, but is just a link (e.g. for create course, etc.) + +-- -- Looks like a button, but is just a link (e.g. for create course, etc.) -- data LinkButton = LinkButton (Route UniWorX) -- deriving (Enum, Eq, Ord, Bounded, Read, Show) --- +-- -- instance PathPiece LinkButton where -- LinkButton route = ??? - + linkButton :: Widget -> ButtonCssClass -> Route UniWorX -> Widget linkButton lbl cls url = [whamlet| ^{lbl} |] -- [whamlet| ---
+-- -- --