From 05de4730209119b0c9f93282c7a26a39eafa4b0f Mon Sep 17 00:00:00 2001 From: "Niels G. W. Serup" Date: Sun, 20 Oct 2024 15:35:24 +0200 Subject: [PATCH] Generate atom.xml --- byg/byg.cabal | 2 + byg/src/Functions.hs | 2 + byg/src/Functions/Atom.hs | 93 +++++++++++++++++++++++++++++++++++++++ byg/src/Functions/Date.hs | 40 +---------------- byg/src/SiteGenerator.hs | 10 ++++- byg/src/Types.hs | 2 + byg/src/Types/Date.hs | 39 ++++++++++++++++ 7 files changed, 149 insertions(+), 39 deletions(-) create mode 100644 byg/src/Functions/Atom.hs create mode 100644 byg/src/Types/Date.hs diff --git a/byg/byg.cabal b/byg/byg.cabal index feeab93..4d3ea09 100644 --- a/byg/byg.cabal +++ b/byg/byg.cabal @@ -24,6 +24,7 @@ library Types.Value Types.Functions Types.Dependency + Types.Date Types DependencyGenerator Functions.Image @@ -32,6 +33,7 @@ library Functions.Template Functions.Text Functions.Date + Functions.Atom Functions DependencyRunner SiteGenerator diff --git a/byg/src/Functions.hs b/byg/src/Functions.hs index e34bd12..dfbf6a2 100644 --- a/byg/src/Functions.hs +++ b/byg/src/Functions.hs @@ -5,6 +5,7 @@ module Functions , module Functions.Template , module Functions.Text , module Functions.Date + , module Functions.Atom ) where import Functions.Image @@ -13,3 +14,4 @@ import Functions.Paths import Functions.Template import Functions.Text import Functions.Date +import Functions.Atom diff --git a/byg/src/Functions/Atom.hs b/byg/src/Functions/Atom.hs new file mode 100644 index 0000000..04ae1bc --- /dev/null +++ b/byg/src/Functions/Atom.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE RebindableSyntax #-} +module Functions.Atom + ( generateAtom + ) where + +import Prelude + +import Types (Token, Date(..), formatDateShort) +import DependencyGenerator (DepGenM, TokenableTo(..), onTupleToken) + +import Data.Text (Text) +import qualified Data.Text as T + +fromString :: String -> Text +fromString = T.pack + +class IsStructure a where + toStructure :: a -> Structure + +instance IsStructure Structure where + toStructure = id + +instance IsStructure [Structure] where + toStructure [s] = s + toStructure (s1 : s2 : ss) = Merge (Merge s1 s2) (toStructure ss) + toStructure [] = Empty + +instance IsStructure [Text] where + toStructure = Line + +instance IsStructure Text where + toStructure t = toStructure [t] + +data Structure = Line [Text] + | Indent Structure + | Merge Structure Structure + | Empty + +structureToText :: Structure -> Text +structureToText = T.concat . toText "" + where toText :: Text -> Structure -> [Text] + toText indent = \case + Line ts -> + indent : ts ++ ["\n"] + Indent s -> + toText (T.append indent " ") s + Merge a b -> + toText indent a ++ toText indent b + Empty -> + [] + +(>:) :: (IsStructure a, IsStructure b) => a -> b -> Structure +a >: b = Merge (toStructure a) (toStructure b) + +(>>:) :: (IsStructure a, IsStructure b) => a -> b -> Structure +a >>: b = Merge (toStructure a) (Indent (toStructure b)) + +type AtomEntry = ((Text, Date), String) + +urlRoot :: Text +urlRoot = "https://mad.metanohi.name" + +generateAtomStructure :: Date -> [AtomEntry] -> Structure +generateAtomStructure updated entries = + "" >: + "" + >>: ("Niels' mad" >: + [""] >: + [""] >: + ["", urlRoot, "/atom.xml"] >: + "" + >>: ("Niels G. W. Serup" >: + "ngws@metanohi.name") >: + "" >: + ["", formatDateShort updated, "T00:00:00Z"]) + >>: map makeEntry entries >: + "" + +makeEntry :: AtomEntry -> Structure +makeEntry ((title, updated), slug) = + "" + >>: (["", title, ""] + >: (""]) + >: ("" : slugUrl ++ [""]) + >: ("" : updatedDate ++ [""]) + >: ("" : updatedDate ++ [""])) + >: "" + where slugUrl = [urlRoot, "/", T.pack slug, ".html"] + updatedDate = [formatDateShort updated, "T00:00:00Z"] + +generateAtom :: (TokenableTo Date a, TokenableTo [AtomEntry] b) => a -> b -> DepGenM (Token Text) +generateAtom = onTupleToken (\updated entries -> + structureToText $ generateAtomStructure updated entries) diff --git a/byg/src/Functions/Date.hs b/byg/src/Functions/Date.hs index f3fc4a0..9b71da5 100644 --- a/byg/src/Functions/Date.hs +++ b/byg/src/Functions/Date.hs @@ -1,21 +1,12 @@ module Functions.Date - ( Date - , extractDate - , formatDate - , formatDateShort + ( extractDate ) where -import Types (Token) +import Types (Token, Date(..)) import DependencyGenerator (DepGenM, TokenableTo(..), onToken) -import Text.Printf (printf) -import qualified Data.Text as T import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE -import Data.Text (Text) - -data Date = Date Int Int Int - deriving (Eq, Ord, Show) split :: Eq a => a -> [a] -> NonEmpty [a] split sep = \case @@ -33,30 +24,3 @@ extractDate = onToken $ \dirName -> case split '-' dirName of Date (read year) (read month) (read day) _ -> error "unexpected" - -formatDate :: Date -> Text -formatDate (Date year month day) = - T.concat [ "den " - , T.pack (show day) - , ". " - , months !! (month - 1) - , " " - , T.pack (show year) - ] - where months = [ "januar" - , "februar" - , "marts" - , "april" - , "maj" - , "juni" - , "juli" - , "august" - , "september" - , "oktober" - , "november" - , "december" - ] - -formatDateShort :: Date -> Text -formatDateShort (Date year month day) = - T.concat [ T.pack (show year), "-", T.pack (printf "%02d" month), "-", T.pack (printf "%02d" day) ] diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs index 464ad86..1271d30 100644 --- a/byg/src/SiteGenerator.hs +++ b/byg/src/SiteGenerator.hs @@ -1,6 +1,6 @@ module SiteGenerator (generateSite) where -import Types (Token(..)) +import Types (Token(..), Date(..), formatDate, formatDateShort) import DependencyGenerator import Functions @@ -15,6 +15,10 @@ elemIndex' x xs = case elemIndex x xs of Just i -> i Nothing -> error ("unexpected unknown directory index for " ++ show x ++ " in " ++ show xs) +head' :: [a] -> a +head' [] = error "error" +head' (x : _) = x + handleRecipeDir :: Token FilePath -> Token FilePath -> Token Template -> Token FilePath -> Token [FilePath] -> Token FilePath @@ -121,6 +125,10 @@ generateSite = do & applyTemplate htmlTemplate saveTextFile allRecipesHtml (joinPaths outputRecipesDir indexName) + newest <- onToken (snd . fst . head') infos + atomText <- generateAtom newest infos + saveTextFile atomText (joinPaths outputDir (inject "atom.xml")) + -- Handle about page outputAboutDir <- joinPaths outputDir (inject "om") makeDir outputAboutDir diff --git a/byg/src/Types.hs b/byg/src/Types.hs index fdac6c4..7c17601 100644 --- a/byg/src/Types.hs +++ b/byg/src/Types.hs @@ -2,10 +2,12 @@ module Types ( module Types.Token , module Types.Value , module Types.Functions + , module Types.Date , Dependency ) where import Types.Token import Types.Value import Types.Functions +import Types.Date import Types.Dependency (Dependency) diff --git a/byg/src/Types/Date.hs b/byg/src/Types/Date.hs new file mode 100644 index 0000000..d0f939c --- /dev/null +++ b/byg/src/Types/Date.hs @@ -0,0 +1,39 @@ +module Types.Date + ( Date(..) + , formatDate + , formatDateShort + ) where + +import Text.Printf (printf) +import Data.Text (Text) +import qualified Data.Text as T + +data Date = Date Int Int Int + deriving (Eq, Ord, Show) + +formatDate :: Date -> Text +formatDate (Date year month day) = + T.concat [ "den " + , T.pack (show day) + , ". " + , months !! (month - 1) + , " " + , T.pack (show year) + ] + where months = [ "januar" + , "februar" + , "marts" + , "april" + , "maj" + , "juni" + , "juli" + , "august" + , "september" + , "oktober" + , "november" + , "december" + ] + +formatDateShort :: Date -> Text +formatDateShort (Date year month day) = + T.concat [ T.pack (show year), "-", T.pack (printf "%02d" month), "-", T.pack (printf "%02d" day) ]