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