From c793b17bedbf1500dfb409f3f69cc7fbc8b49f86 Mon Sep 17 00:00:00 2001 From: James Eversole Date: Sat, 24 Feb 2024 11:34:25 -0600 Subject: [PATCH] Automatic creation of 'All Posts' post index based on existing MD files at application init --- .gitignore | 3 +-- README.md | 4 +--- data/assets/public/style.css | 33 ++++++++++++++++++++++++++------- data/posts/contact.md.example | 3 +++ data/posts/home.md.example | 5 +++++ src/Core/HTTP.hs | 32 +++++++++++++++++++------------- src/Core/Handlers.hs | 35 +++++++++++++++++++++-------------- src/Fragments/Base.hs | 22 ++++++++++++++++++++++ src/Main.hs | 5 ++++- 9 files changed, 102 insertions(+), 40 deletions(-) create mode 100644 data/posts/contact.md.example create mode 100644 data/posts/home.md.example diff --git a/.gitignore b/.gitignore index 828af47..4c9773d 100644 --- a/.gitignore +++ b/.gitignore @@ -5,8 +5,7 @@ Dockerfile WD bin/ -data/posts -data/base +data/posts/*.md dist* docker-stack.yml result diff --git a/README.md b/README.md index 1c88758..4e26787 100644 --- a/README.md +++ b/README.md @@ -15,12 +15,10 @@ Therefore, `la sampu cu sampu lo ka samtci`! - [Haskell](https://www.haskell.org) - [Twain](https://github.com/alexmingoia/twain) - [Lucid2](https://chrisdone.com/posts/lucid2) -- [HTMX](https://htmx.org/) ## Goal -Provide a simple blog engine that is easily customizable via HTML fragments -and straightforward HTMX integration for dynamic server-driven content. +Provide a simple blog engine that is easily customizable via HTML fragments. ## Deployment diff --git a/data/assets/public/style.css b/data/assets/public/style.css index 30ff05a..436dab8 100644 --- a/data/assets/public/style.css +++ b/data/assets/public/style.css @@ -1,21 +1,32 @@ html{font-family:Monospace;background-color:#f1f6f0;color:#222323} -body{margin:1% 2% ;font-size:20px;font-weight:300;text-align:left} a{text-decoration:none} h2{text-transform:uppercase} h3{margin:0.25em 0 0.25em 0} p{margin:0.4em 0 0.4em 0} a{color:#6D92AD} -.main{margin:1em auto;max-width:75%} -.htmx-indicator{display:none}::placeholder{color:#222323;opacity:1} -.logo{margin:4% 3% 0 0;font-size:1.2vw;color:#435F5D;text-align:center} + +body { + margin: 1% 2%; + font-size: 1.25em; + font-weight: 300; + text-align: left +} + +body li { + list-style-type: "~> "; +} + +.main { + margin: 1em auto; + max-width: 60%; +} .navContainer { width: 100%; text-align: center; } -.mainNav{ - list-style-type: none; +.mainNav { margin: 0 auto; padding: 0; overflow: hidden; @@ -23,6 +34,10 @@ a{color:#6D92AD} display: inline-flex; } +.mainNav li { + list-style-type: none; +} + .mainNav li a { display: block; text-align: center; @@ -38,5 +53,9 @@ a{color:#6D92AD} .notFound h1 { font-size: 500%; font-weight: 200; - color:#6D92AD} + color:#6D92AD +} + +.postList { + font-size: 1.5em; } diff --git a/data/posts/contact.md.example b/data/posts/contact.md.example new file mode 100644 index 0000000..02b6bda --- /dev/null +++ b/data/posts/contact.md.example @@ -0,0 +1,3 @@ +# Contact Me + +You can reach me at [YOUREMAIL@EXAMPLE.LOCAL](mailto:YOUREMAIL@EXAMPLE.LOCAL) diff --git a/data/posts/home.md.example b/data/posts/home.md.example new file mode 100644 index 0000000..bb0bb10 --- /dev/null +++ b/data/posts/home.md.example @@ -0,0 +1,5 @@ +# Your Name Here + +### A blog about YOUR_INTERESTS_HERE + +I really love to blog about _____, _____, and _____! diff --git a/src/Core/HTTP.hs b/src/Core/HTTP.hs index 6e8410f..b3019b1 100644 --- a/src/Core/HTTP.hs +++ b/src/Core/HTTP.hs @@ -15,16 +15,14 @@ import Web.Twain -- Get the port to listen on from the ENV and start the webserver main :: [FilePath] -> IO () -main mdFiles = do +main postNames = do port <- Conf.appPort - run (read port :: Int) $ - foldr ($) (notFound Handle.missing) (app mdFiles) - where - app mdFiles = preProcessors - ++ routes - ++ (map mdFileToRoute mdFiles) - ++ postProcessors - + let app = preProcessors + ++ (routes postNames) + ++ (buildMdRoutes postNames) + ++ postProcessors + run (read port) $ + foldr ($) (notFound Handle.missing) app -- These Middlewares are executed before any routes are reached preProcessors :: [Middleware] @@ -37,9 +35,17 @@ postProcessors :: [Middleware] postProcessors = [] -- The application's core routes expressed as a list of WAI Middlewares -routes :: [Middleware] -routes = - [ get "/" Handle.index ] +routes :: [FilePath] -> [Middleware] +routes postNames = + [ get "/" Handle.index + , get "/posts" $ Handle.postsIndex postNames + , get "/contact" Handle.contact + , get "/feed" Handle.feed + ] +-- Takes a post's name extracted from the filepath and returns a valid route mdFileToRoute :: FilePath -> Middleware -mdFileToRoute fp = get (fromString $ "/posts/" ++ fp) (Handle.posts fp) +mdFileToRoute postName = get (fromString $ "/posts/" ++ postName) (Handle.posts postName) + +buildMdRoutes :: [FilePath] -> [Middleware] +buildMdRoutes postNames = map mdFileToRoute postNames diff --git a/src/Core/Handlers.hs b/src/Core/Handlers.hs index 2b78248..dc64d18 100644 --- a/src/Core/Handlers.hs +++ b/src/Core/Handlers.hs @@ -11,24 +11,31 @@ import Web.Twain index :: ResponderM a index = do - -- Probably going to want to add ReaderT to the stack for this instead title <- liftIO Conf.appTitle - -- Probably going to want to do this file reading and processing at app init - homeMd <- liftIO $ mdFileToLucid "./data/base/home.md" - sendLucidFragment - $ baseDoc title - $ baseNav - <> baseHome homeMd + homeMd <- liftIO $ mdFileToLucid "./data/posts/home.md" + sendLucidFragment $ basePage title (baseHome homeMd) + +postsIndex :: [FilePath] -> ResponderM a +postsIndex postNames = do + title <- liftIO Conf.appTitle + sendLucidFragment $ basePage title (postIndex postNames) posts :: FilePath -> ResponderM a -posts fp = do +posts postName = do title <- liftIO Conf.appTitle - postMd <- liftIO $ mdFileToLucid - $ "./data/posts/" ++ fp ++ ".md" - sendLucidFragment - $ baseDoc title - $ baseNav - <> postMd + postMd <- liftIO $ mdFileToLucid ("./data/posts/" ++ postName ++ ".md") + sendLucidFragment $ basePage title (basePost postMd) + +contact :: ResponderM a +contact = do + title <- liftIO Conf.appTitle + contactMd <- liftIO $ mdFileToLucid "./data/posts/contact.md" + sendLucidFragment $ basePage title (baseContact contactMd) + +feed :: ResponderM a +feed = do + title <- liftIO Conf.appTitle + sendLucidFragment $ basePage title baseFeed missing :: ResponderM a missing = sendLucidFragment pageNotFound diff --git a/src/Fragments/Base.hs b/src/Fragments/Base.hs index 2395191..3cbde48 100644 --- a/src/Fragments/Base.hs +++ b/src/Fragments/Base.hs @@ -22,8 +22,30 @@ baseNav = div_ [class_ "navContainer"] $ do li_ $ a_ [href_ "/contact"] "Contact" li_ $ a_ [href_ "/feed"] "Feed" +basePage :: String -> Html () -> Html() +basePage title body = baseDoc title $ baseNav <> body + baseHome :: Html () -> Html () baseHome content = div_ [class_ "main"] content + +basePost :: Html () -> Html () +basePost content = div_ [class_ "main"] content + +postIndex :: [FilePath] -> Html () +postIndex postNames = div_ [class_ "main"] $ do + h1_ [class_ "title"] "All Posts" + ul_ [class_ "postList"] $ do + mapM_ + (\x -> li_ $ a_ [href_ (pack $ "/posts/" ++ x)] (fromString x)) + postNames + +baseContact :: Html () -> Html () +baseContact content = div_ [class_ "main"] content + +baseFeed :: Html () +baseFeed = div_ [class_ "main"] $ do + h2_ "Oops, I haven't been implemented yet." + h3_ "Check back in a couple days!" none :: Text none = mempty diff --git a/src/Main.hs b/src/Main.hs index 00caece..2f79d93 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -17,7 +17,10 @@ main = do HTTP.main mdFiles getMdFilePaths :: FilePath -> IO [FilePath] -getMdFilePaths fp = find isVisible (isMdFile &&? isVisible) fp +getMdFilePaths fp = find isVisible fileFilter fp where isMdFile = extension ==? ".md" isVisible = fileName /~? ".?*" + isHome = fileName /~? "home.md" + isContact = fileName /~? "contact.md" + fileFilter = isMdFile &&? isVisible &&? isHome &&? isContact