diff --git a/src/Guide/Handlers.hs b/src/Guide/Handlers.hs index 24c9224..a8d6360 100644 --- a/src/Guide/Handlers.hs +++ b/src/Guide/Handlers.hs @@ -351,7 +351,7 @@ otherMethods = do -- Feeds -- TODO: this link shouldn't be absolute [absolute-links] - baseUrl <- ( "haskell") . T.unpack . _baseUrl <$> getConfig + baseUrl <- (// "haskell") . _baseUrl <$> getConfig Spock.subcomponent "feed" $ do -- Feed for items in a category Spock.get categoryVar $ \catId -> do @@ -359,19 +359,17 @@ otherMethods = do let sortedItems = reverse $ sortBy cmp (category^.items) where cmp = comparing (^.created) <> comparing (^.uid) let route = "feed" categoryVar - -- We use ++ instead of because the rendered route already has ‘/’ - -- in front of it, and if we used it'd just skip baseUrl - let feedUrl = baseUrl ++ T.unpack (renderRoute route (category^.uid)) + let feedUrl = baseUrl // renderRoute route (category^.uid) feedTitle = Atom.TextString (T.unpack (category^.title) ++ " – Haskell – Aelve Guide") feedLastUpdate = case sortedItems of (item:_) -> Feed.toFeedDateStringUTC Feed.AtomKind (item^.created) _ -> "" - let feedBase = Atom.nullFeed feedUrl feedTitle feedLastUpdate + let feedBase = Atom.nullFeed (T.unpack feedUrl) feedTitle feedLastUpdate entries <- liftIO $ mapM (itemToFeedEntry baseUrl category) sortedItems atomFeed $ feedBase { Atom.feedEntries = entries, - Atom.feedLinks = [Atom.nullLink feedUrl] } + Atom.feedLinks = [Atom.nullLink (T.unpack feedUrl)] } adminMethods :: SpockM () () ServerState () adminMethods = Spock.subcomponent "admin" $ do @@ -416,16 +414,15 @@ adminMethods = Spock.subcomponent "admin" $ do itemToFeedEntry :: (MonadIO m) - => String -> Category -> Item -> m Atom.Entry + => Url -> Category -> Item -> m Atom.Entry itemToFeedEntry baseUrl category item = do entryContent <- Lucid.renderTextT (renderItemForFeed category item) return entryBase { - Atom.entryLinks = [Atom.nullLink entryLink], + Atom.entryLinks = [Atom.nullLink (T.unpack entryLink)], Atom.entryContent = Just (Atom.HTMLContent (TL.unpack entryContent)) } where - entryLink = baseUrl - T.unpack (T.format "{}#item-{}" - (categorySlug category, item^.uid)) + entryLink = baseUrl // + T.format "{}#item-{}" (categorySlug category, item^.uid) entryBase = Atom.nullEntry (T.unpack (uidToText (item^.uid))) (Atom.TextString (T.unpack (item^.name))) diff --git a/src/Guide/Utils.hs b/src/Guide/Utils.hs index d22d1bc..3187929 100644 --- a/src/Guide/Utils.hs +++ b/src/Guide/Utils.hs @@ -29,6 +29,7 @@ module Guide.Utils Url, sanitiseUrl, makeSlug, + (//), -- * IP sockAddrToIP, @@ -167,6 +168,24 @@ makeSlug = T.toLower . T.map (\x -> if x == '_' || x == '/' then '-' else x) +{- | +Add a path element to an URL: + +>>> "https://guide.aelve.com" // "haskell" +"https://guide.aelve.com/haskell" + +If slashes are already present, it strips them: + +>>> "https://guide.aelve.com/" // "/haskell" +"https://guide.aelve.com/haskell" + +Note that ('') from "System.FilePath" shouldn't be used, as on Windows it +appends backslashes (@\@) and not slashes (@/@). +-} +(//) :: Url -> Text -> Url +(//) x y = fromMaybe x (T.stripSuffix "/" x) <> "/" <> + fromMaybe y (T.stripPrefix "/" y) + ---------------------------------------------------------------------------- -- IP ----------------------------------------------------------------------------