| Stability | experimental |
|---|---|
| Maintainer | woozletoff@gmail.com |
| Safe Haskell | None |
Web.RBB
Description
- data BlogConfig m = BlogConfig {
- baseURL :: m Text
- entryRenderer :: BlogConfig m -> [(Entry, Html)] -> m Html
- timeFormatter :: UTCTime -> Text
- entryPath :: FilePath
- updateInterval :: Integer
- createDefaultBlogConfig :: Monad m => FilePath -> BlogConfig m
- data Blog m
- getBlogConfig :: (Functor io, MonadIO io) => Blog m -> io (Maybe (BlogConfig m))
- withBlog :: BlogConfig m -> (Blog m -> IO ()) -> IO ()
- blogEntries :: (Functor io, MonadIO io, Monad m) => Blog m -> EntryQuery -> Maybe (IxSet Entry -> IxSet Entry) -> io (m Html)
- rbb :: IO () -> IO ()
- data Entry
- entryId :: Lens' Entry Integer
- title :: Lens' Entry Text
- author :: Lens' Entry Text
- authorEmail :: Lens' Entry Text
- tags :: Lens' Entry (Set Text)
- fileType :: Lens' Entry FileType
- newtype Title = Title {}
- newtype AuthorName = AuthorName {}
- newtype AuthorEmail = AuthorEmail {}
- newtype Tags = Tags {}
- newtype Index = Index {}
- data FileType
- def :: Default a => a
Configuration
The blog configuration is essentially done by setting the fields of the
BlogConfig data type. A basic configuration can be created with the
function createDefaultBlogConfig that only takes the absolutely necessary
parameters.
data BlogConfig m Source
Basic configuration of the blog.
The m type variable is just a context in which the functions can operate
on. It can be as simple as the Identity functor but also more complex to
play nice with libraries such as boomerang (which provides type-safe URLs).
These functions are usually called in an IO context and hence the context
can be some IO type as well.
Constructors
| BlogConfig | |
Fields
| |
createDefaultBlogConfig :: Monad m => FilePath -> BlogConfig mSource
Given the path to the blog entries, create a BlogConfig value that can
be used as an overrideable template with most fields using default values.
Usage
General
To use the blog in an web application, you have to create an abstact Blog
value via the withBlog function and pass it to functions that need access
to it because they call blog related functions.
importWeb.RBB
myBlogConfig = createDefaultBlogConfig
"/path/to/repository/with/blog/entries"
"/path/to/folder/with/static/resources"
main = withBlog myBlogConfig $ \blog -> do
putStrLn "Replace this with your web application code."
getBlogConfig :: (Functor io, MonadIO io) => Blog m -> io (Maybe (BlogConfig m))Source
Retrieve the BlogConfig from the Blog value. Due to the resuorce
managmeent that the Blog data type encapsulates, this function only works
inside an IO monad.
withBlog :: BlogConfig m -> (Blog m -> IO ()) -> IO ()Source
Create a Blog object by providing a BlogConfig value.
This function also starts threads which will handle the resource management
with some configurable settings that can be defined in the BlogConfig.
XMonad style usage
You can also define an xmonad-like configuration for your blog. If the few
functions from this module do not give you a basic idea on how to use this
library, a trivial example will not suffice.
The following example will contain two modules and for the sake of this
example, I will assume that the configuration is in
~/.config/repo-based-blog.
The first file is repo-based-blog.hs. It will containt the markup and a
minimal happstack server example. The blog will be present at
http://127.0.0.1:8000.
{-# LANGUAGE OverloadedStrings #-}
import Web.RBB
import Query
import Text.Blaze.Html5 as H
import Control.Applicative ((<$>), optional)
import Control.Monad
import Control.Monad.IO.Class
import Data.Text (Text, unpack)
import Happstack.Server
import Data.Maybe
import qualified Data.IxSet as IxSet
import System.Directory
import Text.Blaze.Html5.Attributes as A hiding (dir, start, id)
import Happstack.Server (Conf (port), notFound, nullConf, toResponse, simpleHTTP)
siteTemplate :: (Monad m, Functor m)
=> [Html] -- ^ Additional Headers
-> [Html] -- ^ Body content
-> m Html
siteTemplate hs bodyContent = return $ do
docType
html $ do
H.head $ do
meta ! httpEquiv "Content-Type"
! content "text/html;charset=utf-8"
meta ! content "width=device-width, initial-scale=1, maximum-scale=1"
! name "viewport"
link ! rel "stylesheet" ! type_ "text/css"
! href "resources/default.css"
sequence_ hs
H.body $ do
topNavigationBar [ ("Blog", Just "?")
, ("Github", Just "https://github.com/saep")
]
sequence_ bodyContent
topNavigationBar :: [(Html, Maybe String)] -> Html
topNavigationBar [] = return ()
topNavigationBar xs =
H.div ! class_ "horiz-nav" $
H.nav ! A.class_ "horiz-nav" $
ul ! class_ "horiz-nav" $
forM_ xs $ \(t, ml) ->
case ml of
Just l -> li $ a ! href (toValue l) $ t
_ -> li t
serveBlog :: Blog (ServerPartT IO)
-> ServerPartT IO Response
serveBlog blog = do
qd <- parseQueryRqData
mId <- join . fmap readMaybe <$> optional (look "id")
let qfun = fmap (IxSet.getEQ . Index) mId
entries <- join $ blogEntries blog qd qfun
blogMarkup <- siteTemplate hs [entries]
ok . toResponse $ blogMarkup -- happstack specific
where
hs = [ H.title "Saeptain's log" ]
myBlogConfig :: BlogConfig (ServerPartT IO)
myBlogConfig =
let cfg = createDefaultBlogConfig "/home/saep/git/myblog"
in cfg { baseURL = return "http://127.0.0.1:8000/blog" }
main :: IO ()
main = rbb $ withBlog myBlogConfig $ \b -> do
liftIO $ simpleHTTP (nullConf { port = 8000 }) $ msum
[ dir "resources" $ serveDirectory DisableBrowsing [] "/home/saep/git/blog/resources"
, serveBlog b
, notFound $ toResponse ()
]
The Query module, which you will be missing apart from the obvious missing
libraries is located in lib/Query.hs
module Query where
import Happstack.Server (look, HasRqData, ServerPartT)
import Web.RBB.Blog.Query
import Control.Applicative
import Data.Maybe
readMaybe :: Read a => String -> Maybe a
readMaybe x = case reads x of
[(v,_)] -> Just v
_ -> Nothing
-- | 'look' at the request data of the given name and try to parse it via
-- 'readMaybe'. If the parse failed or the request data did not exist, return
-- the provided default.
maybeLookAndRead :: (Monad m, Read a, Alternative m, HasRqData m)
=> a -> String -> m a
maybeLookAndRead a qry = do
l <- optional $ look qry
return $ fromMaybe a (maybe (Just a) readMaybe l)
-- | Parse the supported request data and present it in a data type.
parseQueryRqData :: ServerPartT IO EntryQuery
parseQueryRqData = EntryQuery
<$> (sortMethodToComparator
<$> maybeLookAndRead Update "sortBy"
<*> maybeLookAndRead Descending "sortOrder")
This function wrapping is needed to let the dyre library detect changes to
the configuration and recompile everything. Simply define your main in
~/.config/repo-based-blog/rbb.hs as follows:
importWeb.RBB
main = rbb $ do
putStrLn "Hello, World!"
Entry querying
Entry
Metadata for a blog entry.
Unique Entry identifier. It you do not mess with the repositories
history, this should be the same across restarts.
Title of the Entry.
Author of the Entry.
These newtype wrappers are used by the IxSet of Entry values and needed
for search queries.
queryEntryForIdentifier :: Ixset Entry -> Maybe Entry queryEntryForIdentifier set = getOne $ set @= Index 42
Newtype for Text
Newtype for Integer
FileType
Enumeration that contains all supported file type extensions for blog entries.
Constructors
| PandocMarkdown | |
| LiterateHaskell |