packages feed

web-page (empty) → 0.1.0

raw patch · 9 files changed

+575/−0 lines, 9 filesdep +basedep +blaze-htmldep +bytestringsetup-changed

Dependencies added: base, blaze-html, bytestring, clay, containers, jmacro, lens, mtl, text, web-page, wl-pprint-text

Files

+ LICENSE view
@@ -0,0 +1,32 @@+web-page license+Copyright (c) 2014, Ertugrul Soeylemez++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 the author nor the names of any 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.
+ README.md view
@@ -0,0 +1,7 @@+Web-page+========++This package combines blaze-html, clay, jmacro and web-routes into a+framework-agnostic library to generate web pages dynamically from+individual components.  It is inspired by Yesod's widgets, but is more+general, more powerful and can be used with other web frameworks.
+ Setup.lhs view
@@ -0,0 +1,12 @@+web-page setup script+Copyright (C) 2014, Ertugrul Soeylemez++Please see the LICENSE file for terms and conditions of use,+modification and distribution of this package, including this file.++> module Main where+>+> import Distribution.Simple+>+> main :: IO ()+> main = defaultMain
+ Web/Page.hs view
@@ -0,0 +1,19 @@+-- |+-- Module:     Web.Page+-- Copyright:  (c) 2014 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <ertesx@gmx.de>++module Web.Page+    ( -- * Reexports+      module Web.Page.Render,+      module Web.Page.Widget,++      -- * External+      module Control.Monad.Writer.Strict+    )+    where++import Control.Monad.Writer.Strict+import Web.Page.Render+import Web.Page.Widget
+ Web/Page/Render.hs view
@@ -0,0 +1,140 @@+-- |+-- Module:     Web.Page.Render+-- Copyright:  (c) 2014 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <ertesx@gmx.de>+--+-- This module provides the functionality to render web pages.  This is+-- the process to construct and then render a web page:+--+--  1. Use a writer monad to construct a 'Widget', which represents a+--     web page component and is usually constructed from multiple+--     smaller components,+--+--  2. use one of the rendering functions to render a widget to a+--     'Page', which represents a rendered web page, but still abstracts+--     over the exact set of documents (everything inline or a set of+--     separate documents for markup, script and style),+--+--  3. turn the page into a set of documents that you can deliver to the+--     client, for example by using 'inlinePage'.+--+-- The motivation for rendering to separate documents is that most web+-- pages consist of dynamic markup, but the stylesheet and script is+-- mostly static.  The way 'Page' works you can have widgets with+-- batteries included and still render to separate documents to utilise+-- the client's cache better.+--+-- Helper functions for doing that are defined in this module, but+-- framework-specific support is necessary to make this work.++module Web.Page.Render+    ( -- * Rendering pages+      Page(..),+      renderWidget,++      -- * Single document+      inlinePage+    )+    where++import qualified Clay+import qualified Data.ByteString.Lazy as Bl+import qualified Data.Map.Strict as M+import qualified Data.Text.Lazy as Tl+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A+import qualified Text.PrettyPrint.Leijen.Text as Pp+import Data.Foldable (foldMap)+import Data.Monoid+import Data.Text (Text)+import Language.Javascript.JMacro (renderJs)+import Text.Blaze.Html+import Text.Blaze.Html.Renderer.Utf8+import Web.Page.Widget+++-- | Rendered pages.  This type supports rendering to multiple documents+-- like an HTML document, as explained above.+--+-- If you're running a low-traffic site and don't want to afford the+-- complexity, then you can just include the stylesheets and scripts+-- inline by using the 'inlinePage' function.  Except for external+-- script and style URLs this will give you a self-contained document+-- that you can deliver to the client.+--+-- The 'pageHtml' field is the function that takes the markup for the+-- script and the style respectively and returns a lazy bytestring that+-- you can send as @text/html@ to the client.  The other two fields are+-- the rendered script and stylesheet.  The markup is UTF-8-encoded,+-- which you should indicate in the @content-type@ header, if you+-- deliver via HTTP.++data Page =+    Page {+      pageHtml   :: Html -> Html -> Bl.ByteString,  -- ^ Markup document.+      pageScript :: Tl.Text,                        -- ^ Page script.+      pageStyle  :: Tl.Text                         -- ^ Page stylesheet.+    }+++-- | Render the given page to a single self-contained document,+-- including the script and stylesheet inline.++inlinePage :: Page -> Bl.ByteString+inlinePage p = pageHtml p scInc stInc+    where+    Page { pageScript = sc,+           pageStyle  = st+         } = p++    scInc | Tl.null sc = mempty+          | otherwise  = H.script (toHtml sc)++    stInc | Tl.null st = mempty+          | otherwise  = H.style (toHtml st)+++-- | This is the most general rendering function for widgets.++renderWidget ::+    (Ord k)+    => [k]               -- ^ Sections to render.+    -> ([Text] -> Text)  -- ^ Title renderer.+    -> Widget k Text     -- ^ Widget to render.+    -> Page+renderWidget ss renderTitle w =+    Page { pageHtml   = \scInc stInc -> renderHtml (html scInc stInc),+           pageScript = Pp.displayT . Pp.renderOneLine . renderJs . _wScript $ w,+           pageStyle  = Clay.renderWith Clay.compact [] . _wStyle $ w }++    where+    html :: Html -> Html -> Html+    html scInc stInc =+        H.docType <>+        H.html (H.head headH <>+                H.body bodyH)++        where+        bodyH =+            foldMap section ss <>+            foldMap scLink (_wScriptLinks w) <>+            scInc++        headH =+            H.title (toHtml title) <>+            _wHead w <>+            foldMap stLink (_wStyleLinks w) <>+            stInc++        section =+            maybe mempty id .+            (`M.lookup` _wSections w)++        scLink url = H.script mempty ! A.src (toValue url)++        stLink url =+            H.link ! A.rel "stylesheet"+                   ! A.href (toValue url)++        title = renderTitle . maybe [] id . getLast . _wTitle $ w
+ Web/Page/Widget.hs view
@@ -0,0 +1,219 @@+-- |+-- Module:     Web.Page.Widget+-- Copyright:  (c) 2014 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <ertesx@gmx.de>+--+-- A widget is a self-contained web page component represented by the+-- 'Widget' type.  This type is a family of monoids, so you can use it+-- together with a writer monad.++module Web.Page.Widget+    ( -- * Page widgets+      Widget(..),++      -- * Widget actions+      MonadWidget,+      WidgetWriter,++      -- * Constructing widgets+      addBody,+      addHead,+      addScript,+      addScriptLink,+      addSection,+      addStyle,+      addStyleLink,+      setTitle,+      withTitle,++      -- * Widget lenses+      wHead,+      wScript,+      wScriptLinks,+      wSections,+      wStyle,+      wStyleLinks,+      wTitle+    )+    where++import qualified Data.Map.Strict as M+import qualified Data.Set as S+import Clay (Css)+import Control.Applicative+import Control.Lens+import Control.Monad.Writer.Class+import Data.Foldable (Foldable)+import Data.Map (Map)+import Data.Monoid+import Data.Set (Set)+import Data.Text (Text)+import Data.Typeable+import Language.Javascript.JMacro (JStat)+import Text.Blaze.Html+++-- | Convenient constraint alias for widget actions.++type MonadWidget k url = MonadWriter (Widget k url)+++-- | A widget is a self-contained fragment of a web page together with+-- its scripts and styles.  This type is inspired by Yesod's widgets,+-- but is supposed to be constructed by using a writer monad and may not+-- denote effects of its own.+--+-- To construct widgets through a writer monad, use lens combinators+-- like 'scribe' and 'censoring'.  Alternatively you can use the @add*@+-- functions like 'addSection' or 'addStyle'.  The title is constructed+-- by using 'withTitle' and 'setTitle'.  This allows you to have a+-- hierarchy of titles with a site title, a page title and even a+-- component title.+--+-- The first type argument is the key type for the individual body+-- sections of the resulting document.  You can use it for example to+-- divide your document into a header, a menu, a content area and a+-- footer and each widget can add to them individually.+--+-- The second type argument is the type of URLs.  You may use it for+-- type-safe routing.++data Widget k url =+    Widget {+      _wHead        :: Html,        -- ^ Head content.+      _wScript      :: JStat,       -- ^ Inline scripts.+      _wScriptLinks :: Set url,     -- ^ External scripts.+      _wSections    :: Map k Html,  -- ^ Contents of body sections.+      _wStyle       :: Css,         -- ^ Stylesheet.+      _wStyleLinks  :: Set url,     -- ^ External stylesheets.+      _wTitle       :: Last [Text]  -- ^ Page title chunks (outermost first).+    }+    deriving (Foldable, Typeable)++instance (Ord k, Ord url) => Monoid (Widget k url) where+    mempty =+        Widget { _wHead        = mempty,+                 _wScript      = mempty,+                 _wScriptLinks = mempty,+                 _wSections    = M.empty,+                 _wStyle       = return (),+                 _wStyleLinks  = mempty,+                 _wTitle       = mempty }++    mappend w1 w2 =+        Widget { _wHead        = _wHead w1 <> _wHead w2,+                 _wScript      = _wScript w1 <> _wScript w2,+                 _wScriptLinks = _wScriptLinks w1 <> _wScriptLinks w2,+                 _wSections    = M.unionWith (<>) (_wSections w1) (_wSections w2),+                 _wStyle       = _wStyle w1 >> _wStyle w2,+                 _wStyleLinks  = _wStyleLinks w1 <> _wStyleLinks w2,+                 _wTitle       = _wTitle w1 <> _wTitle w2 }+++-- | Convenient type alias for polymorphic widget actions.++type WidgetWriter k url a = forall m. (MonadWidget k url m) => m a+++-- | Construct a widget with the given body.  Use this combinator if you+-- don't need sections.++addBody :: (MonadWriter (Widget () url) m) => Html -> m ()+addBody = addSection ()+++-- | Construct a widget with the given head markup.++addHead :: (MonadWriter (Widget k url) m) => Html -> m ()+addHead = scribe wHead+++-- | Construct a widget with the given script.++addScript :: (MonadWriter (Widget k url) m) => JStat -> m ()+addScript = scribe wScript+++-- | Construct a widget with the given script link.++addScriptLink :: (MonadWriter (Widget k url) m) => url -> m ()+addScriptLink url = scribe wScriptLinks (S.singleton url)+++-- | Construct a widget with the given body section.++addSection :: (MonadWriter (Widget k url) m) => k -> Html -> m ()+addSection k = scribe wSections . M.singleton k+++-- | Construct a widget with the given stylesheet.++addStyle :: (MonadWriter (Widget k url) m) => Css -> m ()+addStyle = scribe wStyle+++-- | Construct a widget with the given style link.++addStyleLink :: (MonadWriter (Widget k url) m) => url -> m ()+addStyleLink url = scribe wStyleLinks (S.singleton url)+++-- | Scribe the title of the widget.  Use this function to construct the+-- lowest level title.  For higher level titles use 'withTitle'.++setTitle :: (MonadWriter (Widget k url) m) => Text -> m ()+setTitle x = scribe wTitle (Last (Just [x]))+++-- | Lens into a widget's head.++wHead :: Lens' (Widget k url) Html+wHead l w = (\x -> w { _wHead = x }) <$> l (_wHead w)+++-- | Prepend the given title chunk to the given widget action.+-- Conceptually this wraps the given widget in a higher level title.+-- Use 'setTitle' for the lowest level title.++withTitle :: (MonadWriter (Widget k url) m) => Text -> m a -> m a+withTitle x = censoring wTitle f+    where+    f (Last Nothing)   = Last Nothing+    f (Last (Just xs)) = Last (Just (x:xs))+++-- | Lens into a widget's inline script.++wScript :: Lens' (Widget k url) JStat+wScript l w = (\x -> w { _wScript = x }) <$> l (_wScript w)+++-- | Lens into a widget's external scripts.++wScriptLinks :: Lens' (Widget k url) (Set url)+wScriptLinks l w = (\x -> w { _wScriptLinks = x }) <$> l (_wScriptLinks w)+++-- | Lens into a widget's body sections.++wSections :: Lens' (Widget k url) (Map k Html)+wSections l w = (\x -> w { _wSections = x }) <$> l (_wSections w)+++-- | Lens into a widget's inline style.++wStyle :: Lens' (Widget k url) Css+wStyle l w = (\x -> w { _wStyle = x }) <$> l (_wStyle w)+++-- | Lens into a widget's external styles.++wStyleLinks :: Lens' (Widget k url) (Set url)+wStyleLinks l w = (\x -> w { _wStyleLinks = x }) <$> l (_wStyleLinks w)+++-- | Lens into a widget's title.++wTitle :: Lens' (Widget k url) (Last [Text])+wTitle l w = (\x -> w { _wTitle = x }) <$> l (_wTitle w)
+ default.nix view
@@ -0,0 +1,29 @@+# -*-conf-*-++{ pkgs ? import <nixpkgs> { }, devel ? false }:++let hs = pkgs.haskellPackages;+    inherit (hs) cabal;++    develDepends = with hs; [+    ];+in++cabal.mkDerivation (self : rec {+    pname = "web-page";+    version = "0.1.0";+    isExecutable = false;+    isLibrary = true;+    preConfigure = ''rm -rf dist'';+    src = if devel then ./. else pkgs.fetchdarcs { url = ./.; };++    buildDepends = with hs; [+        blazeHtml+        clay+        jmacro+        lens+        mtl+        webRoutes+        wlPprintText+    ] ++ (if devel then develDepends else []);+})
+ test/Test.hs view
@@ -0,0 +1,43 @@+-- |+-- Module:     Main+-- Copyright:  (c) 2014 Ertugrul Soeylemez+-- License:    BSD3+-- Maintainer: Ertugrul Soeylemez <ertesx@gmx.de>++module Main where++import qualified Data.ByteString.Lazy.Char8 as Blc+import qualified Data.Text as T+import qualified Text.Blaze.Html5 as H+import Clay+import Data.Text (Text)+import Language.Javascript.JMacro+import Web.Page+++data Section = Header | Content | Footer+    deriving (Eq, Ord, Show)+++myWidget :: WidgetWriter Section Text ()+myWidget =+    withTitle "Test site" $ do+        setTitle "Test page"+        addSection Footer (H.p "copyright crap")+        addScript [jmacro| alert("haha") |]+        addSection Header (H.h1 "blah")+        addStyle $ "html" ? do+            background white+            color black++        addScriptLink "/js/blah.js"+        addStyleLink "/style/screen.css"+++main :: IO ()+main = do+    let w = execWriter myWidget+        p = renderWidget [Header, Content, Footer] (T.intercalate " - ") w+        d = inlinePage p++    Blc.putStrLn d
+ web-page.cabal view
@@ -0,0 +1,74 @@+name:          web-page+version:       0.1.0+category:      Web+synopsis:      Monoidally construct web pages+maintainer:    Ertugrul Söylemez <ertesx@gmx.de>+author:        Ertugrul Söylemez <ertesx@gmx.de>+copyright:     (c) 2014 Ertugrul Söylemez+license:       BSD3+license-file:  LICENSE+build-type:    Simple+cabal-version: >= 1.10+extra-source-files: README.md default.nix+description:+    This package combines blaze-html, clay, jmacro and web-routes into a+    framework-agnostic library to generate web pages dynamically from+    individual components.  It is inspired by Yesod's widgets, but is+    more general, more powerful and can be used with other web+    frameworks.++flag TestProgram+    default: False+    description: Build the test program+    manual: True++source-repository head+    type:     darcs+    location: http://hub.darcs.net/ertes/web-page++library+    build-depends:+        base           >= 4.5  && < 5,+        blaze-html     >= 0.7  && < 1,+        bytestring     >= 0.10 && < 1,+        clay           >= 0.9  && < 1,+        containers     >= 0.5  && < 1,+        jmacro         >= 0.6  && < 1,+        lens           >= 4.4  && < 5,+        mtl            >= 2.1  && < 3,+        text           >= 1.0  && < 2,+        wl-pprint-text >= 1.1  && < 2+    default-language: Haskell2010+    default-extensions:+        ConstraintKinds+        DeriveDataTypeable+        DeriveFoldable+        FlexibleContexts+        OverloadedStrings+        RankNTypes+    ghc-options: -W+    exposed-modules:+        Web.Page+        Web.Page.Render+        Web.Page.Widget++executable web-page-test+    if flag(testprogram)+        build-depends:+            base >= 4.5 && < 5,+            blaze-html,+            bytestring,+            clay,+            jmacro,+            text,+            web-page+    else+        buildable: False+    default-language: Haskell2010+    default-extensions:+        FlexibleContexts+        OverloadedStrings+        QuasiQuotes+    ghc-options: -threaded -rtsopts+    hs-source-dirs: test+    main-is: Test.hs