diff --git a/hl.cabal b/hl.cabal index 6054646..b29b06e 100644 --- a/hl.cabal +++ b/hl.cabal @@ -15,7 +15,8 @@ executable hl hs-source-dirs: src/ ghc-options: -Wall -O2 main-is: Main.hs - build-depends: monad-extras, + build-depends: blaze-html, + monad-extras, filepath, markdown, xml-conduit, @@ -30,8 +31,7 @@ executable hl yesod-static, base >= 4 && < 5, foreign-store, - blaze, - css, + senza, directory, pandoc, pandoc-types, diff --git a/src/Blaze/Prelude.hs b/src/Blaze/Prelude.hs deleted file mode 100644 index a314632..0000000 --- a/src/Blaze/Prelude.hs +++ /dev/null @@ -1,14 +0,0 @@ --- | A prelude for when using blaze-html. - -module Blaze.Prelude - (module Blaze.Attributes - ,module Blaze.Senza - ,module Prelude - ,AttributeValue - ,docTypeHtml) - where - -import Blaze.Attributes hiding (style,span) -import Blaze.Senza -import Blaze -import Prelude hiding (head,div,max,span,id,min) diff --git a/src/Blaze/Senza.hs b/src/Blaze/Senza.hs deleted file mode 100644 index 5e97c28..0000000 --- a/src/Blaze/Senza.hs +++ /dev/null @@ -1,73 +0,0 @@ --- | Blaze without attribute operators. - -module Blaze.Senza where - -import Blaze (with,Html) -import qualified Blaze.Elements as E -import Prelude () - -meta :: [E.Attribute] -> Html -meta = with E.meta - -headtitle :: Html -> Html -headtitle = E.title - -style :: [E.Attribute] -> Html -style = with E.link - -script :: [E.Attribute] -> Html -> Html -script = with E.script - -div :: [E.Attribute] -> Html -> Html -div = with E.div - -span :: [E.Attribute] -> Html -> Html -span = with E.span - -link :: [E.Attribute] -> Html -link = with E.link - -a :: [E.Attribute] -> Html -> Html -a = with E.a - -h1 :: [E.Attribute] -> Html -> Html -h1 = with E.h1 - -h2 :: [E.Attribute] -> Html -> Html -h2 = with E.h2 - -h3 :: [E.Attribute] -> Html -> Html -h3 = with E.h3 - -h4 :: [E.Attribute] -> Html -> Html -h4 = with E.h4 - -h5 :: [E.Attribute] -> Html -> Html -h5 = with E.h5 - -head :: [E.Attribute] -> Html -> Html -head = with E.head - -body :: [E.Attribute] -> Html -> Html -body = with E.body - -nav :: [E.Attribute] -> Html -> Html -nav = with E.nav - -ul :: [E.Attribute] -> Html -> Html -ul = with E.ul - -ol :: [E.Attribute] -> Html -> Html -ol = with E.ol - -li :: [E.Attribute] -> Html -> Html -li = with E.li - -p :: [E.Attribute] -> Html -> Html -p = with E.p - -pre :: [E.Attribute] -> Html -> Html -pre = with E.pre - -code :: [E.Attribute] -> Html -> Html -code = with E.code diff --git a/src/HL/C.hs b/src/HL/C.hs index 93f59f4..e91ff39 100644 --- a/src/HL/C.hs +++ b/src/HL/C.hs @@ -13,7 +13,7 @@ import HL.Foundation as C (Route(..),App(..)) import Control.Monad.Extra import Data.Text as C (Text) import Yesod as C -import Yesod.Blaze as C +import Yesod.Senza as C -- | Controller type. type C = Handler diff --git a/src/HL/C/Community.hs b/src/HL/C/Community.hs index 0090e4a..6c7ff8d 100644 --- a/src/HL/C/Community.hs +++ b/src/HL/C/Community.hs @@ -9,4 +9,4 @@ import HL.V.Community -- | Community controller. getCommunityR :: C Html -getCommunityR = blaze communityV +getCommunityR = senza communityV diff --git a/src/HL/C/Documentation.hs b/src/HL/C/Documentation.hs index bd9520c..b52c870 100644 --- a/src/HL/C/Documentation.hs +++ b/src/HL/C/Documentation.hs @@ -10,4 +10,4 @@ import HL.V.Documentation -- | Documentation controller. getDocumentationR :: C Html getDocumentationR = - blaze documentationV + senza documentationV diff --git a/src/HL/C/Home.hs b/src/HL/C/Home.hs index 500b209..df0a5fb 100644 --- a/src/HL/C/Home.hs +++ b/src/HL/C/Home.hs @@ -10,4 +10,4 @@ import HL.C -- | Home controller. getHomeR :: C Html getHomeR = - markdownPage [HomeR] "Home" "home.md" + markdownPage [] "Home" "home.md" diff --git a/src/HL/C/Markdown.hs b/src/HL/C/Markdown.hs index 44da570..eaef64d 100644 --- a/src/HL/C/Markdown.hs +++ b/src/HL/C/Markdown.hs @@ -12,4 +12,4 @@ import HL.V.Markdown markdownPage :: [Route App] -> Text -> FilePath -> C Html markdownPage crumbs t name = do content <- io (getMarkdown name) - blaze (markdownV crumbs t content) + senza (markdownV crumbs t content) diff --git a/src/HL/C/News.hs b/src/HL/C/News.hs index e67f262..926a21a 100644 --- a/src/HL/C/News.hs +++ b/src/HL/C/News.hs @@ -12,4 +12,4 @@ import HL.V.News getNewsR :: C Html getNewsR = do html <- io getHaskellNews - blaze (newsV html) + senza (newsV html) diff --git a/src/HL/C/Report.hs b/src/HL/C/Report.hs index cd5083d..7359279 100644 --- a/src/HL/C/Report.hs +++ b/src/HL/C/Report.hs @@ -10,7 +10,7 @@ import HL.M.Report getReportR :: Int -> FilePath -> C Html getReportR year page = do content <- io (getReportPage year page) - blaze (reportV year page content) + senza (reportV year page content) -- | Default page to go to for the given year. getReportHomeR :: Int -> C Html diff --git a/src/HL/C/Wiki.hs b/src/HL/C/Wiki.hs index 807ce6b..ed87b2f 100644 --- a/src/HL/C/Wiki.hs +++ b/src/HL/C/Wiki.hs @@ -22,4 +22,4 @@ getWikiR :: Text -> C Html getWikiR name = do url <- getUrlRender result <- io (getWikiPage name) - blaze (wikiV url result) + senza (wikiV url result) diff --git a/src/HL/V.hs b/src/HL/V.hs index 0d5d309..8be72cd 100644 --- a/src/HL/V.hs +++ b/src/HL/V.hs @@ -7,8 +7,9 @@ module HL.V import HL.Foundation as V (Route(..),App) import HL.Static as V -import Blaze.Bootstrap as V -import Blaze.Prelude as V -import Data.Text as V (Text) -import Yesod.Blaze as V import Control.Monad as V +import Data.Text as V (Text) +import Prelude as V hiding (span,head,min,max,id,div) +import Senza as V +import Senza.Bootstrap as V +import Yesod.Senza as V diff --git a/src/HL/V/Community.hs b/src/HL/V/Community.hs index 942deda..6b49c15 100644 --- a/src/HL/V/Community.hs +++ b/src/HL/V/Community.hs @@ -9,7 +9,7 @@ import HL.V hiding (list) import HL.V.Template -- | Community view. -communityV :: Blaze App +communityV :: FromSenza App communityV = template [CommunityR] diff --git a/src/HL/V/Documentation.hs b/src/HL/V/Documentation.hs index bea81ca..57dbc2c 100644 --- a/src/HL/V/Documentation.hs +++ b/src/HL/V/Documentation.hs @@ -10,7 +10,7 @@ import HL.V import HL.V.Template -- | Documentation view. -documentationV :: Blaze App +documentationV :: FromSenza App documentationV = template [DocumentationR] diff --git a/src/HL/V/Markdown.hs b/src/HL/V/Markdown.hs index 2137054..680a084 100644 --- a/src/HL/V/Markdown.hs +++ b/src/HL/V/Markdown.hs @@ -8,7 +8,7 @@ import HL.V import HL.V.Template -- | Render a simple page. -markdownV :: [Route App] -> Text -> Html -> Blaze App +markdownV :: [Route App] -> Text -> Html -> FromSenza App markdownV routes t inner = template routes diff --git a/src/HL/V/News.hs b/src/HL/V/News.hs index 5f722f5..ac5ed57 100644 --- a/src/HL/V/News.hs +++ b/src/HL/V/News.hs @@ -9,7 +9,7 @@ import HL.V import HL.V.Template -- | News view. -newsV :: Html -> Blaze App +newsV :: Html -> FromSenza App newsV inner = template [NewsR] diff --git a/src/HL/V/Report.hs b/src/HL/V/Report.hs index 831a545..e426b9a 100644 --- a/src/HL/V/Report.hs +++ b/src/HL/V/Report.hs @@ -9,7 +9,7 @@ import HL.V import HL.V.Template -- | Report view. -reportV :: Int -> FilePath -> Html -> Blaze App +reportV :: Int -> FilePath -> Html -> FromSenza App reportV year _ inner = template [DocumentationR diff --git a/src/HL/V/Template.hs b/src/HL/V/Template.hs index a77a37f..6186a4d 100644 --- a/src/HL/V/Template.hs +++ b/src/HL/V/Template.hs @@ -6,19 +6,18 @@ module HL.V.Template where -import HL.V hiding (item) +import HL.V hiding (item) -import qualified Blaze.Elements as E -import Data.Maybe -import Data.Monoid -import Data.Text (pack) +import Data.Maybe +import Data.Monoid +import Data.Text (pack) -- | Render a template. template :: [Route App] -> Text -> ((Route App -> AttributeValue) -> Html) - -> Blaze App + -> FromSenza App template crumbs ptitle inner url = docTypeHtml (do head [] @@ -57,7 +56,7 @@ template crumbs ptitle inner url = ,href (url route)]) -- | Main navigation. -navigation :: Maybe (Route App) -> Blaze App +navigation :: Maybe (Route App) -> FromSenza App navigation cur url = nav [class_ "navbar navbar-default"] (div [class_ "container"] @@ -88,7 +87,7 @@ navigation cur url = "Haskell")) -- | Breadcrumb. -bread :: (Route App -> E.AttributeValue) -> [Route App] -> Html +bread :: (Route App -> AttributeValue) -> [Route App] -> Html bread url crumbs = ol [class_ "breadcrumb"] (forM_ crumbs diff --git a/src/HL/V/Wiki.hs b/src/HL/V/Wiki.hs index 3898fa7..eee6982 100644 --- a/src/HL/V/Wiki.hs +++ b/src/HL/V/Wiki.hs @@ -19,7 +19,7 @@ import Text.Pandoc.Walk import Text.Pandoc.Writers.HTML -- | Wiki view. -wikiV :: (Route App -> Text) -> Either Text (Text,Pandoc) -> Blaze App +wikiV :: (Route App -> Text) -> Either Text (Text,Pandoc) -> FromSenza App wikiV urlr result = template ([WikiHomeR] ++ diff --git a/src/Main.hs b/src/Main.hs index d7c3ab6..433fa2e 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,14 +2,12 @@ module Main where -import HL.Foundation -import HL.Dispatch () +import HL.Dispatch () +import HL.Foundation -import Control.Concurrent.Chan -import qualified Data.Text.Lazy.IO as L -import System.Directory -import Yesod -import Yesod.Static +import Control.Concurrent.Chan +import Yesod +import Yesod.Static -- | Main entry point. main :: IO () diff --git a/src/Yesod/Blaze.hs b/src/Yesod/Blaze.hs deleted file mode 100644 index aeca5f2..0000000 --- a/src/Yesod/Blaze.hs +++ /dev/null @@ -1,21 +0,0 @@ --- | Useful utilities for using blaze-html with Yesod. - -module Yesod.Blaze - (module Yesod.Blaze - ,module Yesod) - where - -import Yesod hiding (object) -import Blaze - --- | A blaze generator. -type Blaze a = - (Route a -> AttributeValue) -> - Html - --- | Output some blaze, passes a URL renderer to the continuation. -blaze :: MonadHandler m => Blaze (HandlerSite m) -> m Html -blaze cont = - do render <- getUrlRender - return - (cont (toValue . render)) diff --git a/src/Yesod/Senza.hs b/src/Yesod/Senza.hs new file mode 100644 index 0000000..7f4d71a --- /dev/null +++ b/src/Yesod/Senza.hs @@ -0,0 +1,21 @@ +-- | Useful utilities for using Senza with Yesod. + +module Yesod.Senza + (module Yesod.Senza + ,module Yesod) + where + +import Senza +import Yesod + +-- | A senza generator. +type FromSenza a = + (Route a -> AttributeValue) -> + Senza + +-- | Output some senza, passes a URL renderer to the continuation. +senza :: MonadHandler m => FromSenza (HandlerSite m) -> m Html +senza cont = + do render <- getUrlRender + return + (cont (toValue . render))