diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,8 @@ Hablog ====== +[![Hackage](https://img.shields.io/hackage/v/hablog.svg)](http://hackage.haskell.org/package/hablog) [![CircleCI](https://circleci.com/gh/soupi/hablog.svg?style=svg)](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. diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/hablog.cabal b/hablog.cabal --- a/hablog.cabal +++ b/hablog.cabal @@ -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 diff --git a/src/Web/Hablog/Config.hs b/src/Web/Hablog/Config.hs --- a/src/Web/Hablog/Config.hs +++ b/src/Web/Hablog/Config.hs @@ -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) + ] diff --git a/src/Web/Hablog/Html.hs b/src/Web/Hablog/Html.hs --- a/src/Web/Hablog/Html.hs +++ b/src/Web/Hablog/Html.hs @@ -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) diff --git a/src/Web/Hablog/Present.hs b/src/Web/Hablog/Present.hs --- a/src/Web/Hablog/Present.hs +++ b/src/Web/Hablog/Present.hs @@ -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