summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xbuild/generate-rss.hs82
-rw-r--r--clean.do1
-rw-r--r--default.nix2
-rw-r--r--htdocs.do2
-rw-r--r--index.md.do3
-rw-r--r--rss/default.rss.do4
6 files changed, 91 insertions, 3 deletions
diff --git a/build/generate-rss.hs b/build/generate-rss.hs
new file mode 100755
index 0000000..18d2d6f
--- /dev/null
+++ b/build/generate-rss.hs
@@ -0,0 +1,82 @@
1#!/usr/bin/env runhaskell
2
3import System.Environment (getArgs)
4import qualified Control.Monad.State as S
5import Control.Monad (sequence)
6
7import Text.Feed.Constructor
8import Text.Feed.Util
9import Text.Feed.Export
10import Text.Feed.Types
11
12import Text.Pandoc
13import Text.Pandoc.Pretty
14
15import qualified System.Time as T
16import qualified System.Posix.Files as F
17import qualified Text.XML.Light.Output as X
18import qualified System.FilePath as FP
19import System.Posix.Types
20
21import Data.Maybe (fromMaybe)
22import Data.List (dropWhileEnd, isSuffixOf)
23
24type FeedState = (Feed, Maybe T.ClockTime)
25
26feedKind = RSSKind $ Just "test" -- DEBUG
27
28extract_title :: Pandoc -> String
29extract_title d@(Pandoc m _) = do
30 title <- render Nothing $ cat $ map pretty (docTitle m)
31 return title
32 where pretty :: Inline -> Doc
33 pretty (Str s) = text s
34 pretty Space = space
35 pretty _ = empty
36
37main :: IO ()
38main = do
39 (title:entries) <- getArgs
40 currentTime <- T.getClockTime
41 let feed = withFeedHome "http://dirty-haskell.org" $ withFeedTitle title $ newFeed feedKind
42 (populatedFeed, itemTime) <- S.execStateT (sequence $ map addItem' entries) (feed, Nothing)
43 let populatedFeed' = withFeedDate (toFeedDateString feedKind $ fromMaybe currentTime itemTime) populatedFeed
44 putStrLn $ X.ppElement $ xmlFeed populatedFeed'
45
46addItem' :: FilePath -> S.StateT FeedState IO ()
47addItem' mdFile = do
48 url <- S.liftIO $ mkUrl mdFile
49 fileStatus <- S.liftIO $ F.getFileStatus mdFile
50 fileContents <- S.liftIO $ readFile mdFile
51 let title = extract_title $ document
52 contents = writeAsciiDoc def document
53 document = readMarkdown def fileContents
54 (feed, time) <- S.get
55 let fileTime = maximum ([F.modificationTime, F.statusChangeTime] <-> fileStatus) :: System.Posix.Types.EpochTime
56 fileTime' = T.TOD (toInteger $ fromEnum fileTime) 0
57 let item = [ withItemTitle title
58 , withItemLink url
59 , withItemDate $ toFeedDateString feedKind fileTime'
60 , withItemDescription contents
61 ] <--> (newItem feedKind) :: Item
62 S.put (addItem item feed, if (Just fileTime' > time) then Just fileTime' else time)
63
64mkUrl :: FilePath -> IO String
65mkUrl link = do
66 status <- F.getFileStatus link
67 if F.isSymbolicLink status then
68 F.readSymbolicLink link >>= mkUrl
69 else
70 return $ mkUrl' link
71mkUrl' :: FilePath -> String
72mkUrl' path = (++) "http://dirty-haskell.org/posts/" $ switchExt ".md" ".html" $ FP.takeFileName path
73
74switchExt prev after str = if ('.':prev) `isSuffixOf` str then (dropWhileEnd (/= '.') str) ++ after else str
75
76(<->) :: [(a -> b)] -> a -> [b]
77[] <-> _ = []
78(f:fs) <-> x = (f x:fs <-> x)
79
80(<-->) :: [(a -> a)] -> a -> a
81[] <--> x = x
82(f:fs) <--> x = fs <--> (f x)
diff --git a/clean.do b/clean.do
index 3b75ee7..3444aab 100644
--- a/clean.do
+++ b/clean.do
@@ -1,3 +1,4 @@
1find -name '*.html' -not -path './nginx/*' -not -path './htdocs/*' -delete 1find -name '*.html' -not -path './nginx/*' -not -path './htdocs/*' -delete
2find -name '*.md' -not -path './posts/*' -not -name 'about.md' -delete 2find -name '*.md' -not -path './posts/*' -not -name 'about.md' -delete
3find -name '*.rss' -not -path './htdocs/*' -delete
3rm tex -rf \ No newline at end of file 4rm tex -rf \ No newline at end of file
diff --git a/default.nix b/default.nix
index 4b377cb..f808b8b 100644
--- a/default.nix
+++ b/default.nix
@@ -7,6 +7,6 @@ in rec {
7 name = "blog-env"; 7 name = "blog-env";
8 version = "1"; 8 version = "1";
9 src = ./.; 9 src = ./.;
10 buildInputs = [ hs.pandoc hs.pandocTypes hs.cryptohash hs.strict ]; 10 buildInputs = [ hs.pandoc hs.pandocTypes hs.cryptohash hs.strict hs.feed ];
11 }; 11 };
12} 12}
diff --git a/htdocs.do b/htdocs.do
index 6e70576..280bfee 100644
--- a/htdocs.do
+++ b/htdocs.do
@@ -1,3 +1,3 @@
1redo-ifchange all 1redo-ifchange all
2find . \( -name '*.html' -or -name '*.css' -or -name '*.svg' \) -and -not \( -path '*/.cabal-sandbox/*' -or -path '*/htdocs/*' -or -path '*/build/*' \) -print0 | \ 2find . \( -name '*.html' -or -name '*.css' -or -name '*.svg' -or -name '*.rss' \) -and -not \( -path '*/.cabal-sandbox/*' -or -path '*/htdocs/*' -or -path '*/build/*' \) -print0 | \
3xargs -0 -I '{}' -- rsync -Rav --delete '{}' htdocs >&2 3xargs -0 -I '{}' -- rsync -Rav --delete '{}' htdocs >&2
diff --git a/index.md.do b/index.md.do
index 605bbb0..f9def9c 100644
--- a/index.md.do
+++ b/index.md.do
@@ -7,6 +7,7 @@ done < <(find lists -maxdepth 1 -mindepth 1 -type d -not -name '.*' -print0 | so
7 7
8for x in "${LISTS[@]}"; do 8for x in "${LISTS[@]}"; do
9 printf "%s.html\0" "$x" 9 printf "%s.html\0" "$x"
10 printf "rss/%s.rss\0" "$(basename $x)"
10done | xargs -r -0 redo-ifchange 11done | xargs -r -0 redo-ifchange
11 12
12cat <<EOF 13cat <<EOF
@@ -21,6 +22,6 @@ EOF
21for x in "${LISTS[@]}"; do 22for x in "${LISTS[@]}"; do
22 printf "* [%s](%s)\n" "$(<$x/title)" "$x.html" 23 printf "* [%s](%s)\n" "$(<$x/title)" "$x.html"
23 while read -r -d $'\n'; do 24 while read -r -d $'\n'; do
24 printf " %s\n" "$REPLY" 25 printf " %s ([RSS](rss/%s))\n" "$REPLY" "$(basename $x).rss"
25 done < "$x/preview" 26 done < "$x/preview"
26done 27done
diff --git a/rss/default.rss.do b/rss/default.rss.do
new file mode 100644
index 0000000..a10b032
--- /dev/null
+++ b/rss/default.rss.do
@@ -0,0 +1,4 @@
1redo-ifchange ../lists/$2.html
2
3find ../lists/$2 -maxdepth 1 -mindepth 1 -not -name 'preview' -not -name 'title' -print0 | \
4 xargs -x -0 -- ../build/generate-rss.hs "$(printf "Dirty-Haskell.org — %s" "$(cat ../lists/$2/title)")"