blob: f6ecfa67612718535409204d980d927b201f11c1 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
#!/usr/bin/env runhaskell
import System.Environment (getArgs)
import qualified Control.Monad.State as S
import Control.Monad (sequence)
import Text.Feed.Constructor
import Text.Feed.Util
import Text.Feed.Export
import Text.Feed.Types
import Text.Pandoc
import Text.Pandoc.Pretty
import qualified System.Time as T
import qualified System.Posix.Files as F
import qualified Text.XML.Light.Output as X
import qualified System.FilePath as FP
import System.Posix.Types
import Data.Maybe (fromMaybe)
import Data.List (dropWhileEnd, isSuffixOf)
type FeedState = (Feed, Maybe T.ClockTime)
feedKind = RSSKind $ Just "2.0"
extract_title :: Pandoc -> String
extract_title d@(Pandoc m _) = do
title <- render Nothing $ cat $ map pretty (docTitle m)
return title
where pretty :: Inline -> Doc
pretty (Str s) = text s
pretty Space = space
pretty _ = empty
main :: IO ()
main = do
(title:entries) <- getArgs
currentTime <- T.getClockTime
let feed = withFeedHome "http://dirty-haskell.org" $ withFeedTitle title $ newFeed feedKind
(populatedFeed, itemTime) <- S.execStateT (sequence $ map addItem' entries) (feed, Nothing)
let populatedFeed' = withFeedDate (toFeedDateString feedKind $ fromMaybe currentTime itemTime) populatedFeed
putStrLn $ X.ppElement $ xmlFeed populatedFeed'
addItem' :: FilePath -> S.StateT FeedState IO ()
addItem' mdFile = do
url <- S.liftIO $ mkUrl mdFile
fileStatus <- S.liftIO $ F.getSymbolicLinkStatus mdFile
fileContents <- S.liftIO $ readFile mdFile
let title = extract_title $ document
contents = writeAsciiDoc def document
document = readMarkdown def fileContents
(feed, time) <- S.get
let fileTime = maximum ([F.modificationTime, F.statusChangeTime] <-> fileStatus) :: System.Posix.Types.EpochTime
fileTime' = T.TOD (toInteger $ fromEnum fileTime) 0
let item = [ withItemTitle title
, withItemLink url
, withItemDate $ toFeedDateString feedKind fileTime'
, withItemDescription contents
] <--> (newItem feedKind) :: Item
S.put (addItem item feed, if (Just fileTime' > time) then Just fileTime' else time)
mkUrl :: FilePath -> IO String
mkUrl link = do
status <- F.getSymbolicLinkStatus link
if F.isSymbolicLink status then
do target <- F.readSymbolicLink link
mkUrl $ FP.combine (FP.takeDirectory link) target
else
return $ mkUrl' link
mkUrl' :: FilePath -> String
mkUrl' path = (++) "http://dirty-haskell.org/posts/" $ (flip FP.replaceExtension) "html" $ FP.takeFileName path
(<->) :: [(a -> b)] -> a -> [b]
[] <-> _ = []
(f:fs) <-> x = (f x:fs <-> x)
(<-->) :: [(a -> a)] -> a -> a
[] <--> x = x
(f:fs) <--> x = fs <--> (f x)
|
