diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Athan Clark + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Athan Clark nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/generic-lucid-scaffold.cabal b/generic-lucid-scaffold.cabal new file mode 100644 --- /dev/null +++ b/generic-lucid-scaffold.cabal @@ -0,0 +1,51 @@ +Name: generic-lucid-scaffold +Version: 0.0.1 +Author: Athan Clark +Maintainer: Athan Clark +License: MIT +License-File: LICENSE +Synopsis: General-purpose web page scaffold for Lucid. +Description: + This is a general organization scheme for web pages, implemented for Lucid. + . + It's as easy as 1-2-3: + . + > λ> renderText $ template mempty "some content" + > + > ↪ " rel="icon">some content" + . + overload the particular areas with record syntax and stuff: + . + > λ> let page = WebPage + > "foo" + > mempty + > mempty + > mempty + > mempty + > mempty + > mempty + > (script_ [src_ "jquery.js"] "") + > + > + > λ> template page "some content" + > + > ↪ "foo rel=\"icon\">some content" + . +Cabal-Version: >= 1.10 +Build-Type: Simple + +Library + Default-Language: Haskell2010 + HS-Source-Dirs: src + GHC-Options: -Wall + Exposed-Modules: Lucid.Scaffold + Build-Depends: base >= 4 && < 5 + , lucid >= 2.5 + , text + +Source-Repository head + Type: git + Location: https://github.com/athanclark/generic-lucid-scaffold.git diff --git a/src/Lucid/Scaffold.hs b/src/Lucid/Scaffold.hs new file mode 100644 --- /dev/null +++ b/src/Lucid/Scaffold.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE BangPatterns #-} + +module Lucid.Scaffold where + + +import Lucid +import Lucid.Base + +import qualified Data.Text as T + +import Data.Monoid + +data WebPage m = WebPage { pageTitle :: T.Text -- ^ Page title + , favicon :: T.Text -- ^ Favicon url + , metaVars :: (HtmlT m ()) -- ^ @\@ tags + , initScripts :: (HtmlT m ()) -- ^ JavaScript to include at the top of the page + , beforeStylesScripts :: (HtmlT m ()) -- ^ JavaScript to include before @\@ tags + , styles :: (HtmlT m ()) -- ^ Styles + , afterStylesScripts :: (HtmlT m ()) -- ^ JavaScript to include after @\@ tags - ie: + , bodyScripts :: (HtmlT m ()) -- ^ JavaScript to include at the base of @\@ + } + + +instance Monad m => Monoid (WebPage m) where + mempty = WebPage "" "" mempty mempty mempty mempty mempty mempty + mappend x _ = x -- Some people just want to watch the world burn. + +template :: Monad m => + WebPage m -- ^ Page information + -> HtmlT m () -- ^ Content to insert in @\@ + -> HtmlT m () +template page content = doctypehtml_ $ mconcat $ + [ head_ [] $ mconcat $ + [ initScripts page + , title_ $ toHtmlRaw $ pageTitle page + , metaVars page + , link_ [ rel_ "icon" + , href_ $ favicon page + ] + , beforeStylesScripts page + , styles page + , afterStylesScripts page + ] + , body_ [] $ mconcat $ + [ content + , bodyScripts page + ] + ] +