Added a test path and fixed blog rendering.

diff --git a/Vagrantfile b/Vagrantfile
index eec7552..bd5a7d7 100644 (file)
--- a/Vagrantfile
+++ b/Vagrantfile
@@ -15,6 +15,7 @@ sudo stack --allow-different-user test
 SCRIPT
 
 $run = <<-SCRIPT
+sudo killall website
 cd /vagrant
 sudo stack --allow-different-user exec website
 SCRIPT

diff --git a/package.yaml b/package.yaml
index 0c66009..d4a2c73 100644 (file)
--- a/package.yaml
+++ b/package.yaml
@@ -25,6 +25,7 @@ dependencies:
 - bytestring == 0.10.12.0
 - cmark == 0.6
 - containers == 0.6.2.1
+- directory == 1.3.6.0
 - http-media == 0.8.0.0
 - lucid == 2.9.12.1
 - mtl == 2.2.2

diff --git a/src/RenderBlog.hs b/src/RenderBlog.hs
index 204efda..ea5f826 100644 (file)
--- a/src/RenderBlog.hs
+++ b/src/RenderBlog.hs
@@ -1,17 +1,8 @@
 module RenderBlog (renderBlog) where
 
-import CMark (Node(..), CMarkOption(..), nodeToHtml, commonmarkToNode, optSafe)
+import CMark (commonmarkToHtml)
 import Lucid (Html(..), toHtmlRaw)
 import qualified Data.Text as T
 
 renderBlog :: T.Text -> Html ()
-renderBlog = renderNode . cssToNode
-
-cmarkOptions :: [CMarkOption]
-cmarkOptions = [optSafe]
-
-cssToNode :: T.Text -> Node
-cssToNode = commonmarkToNode cmarkOptions
-
-renderNode :: Node -> Html ()
-renderNode = toHtmlRaw . nodeToHtml cmarkOptions
+renderBlog = toHtmlRaw . commonmarkToHtml []

diff --git a/src/Server.hs b/src/Server.hs
index 4af5b38..5c957e0 100644 (file)
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -1,11 +1,13 @@
 module Server where
 
+import Control.Monad ((<=<))
 import Control.Monad.IO.Class (liftIO)
 import CssContentType
 import Lucid
 import RenderBlog (renderBlog)
 import Servant
 import Servant.HTML.Lucid (HTML(..))
+import System.Directory (getCurrentDirectory)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 
@@ -15,17 +17,18 @@ app = serve apiProxy api
 apiProxy :: Proxy Api
 apiProxy = Proxy
 
-type Api = MainPage :<|> BlogPost :<|> Themes
+type Api = MainPage :<|> BlogPost :<|> Themes :<|> TestPage
 type MainPage = Get '[HTML] (Html ())
-type BlogPost = "blog" :> QueryParam "id" BlogId :> Get '[HTML] (Html ())
+type BlogPost = "blog" :> Capture "id" BlogId :> Get '[HTML] (Html ())
 type Themes = DarkTheme :<|> LightTheme
 type DarkTheme = "dark" :> Get '[CSS] T.Text
 type LightTheme = "light" :> Get '[CSS] T.Text
+type TestPage = "test" :> Get '[HTML] T.Text
 
 type BlogId = FilePath
 
 api :: Server Api
-api = mainPage :<|> blogPost :<|> themes
+api = mainPage :<|> blogPost :<|> themes :<|> testPage
 
 mainPage :: Handler (Html ())
 mainPage = pure $ with doctypehtml_ [lang_ "en"] $ do
@@ -37,12 +40,11 @@ mainPage = pure $ with doctypehtml_ [lang_ "en"] $ do
   body_ $ div_ [role_ "main"] $ do
     h1_ $ toHtml siteTitle
 
-blogPost :: Maybe BlogId -> Handler (Html ())
-blogPost Nothing = mainPage
-blogPost (Just blogId) = findBlogPost blogId >>= pure . renderBlog
+blogPost :: BlogId -> Handler (Html ())
+blogPost = pure . renderBlog <=< findBlogPost
 
 findBlogPost :: BlogId -> Handler T.Text
-findBlogPost = liftIO . T.readFile . (<>) "/static/"
+findBlogPost = liftIO . T.readFile . (<>) "static/" . flip (<>) ".md"
 
 themes :: Server Themes
 themes = darkTheme :<|> lightTheme
@@ -60,3 +62,6 @@ htmlContainer = id
 
 siteTitle :: T.Text
 siteTitle = "My Site"
+
+testPage :: Handler T.Text
+testPage = liftIO getCurrentDirectory >>= pure . T.pack