Stop hardcoding feed URL; update environment variable helper function names and add new SAMPU_BASEURL env var

data/.env.example

@@ -1,2 +1,3 @@
-APPLICATIONPORT="3000"
+SAMPU_PORT="3000"
-BLOGTITLE="Anon's Blog"
+SAMPU_TITLE="Anon's Blog"
+SAMPU_BASEURL="http://localhost:3000"

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

src/Core/Configuration.hs

@@ -35,11 +35,17 @@ main = do
       ++ "All required environment variables:\n"
       ++  unlines required
 
-appPort :: IO String
+-- The port to run the web server on
-appPort = getEnv "APPLICATIONPORT"
+port :: IO String
+port = getEnv "SAMPU_PORT"
 
-appTitle :: IO String
+-- The site's title; used for HTML title and XML feed title
-appTitle = getEnv "BLOGTITLE"
+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" ]

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.RequestLogger ( logStdout, logStdoutDev )
-import           Network.Wai.Middleware.Static
 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
@@ -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

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 :: String -> String -> String -> Atom.Feed
-      baseFeed title time = Atom.nullFeed
+      baseFeed title time baseUrl = Atom.nullFeed
-        "https://eversole.co/feed"
+        (pack $ baseUrl ++ "/feed")
         (Atom.TextString $ pack title)
         (pack $ time ++ " UTC")
 
       -- Create an Atom Post for each markdown post present
-      makePost :: FilePath -> IO (Post)
+      makePost :: String -> FilePath -> IO (Post)
-      makePost x = do 
+      makePost baseUrl postName = do 
-        date   <- getModificationTime $ "./data/posts/" ++ x ++ ".md"
+        date   <- getModificationTime $ "./data/posts/" ++ postName ++ ".md"
         return  $ Post 
           (pack $ (timeFormat date) ++ " UTC")
-          (pack $ "https://eversole.co/posts/" ++ x) 
+          (pack $ baseUrl ++ "/posts/" ++ postName) 
-          (pack $ show x)
+          (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

src/Core/Styles.hs

@@ -47,7 +47,7 @@ body_ = do
     strong ? do
       fontWeight    $ weight 600
     li ? do
-      listStyleType $ other "~> "
+      listStyleType $ other "\"~> \""
 
 footer_ :: Css
 footer_ = do
@@ -109,8 +109,7 @@ nav_ = do
     margin      (em 0) auto (em 0) auto
     padding     (em 0) (em 0) (em 0) (em 0)
     overflow    hidden
-    boxShadow . pure $ bsColor "#ccc" $ 
+    boxShadow . pure $ bsColor "#ccc" $ shadowWithBlur (px 4) (px 4) (px 6)
-      shadowWithBlur (px 4) (px 4) (px 6) 
     display     inlineFlex
     li ? do
       listStyleType   none