diff --git a/data/.env.example b/data/.env.example index 7719108..b01cb96 100644 --- a/data/.env.example +++ b/data/.env.example @@ -1,2 +1,3 @@ -APPLICATIONPORT="3000" -BLOGTITLE="Anon's Blog" +SAMPU_PORT="3000" +SAMPU_TITLE="Anon's Blog" +SAMPU_BASEURL="http://localhost:3000" diff --git a/sampu.cabal b/sampu.cabal index 80afadf..f6c321f 100644 --- a/sampu.cabal +++ b/sampu.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: sampu -version: 0.5.0 +version: 0.6.0 license: ISC author: James Eversole maintainer: james@eversole.co @@ -28,7 +28,6 @@ executable sampu , time >= 1.12.0 , twain >= 2.1.0.0 , wai-extra >= 3.0 && < 3.2 - , wai-middleware-static >= 0.9.0 , warp == 3.3.25 , xml-conduit >= 1.9.1.0 hs-source-dirs: src diff --git a/src/Core/Configuration.hs b/src/Core/Configuration.hs index e73a516..4914a43 100644 --- a/src/Core/Configuration.hs +++ b/src/Core/Configuration.hs @@ -35,11 +35,17 @@ main = do ++ "All required environment variables:\n" ++ unlines required -appPort :: IO String -appPort = getEnv "APPLICATIONPORT" +-- The port to run the web server on +port :: IO String +port = getEnv "SAMPU_PORT" -appTitle :: IO String -appTitle = getEnv "BLOGTITLE" +-- The site's title; used for HTML title and XML feed title +title :: IO String +title = getEnv "SAMPU_TITLE" + +-- The site's public-facing base url with no trailing slash +baseUrl :: IO String +baseUrl = getEnv "SAMPU_BASEURL" requiredEnvVars :: [String] -requiredEnvVars = [ "APPLICATIONPORT", "BLOGTITLE" ] +requiredEnvVars = [ "SAMPU_PORT", "SAMPU_TITLE", "SAMPU_BASEURL" ] diff --git a/src/Core/HTTP.hs b/src/Core/HTTP.hs index adf44be..c156c12 100644 --- a/src/Core/HTTP.hs +++ b/src/Core/HTTP.hs @@ -6,8 +6,7 @@ import qualified Core.Handlers as Handle 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 Network.Wai.Middleware.RequestLogger ( logStdout, logStdoutDev ) import System.FilePath ( takeFileName ) @@ -16,7 +15,7 @@ import Web.Twain -- Get the port to listen on from the ENV and start the webserver. main :: [FilePath] -> IO () main postNames = do - port <- Conf.appPort + port <- Conf.port let app = preProcessors ++ (routes postNames) ++ postProcessors @@ -25,11 +24,11 @@ main postNames = do -- These Middlewares are executed before any routes are reached. preProcessors :: [Middleware] -preProcessors = [ logStdoutDev ] +preProcessors = [logStdoutDev] -- These Middlewares are executed after all other routes are exhausted postProcessors :: [Middleware] -postProcessors = [] +postProcessors = [] {- The application's core routes expressed as a list of WAI Middlewares. The list of post names is required so that the postsIndex handler can @@ -48,7 +47,8 @@ routes postNames = -- Takes a post's name extracted from the filepath and returns a valid route mdFileToRoute :: FilePath -> Middleware -mdFileToRoute postName = get (fromString $ "/posts/" ++ postName) (Handle.posts postName) +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 07e1dfd..de1476d 100644 --- a/src/Core/Handlers.hs +++ b/src/Core/Handlers.hs @@ -21,7 +21,7 @@ import Web.Twain index :: ResponderM a index = do -- Query the system environment for the BLOGTITLE environment variable - title <- liftIO Conf.appTitle + title <- liftIO Conf.title -- Read a Commonmark Markdown file and process it to HTML homeMd <- liftIO $ mdFileToLucid "./data/posts/home.md" -- Get the Footer content from Markdown @@ -32,7 +32,7 @@ index = do -- Responds with processed Commonmark -> HTML for posts existing at app init posts :: FilePath -> ResponderM a posts postName = do - title <- liftIO Conf.appTitle + title <- liftIO Conf.title footerMd <- liftIO $ mdFileToLucid "./data/posts/footer.md" postMd <- liftIO $ mdFileToLucid ("./data/posts/" ++ postName ++ ".md") sendLucidFragment $ basePage title (basePost postMd) footerMd @@ -40,45 +40,46 @@ posts postName = do -- Builds an index of all posts on filesystem as of application init postsIndex :: [FilePath] -> ResponderM a postsIndex postNames = do - title <- liftIO Conf.appTitle + title <- liftIO Conf.title footerMd <- liftIO $ mdFileToLucid "./data/posts/footer.md" sendLucidFragment $ basePage title (postIndex postNames) footerMd -- Generates the XML feed at /feed feed :: [FilePath] -> ResponderM a feed postNames = do - title <- liftIO Conf.appTitle + title <- liftIO Conf.title + baseUrl <- liftIO Conf.baseUrl time <- liftIO $ fmap (\x -> timeFormat x) getCurrentTime -- Create Atom [Post] to populate the feed - feedData <- liftIO $ mapM makePost postNames + feedData <- liftIO $ mapM (makePost baseUrl) postNames -- Send an XML response with an automatically populated Atom feed send $ xml $ LTE.encodeUtf8 $ renderFeed - $ autoFeed (baseFeed title time) feedData + $ autoFeed (baseFeed title time baseUrl) feedData where -- Base feed data structure which we populate with entries - baseFeed :: String -> String -> Atom.Feed - baseFeed title time = Atom.nullFeed - "https://eversole.co/feed" + baseFeed :: String -> String -> String -> Atom.Feed + baseFeed title time baseUrl = Atom.nullFeed + (pack $ baseUrl ++ "/feed") (Atom.TextString $ pack title) (pack $ time ++ " UTC") -- Create an Atom Post for each markdown post present - makePost :: FilePath -> IO (Post) - makePost x = do - date <- getModificationTime $ "./data/posts/" ++ x ++ ".md" + makePost :: String -> FilePath -> IO (Post) + makePost baseUrl postName = do + date <- getModificationTime $ "./data/posts/" ++ postName ++ ".md" return $ Post (pack $ (timeFormat date) ++ " UTC") - (pack $ "https://eversole.co/posts/" ++ x) - (pack $ show x) + (pack $ baseUrl ++ "/posts/" ++ postName) + (pack $ show postName) -- YYYY-MM-DD HH:MM | 2024-02-24 16:36 timeFormat :: UTCTime -> String - timeFormat x = formatTime defaultTimeLocale "%Y-%m-%d %H:%M" x + timeFormat date = formatTime defaultTimeLocale "%Y-%m-%d %H:%M" date -- Refer to index comments contact :: ResponderM a contact = do - title <- liftIO Conf.appTitle + title <- liftIO Conf.title contactMd <- liftIO $ mdFileToLucid "./data/posts/contact.md" footerMd <- liftIO $ mdFileToLucid "./data/posts/footer.md" sendLucidFragment $ basePage title (baseContact contactMd) footerMd diff --git a/src/Core/Styles.hs b/src/Core/Styles.hs index 18d3506..250e837 100644 --- a/src/Core/Styles.hs +++ b/src/Core/Styles.hs @@ -1,7 +1,7 @@ module Core.Styles where import Clay hiding (main_) -import qualified Clay.Media as M +import qualified Clay.Media as M import Data.Text.Lazy hiding (center) import Prelude hiding (div) @@ -32,22 +32,22 @@ core_ = do a_ :: Css a_ = do - a ? do + a ? do textDecoration none color terColor body_ :: Css body_ = do - body ? do + body ? do fontFamily [] [monospace] fontSize $ em 1.25 fontWeight $ weight 300 textAlign start margin (em 0) auto (em 0) auto strong ? do - fontWeight $ weight 600 + fontWeight $ weight 600 li ? do - listStyleType $ other "~> " + listStyleType $ other "\"~> \"" footer_ :: Css footer_ = do @@ -105,12 +105,11 @@ nav_ = do margin (em 1.5) (em 0) (em 1.5) (em 0) width $ pct 100 textAlign center - ".mainNav" ? do + ".mainNav" ? do margin (em 0) auto (em 0) auto padding (em 0) (em 0) (em 0) (em 0) overflow hidden - boxShadow . pure $ bsColor "#ccc" $ - shadowWithBlur (px 4) (px 4) (px 6) + boxShadow . pure $ bsColor "#ccc" $ shadowWithBlur (px 4) (px 4) (px 6) display inlineFlex li ? do listStyleType none