gdritter repos lektor / 8d7cf1f
Splitting features into better-encapsulated modules Getty Ritter 9 years ago
3 changed file(s) with 156 addition(s) and 1 deletion(s). Collapse all Expand all
+53
-0
lektor-rss/src/Atom.hs less more
1 {-# LANGUAGE RecordWildCards #-}
2
3 module Atom (atomToLektor) where
4
5 import Data.Monoid ((<>))
6 import Text.Atom.Feed
7 import Text.XML.Light.Output
8
9 import qualified Lektor as L
10
11 atomToLektor :: Feed -> (L.Feed, [L.Entry])
12 atomToLektor Feed { .. } = (lfeed, lentries)
13 where lentries = map toEntry feedEntries
14 lfeed = L.Feed
15 { L.feedId = feedId
16 , L.feedName = toString feedTitle
17 , L.feedDescr = fmap toString feedSubtitle
18 , L.feedLang = Nothing
19 , L.feedImage = feedLogo
20 , L.feedCopy = fmap toString feedRights
21 , L.feedAuthor = toPeople feedAuthors
22 }
23
24 toEntry :: Entry -> L.Entry
25 toEntry Entry { .. } = L.Entry
26 { L.entryId = entryId
27 , L.entryTitle = toString entryTitle
28 , L.entryContent = maybe "" entryToString entryContent
29 , L.entryAuthor = toPeople entryAuthors
30 , L.entryPubdate = undefined
31 , L.entryType = undefined
32 }
33
34 toString :: TextContent -> String
35 toString (TextString s) = s
36 toString (HTMLString s) = s
37 toString (XHTMLString e) = showElement e
38
39 entryToString :: EntryContent -> String
40 entryToString (TextContent s) = s
41 entryToString (HTMLContent s) = s
42 entryToString (XHTMLContent e) = showElement e
43 entryToString (MixedContent _ _) = "[unimplemented]"
44 entryToString (ExternalContent _ _) = "[unimplemented]"
45
46 toPeople :: [Person] -> Maybe String
47 toPeople [] = Nothing
48 toPeople xs = Just (unlines (map toPerson xs))
49
50 toPerson :: Person -> String
51 toPerson p = case personEmail p of
52 Just e -> personName p <> " <" <> e <> ">"
53 Nothing -> personName p
+96
-0
lektor-rss/src/Lektor.hs less more
1 {-# LANGUAGE RecordWildCards #-}
2 {-# LANGUAGE ScopedTypeVariables #-}
3
4 module Lektor
5 ( Feed(..)
6 , Entry(..)
7 , mkFeed
8 , mkEntry
9 , writeFeed
10 , writeEntry
11 ) where
12
13 import Data.ByteString.Lazy.Char8 (pack)
14 import Data.Char (isDigit)
15 import Data.Digest.Pure.SHA (sha1, showDigest)
16 import Data.Monoid ((<>))
17 import Data.Time.Clock.POSIX (getPOSIXTime)
18 import Network.HostName (getHostName)
19 import System.Directory
20 import System.FilePath ((</>))
21 import System.Posix.Files (createSymbolicLink)
22 import System.Posix.Process (getProcessID)
23
24 mkdirP :: FilePath -> IO ()
25 mkdirP = createDirectoryIfMissing True
26
27 hash :: String -> String
28 hash = showDigest . sha1 . pack
29
30 writeFileMb :: FilePath -> Maybe String -> IO ()
31 writeFileMb path = maybe (return ()) (writeFile path)
32
33 data Feed = Feed
34 { feedId :: String
35 , feedName :: String
36 , feedDescr :: Maybe String
37 , feedLang :: Maybe String
38 , feedImage :: Maybe String
39 , feedCopy :: Maybe String
40 , feedAuthor :: Maybe String
41 } deriving (Eq, Show)
42
43 data Entry = Entry
44 { entryId :: String
45 , entryTitle :: String
46 , entryContent :: String
47 , entryAuthor :: Maybe String
48 , entryPubdate :: Maybe String
49 , entryType :: Maybe String
50 } deriving (Eq, Show)
51
52 mkFeed :: String -> String -> Feed
53 mkFeed feedId feedName =
54 Feed feedId feedName Nothing Nothing Nothing Nothing Nothing
55
56 mkEntry :: String -> String -> String -> Entry
57 mkEntry entryId entryTitle entryContent =
58 Entry entryId entryTitle entryContent Nothing Nothing Nothing
59
60 writeFeed :: Feed -> IO ()
61 writeFeed Feed { .. } = do
62 let dir = "src" </> hash feedId
63 mkdirP dir
64 writeFile (dir </> "id") feedId
65 writeFile (dir </> "name") feedName
66 writeFileMb (dir </> "description") feedDescr
67 writeFileMb (dir </> "language") feedLang
68 writeFileMb (dir </> "image") feedImage
69 writeFileMb (dir </> "copyright") feedCopy
70 writeFileMb (dir </> "author") feedAuthor
71
72 writeEntry :: Entry -> Feed -> IO ()
73 writeEntry (Entry { .. }) (Feed { feedId = feedId }) = do
74 let feedHash = hash feedId
75 uniq <- mkUniq
76 let dir = "tmp" </> feedHash </> uniq
77 mkdirP dir
78 mkdirP ("new" </> hash feedId)
79 writeFile (dir </> "id") entryId
80 writeFile (dir </> "title") entryTitle
81 writeFile (dir </> "content") entryContent
82 writeFileMb (dir </> "author") entryAuthor
83 writeFileMb (dir </> "pubdate") entryPubdate
84 writeFileMb (dir </> "type") entryType
85 createSymbolicLink (dir </> "feed") ("src" </> feedHash)
86 renameDirectory dir ("new" </> feedHash </> uniq)
87
88 mkUniq :: IO String
89 mkUniq = do
90 (t :: Integer, r') <- properFraction `fmap` getPOSIXTime
91 let r = filter isDigit (show r')
92 let m = ""
93 p <- getProcessID
94 h <- getHostName
95 let uniq = "P" <> show p <> "R" <> r <> "M" <> m
96 return (show t <> "." <> uniq <> "." <> h)
+7
-1
lektor-rss/src/Main.hs less more
33 {-# LANGUAGE RecordWildCards #-}
44
55 module Main where
6
7 import qualified Lektor as L
8
9 import qualified Atom as A
610
711 import Control.Monad (zipWithM_)
812 import Data.ByteString.Lazy.Char8 (pack)
1317 import Network.HTTP
1418 import System.Directory
1519 import System.Environment
16 import System.Exit (die)
20 -- import System.Exit (die)
1721 import System.FilePath ((</>))
1822 import System.Posix.Process (getProcessID)
1923 import Text.Atom.Feed.Import (elementFeed)
2024 import Text.Atom.Feed
2125 import Text.XML.Light.Input (parseXMLDoc)
26
27 die = error
2228
2329 usage :: String
2430 usage = "Usage: lektor-rss [feed url]"