diff --git a/sampu.cabal b/sampu.cabal index 1cca3c4..a928257 100644 --- a/sampu.cabal +++ b/sampu.cabal @@ -19,6 +19,8 @@ executable sampu , commonmark >= 0.2.4 , directory >= 1.3.7.0 , dotenv >= 0.11.0.0 + , filemanip >= 0.3.6.1 + , filepath >= 1.4.2.2 , lucid >= 2.11.0 , text >= 2.0 , twain >= 2.1.0.0 diff --git a/src/Core/HTTP.hs b/src/Core/HTTP.hs index 08cb4c4..6e8410f 100644 --- a/src/Core/HTTP.hs +++ b/src/Core/HTTP.hs @@ -1,20 +1,30 @@ module Core.HTTP where -import qualified Core.Configuration as Conf -import qualified Core.Handlers as Handle +import qualified Core.Configuration as Conf +import qualified Core.Handlers as Handle -import Network.Wai.Handler.Warp (Port, run) -import Network.Wai.Middleware.RequestLogger (logStdoutDev) -import Network.Wai.Middleware.Static +import Control.Monad ( mapM_ ) +import Data.String ( fromString ) +import Network.Wai.Handler.Warp ( Port, run ) +import Network.Wai.Middleware.RequestLogger ( logStdoutDev ) +import Network.Wai.Middleware.Static +import System.FilePath ( takeFileName ) -import Web.Twain + +import Web.Twain -- Get the port to listen on from the ENV and start the webserver -main :: IO () -main = do +main :: [FilePath] -> IO () +main mdFiles = do port <- Conf.appPort run (read port :: Int) $ - foldr ($) (notFound Handle.missing) app + foldr ($) (notFound Handle.missing) (app mdFiles) + where + app mdFiles = preProcessors + ++ routes + ++ (map mdFileToRoute mdFiles) + ++ postProcessors + -- These Middlewares are executed before any routes are reached preProcessors :: [Middleware] @@ -22,11 +32,14 @@ preProcessors = [ logStdoutDev , staticPolicy $ noDots >-> addBase "data/assets/public" ] --- The application's routes expressed as a list of WAI Middlewares +-- These Middlewares are executed after all other routes are exhausted +postProcessors :: [Middleware] +postProcessors = [] + +-- The application's core routes expressed as a list of WAI Middlewares routes :: [Middleware] routes = [ get "/" Handle.index ] --- Combine our Preprocessor Middlewares and Routes to create an App to run -app :: [Middleware] -app = preProcessors ++ routes +mdFileToRoute :: FilePath -> Middleware +mdFileToRoute fp = get (fromString $ "/posts/" ++ fp) (Handle.posts fp) diff --git a/src/Core/Handlers.hs b/src/Core/Handlers.hs index a3dfca8..2b78248 100644 --- a/src/Core/Handlers.hs +++ b/src/Core/Handlers.hs @@ -20,6 +20,16 @@ index = do $ baseNav <> baseHome homeMd +posts :: FilePath -> ResponderM a +posts fp = do + title <- liftIO Conf.appTitle + postMd <- liftIO $ mdFileToLucid + $ "./data/posts/" ++ fp ++ ".md" + sendLucidFragment + $ baseDoc title + $ baseNav + <> postMd + missing :: ResponderM a missing = sendLucidFragment pageNotFound diff --git a/src/Fragments/Base.hs b/src/Fragments/Base.hs index a8e92f3..2395191 100644 --- a/src/Fragments/Base.hs +++ b/src/Fragments/Base.hs @@ -10,7 +10,7 @@ baseDoc :: String -> Html () -> Html () baseDoc title bodyContent = doctypehtml_ $ do head_ $ do title_ $ fromString title - link_ [rel_ "stylesheet", type_ "text/css", href_ "style.css"] + link_ [rel_ "stylesheet", type_ "text/css", href_ "/style.css"] script_ [src_ "/htmx.min.js"] none body_ bodyContent diff --git a/src/Main.hs b/src/Main.hs index cdefdc6..00caece 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,7 +1,23 @@ module Main where -import qualified Core.HTTP as Core -import qualified Core.Configuration as Conf +import qualified Core.HTTP as HTTP +import qualified Core.Configuration as Conf + +import Control.Monad ( mapM_ ) +import System.FilePath.Find ( always, extension, fileName, find, (&&?) + , (/~?), (==?) ) +import System.FilePath ( dropExtension, takeFileName ) + main :: IO () -main = Conf.main >>= (\_ -> Core.main) +main = do + Conf.main + mdFilePaths <- getMdFilePaths "./data/posts/" + let mdFiles = map (dropExtension . takeFileName) mdFilePaths + HTTP.main mdFiles + +getMdFilePaths :: FilePath -> IO [FilePath] +getMdFilePaths fp = find isVisible (isMdFile &&? isVisible) fp + where + isMdFile = extension ==? ".md" + isVisible = fileName /~? ".?*"