diff options
-rwxr-xr-x | build/generate-rss.hs | 11 |
1 files changed, 5 insertions, 6 deletions
diff --git a/build/generate-rss.hs b/build/generate-rss.hs index b892424..f6ecfa6 100755 --- a/build/generate-rss.hs +++ b/build/generate-rss.hs | |||
@@ -46,7 +46,7 @@ main = do | |||
46 | addItem' :: FilePath -> S.StateT FeedState IO () | 46 | addItem' :: FilePath -> S.StateT FeedState IO () |
47 | addItem' mdFile = do | 47 | addItem' mdFile = do |
48 | url <- S.liftIO $ mkUrl mdFile | 48 | url <- S.liftIO $ mkUrl mdFile |
49 | fileStatus <- S.liftIO $ F.getFileStatus mdFile | 49 | fileStatus <- S.liftIO $ F.getSymbolicLinkStatus mdFile |
50 | fileContents <- S.liftIO $ readFile mdFile | 50 | fileContents <- S.liftIO $ readFile mdFile |
51 | let title = extract_title $ document | 51 | let title = extract_title $ document |
52 | contents = writeAsciiDoc def document | 52 | contents = writeAsciiDoc def document |
@@ -63,15 +63,14 @@ addItem' mdFile = do | |||
63 | 63 | ||
64 | mkUrl :: FilePath -> IO String | 64 | mkUrl :: FilePath -> IO String |
65 | mkUrl link = do | 65 | mkUrl link = do |
66 | status <- F.getFileStatus link | 66 | status <- F.getSymbolicLinkStatus link |
67 | if F.isSymbolicLink status then | 67 | if F.isSymbolicLink status then |
68 | F.readSymbolicLink link >>= mkUrl | 68 | do target <- F.readSymbolicLink link |
69 | mkUrl $ FP.combine (FP.takeDirectory link) target | ||
69 | else | 70 | else |
70 | return $ mkUrl' link | 71 | return $ mkUrl' link |
71 | mkUrl' :: FilePath -> String | 72 | mkUrl' :: FilePath -> String |
72 | mkUrl' path = (++) "http://dirty-haskell.org/posts/" $ switchExt ".md" ".html" $ FP.takeFileName path | 73 | mkUrl' path = (++) "http://dirty-haskell.org/posts/" $ (flip FP.replaceExtension) "html" $ FP.takeFileName path |
73 | |||
74 | switchExt prev after str = if ('.':prev) `isSuffixOf` str then (dropWhileEnd (/= '.') str) ++ after else str | ||
75 | 74 | ||
76 | (<->) :: [(a -> b)] -> a -> [b] | 75 | (<->) :: [(a -> b)] -> a -> [b] |
77 | [] <-> _ = [] | 76 | [] <-> _ = [] |