hablog 0.4.0 → 0.4.1
raw patch · 6 files changed
+44/−23 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Web.Hablog.Config: themes :: [(String, Theme)]
Files
- README.md +2/−0
- app/Main.hs +14/−6
- hablog.cabal +1/−1
- src/Web/Hablog/Config.hs +6/−0
- src/Web/Hablog/Html.hs +15/−10
- src/Web/Hablog/Present.hs +6/−6
README.md view
@@ -1,6 +1,8 @@ Hablog ====== +[](http://hackage.haskell.org/package/hablog) [](https://circleci.com/gh/soupi/hablog)+ A simple blog platform with tags. Made with Haskell and Scotty. Hablog will read posts written in Markdown from the `_posts` folder.
app/Main.hs view
@@ -32,12 +32,20 @@ defaultConfig _ -> putStrLn usageMsgTLS- [portStr] ->- case reads portStr of- [(port, "")] ->- run defaultConfig port- _ ->- putStrLn usageMsg++ [themeStr]+ | Just theme <- lookup themeStr themes ->+ run defaultConfig { blogTheme = theme } defaultPort++ [portStr]+ | [(port, "")] <- reads portStr ->+ run defaultConfig port++ [themeStr,portStr]+ | Just theme <- lookup themeStr themes+ , [(port, "")] <- reads portStr ->+ run defaultConfig { blogTheme = theme } port+ _ -> putStrLn usageMsg
hablog.cabal view
@@ -1,5 +1,5 @@ Name: hablog-Version: 0.4.0+Version: 0.4.1 Synopsis: A blog system Description: blog system with tags License: MIT
src/Web/Hablog/Config.hs view
@@ -55,3 +55,9 @@ lightTheme :: Theme lightTheme = Theme "/static/css/light.css" "/static/highlight/styles/docco.css" ++themes :: [(String, Theme)]+themes =+ [("dark", darkTheme)+ ,("light", lightTheme)+ ]
src/Web/Hablog/Html.hs view
@@ -14,28 +14,33 @@ import qualified Web.Hablog.Post as Post import qualified Web.Hablog.Page as Page -template :: Config -> T.Text -> H.Html -> H.Html-template cfg title container =+template :: Config -> Bool -> T.Text -> H.Html -> H.Html+template cfg highlight title container = H.docTypeHtml $ do H.head $ do H.title (H.toHtml (T.concat [blogTitle cfg, " - ", title])) H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href (bgTheme $ blogTheme cfg)- H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href (codeTheme $ blogTheme cfg)+ if highlight+ then H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href (codeTheme $ blogTheme cfg)+ else mempty H.body $ do H.div ! A.class_ "container" $ do logo cfg H.div ! A.class_ "maincontainer" $ container footer- H.script ! A.src "static/highlight/highlight.pack.js" $ ""- H.script "hljs.initHighlightingOnLoad();"-+ if highlight+ then do+ H.script ! A.src "static/highlight/highlight.pack.js" $ ""+ H.script "hljs.initHighlightingOnLoad();"+ else+ mempty mainTemplate :: H.Html -> H.Html mainTemplate = H.article ! A.class_ "content" notFoundPage :: Config -> H.Html notFoundPage cfg =- template cfg "Not Found" $ mainTemplate $ do+ template cfg False "Not Found" $ mainTemplate $ do H.h1 "Not found" H.p "The page you search for is not available." @@ -49,7 +54,7 @@ errorPage :: Config -> T.Text -> String -> H.Html errorPage cfg ttl msg =- template cfg ttl $ do+ template cfg False ttl $ do H.h2 "Something Went Wrong..." H.p $ H.toHtml msg @@ -73,7 +78,7 @@ H.a ! A.href (fromString $ T.unpack ("/" `T.append` Post.getPath post)) $ H.toHtml $ Post.title post postPage :: Config -> Post.Post -> H.Html-postPage cfg post = template cfg (Post.title post) $+postPage cfg post = template cfg True (Post.title post) $ H.article ! A.class_ "post" $ do H.div ! A.class_ "postTitle" $ do H.a ! A.href (fromString $ T.unpack ("/" `T.append` Post.getPath post)) $ H.h2 ! A.class_ "postHeader" $ H.toHtml (Post.title post)@@ -86,7 +91,7 @@ H.div ! A.class_ "postContent" $ Post.content post pagePage :: Config -> Page.Page -> H.Html-pagePage cfg page = template cfg (Page.getPageName page) $+pagePage cfg page = template cfg True (Page.getPageName page) $ H.article ! A.class_ "post" $ do H.div ! A.class_ "postTitle" $ H.a ! A.href (fromString (Page.getPageURL page)) $ H.h2 ! A.class_ "postHeader" $ H.toHtml (Page.getPageName page)
src/Web/Hablog/Present.hs view
@@ -32,7 +32,7 @@ tgs <- liftIO getTagList auths <- liftIO getAuthorsList cfg <- getCfg- html $ HR.renderHtml $ template cfg "Posts" $ do+ html $ HR.renderHtml $ template cfg False "Posts" $ do H.aside ! A.class_ "aside" $ do presentPagesList allPages H.div ! A.class_ "AllAuthorsList" $ do@@ -47,7 +47,7 @@ showPostsWhere test = do cfg <- getCfg allPosts <- liftIO getAllPosts- html $ HR.renderHtml $ template cfg "Posts" $+ html $ HR.renderHtml $ template cfg False "Posts" $ postsListHtml $ filter test allPosts presentPagesList :: [Page.Page] -> H.Html@@ -91,7 +91,7 @@ presentTags = do cfg <- getCfg tags <- liftIO getTagList- html . HR.renderHtml $ template cfg "Posts Tags" tags+ html . HR.renderHtml $ template cfg False "Posts Tags" tags getTagList :: IO H.Html getTagList = pure . tagsList . getAllTags =<< getAllPosts@@ -107,19 +107,19 @@ presentTag tag = do cfg <- getCfg posts <- liftIO getAllPosts- html . HR.renderHtml . template cfg tag $ postsListHtml $ filter (hasTag tag) posts+ html . HR.renderHtml . template cfg False tag $ postsListHtml $ filter (hasTag tag) posts presentAuthors :: HablogAction () presentAuthors = do cfg <- getCfg authors <- liftIO getAuthorsList- html . HR.renderHtml $ template cfg "Posts Authors" authors+ html . HR.renderHtml $ template cfg False "Posts Authors" authors presentAuthor :: T.Text -> HablogAction () presentAuthor auth = do cfg <- getCfg posts <- liftIO getAllPosts- html . HR.renderHtml . template cfg auth . postsListHtml $ filter (hasAuthor auth) posts+ html . HR.renderHtml . template cfg False auth . postsListHtml $ filter (hasAuthor auth) posts getPageFromFile :: T.Text -> IO (Maybe Page.Page) getPageFromFile title = do