Generate atom.xml

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

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

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 =
+  "<?xml version=\"1.0\" encoding=\"utf-8\"?>" >:
+  "<feed xmlns=\"http://www.w3.org/2005/Atom\">"
+  >>: ("<title>Niels' mad</title>" >:
+       ["<link href=\"", urlRoot, "/atom.xml\" rel=\"self\" />"] >:
+       ["<link href=\"", urlRoot, "\" />"] >:
+       ["<id>", urlRoot, "/atom.xml</id>"] >:
+       "<author>"
+       >>: ("<name>Niels G. W. Serup</name>" >:
+            "<email>ngws@metanohi.name</email>") >:
+       "</author>" >:
+       ["<updated>", formatDateShort updated, "T00:00:00Z</updated>"])
+  >>: map makeEntry entries >:
+  "</feed>"
+
+makeEntry :: AtomEntry -> Structure
+makeEntry ((title, updated), slug) =
+  "<entry>"
+  >>: (["<title>", title, "</title>"]
+       >: ("<link href=\"" : slugUrl ++ ["\" />"])
+       >: ("<id>" : slugUrl ++ ["</id>"])
+       >: ("<updated>" : updatedDate ++ ["</updated>"])
+       >: ("<published>" : updatedDate ++ ["</published>"]))
+  >: "</entry>"
+  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)

byg/src/Functions/Date.hs

@@ -1,21 +1,12 @@
 module Functions.Date
-  ( Date
+  ( extractDate
-  , extractDate
-  , formatDate
-  , formatDateShort
   ) 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) ]

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

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)

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) ]