94 lines
2.8 KiB
Haskell
94 lines
2.8 KiB
Haskell
{-# 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)
|