gdritter repos lektor / master
Splitting apart Lektor into lektor-lib Getty Ritter 6 years ago
3 changed file(s) with 160 addition(s) and 0 deletion(s). Collapse all Expand all
(New empty file)
1 {-# LANGUAGE RecordWildCards #-}
2
3 module Text.Lektor
4 ( Feed(..)
5 , Entry(..)
6 , mkFeed
7 , mkEntry
8 , writeAll
9 , writeFeed
10 , writeEntry
11 , writeSetup
12 , readEntry
13 ) where
14
15 import Data.ByteString.Lazy.Char8 (pack)
16 import Data.Char (isDigit)
17 import Data.Digest.Pure.SHA (sha1, showDigest)
18 import Data.Monoid ((<>))
19 import Data.Time.Clock.POSIX (getPOSIXTime)
20 import Network.HostName (getHostName)
21 import System.Directory
22 import System.Environment (getEnv)
23 import System.FilePath ((</>))
24 import System.Posix.Files (createSymbolicLink)
25 import System.Posix.Process (getProcessID)
26 import System.Random (randomIO)
27
28 mkdirP :: FilePath -> IO ()
29 mkdirP = createDirectoryIfMissing True
30
31 hash :: String -> String
32 hash = showDigest . sha1 . pack
33
34 writeFileMb :: FilePath -> Maybe String -> IO ()
35 writeFileMb path = maybe (return ()) (writeFile path)
36
37 data Feed = Feed
38 { feedId :: String
39 , feedName :: String
40 , feedDescr :: Maybe String
41 , feedLang :: Maybe String
42 , feedImage :: Maybe String
43 , feedCopy :: Maybe String
44 , feedAuthor :: Maybe String
45 } deriving (Eq, Show)
46
47 data Entry = Entry
48 { entryId :: String
49 , entryTitle :: String
50 , entryContent :: String
51 , entryAuthor :: Maybe String
52 , entryPubdate :: Maybe String
53 , entryType :: Maybe String
54 } deriving (Eq, Show)
55
56 mkFeed :: String -> String -> Feed
57 mkFeed feedId feedName =
58 Feed feedId feedName Nothing Nothing Nothing Nothing Nothing
59
60 mkEntry :: String -> String -> String -> Entry
61 mkEntry entryId entryTitle entryContent =
62 Entry entryId entryTitle entryContent Nothing Nothing Nothing
63
64 writeSetup :: IO ()
65 writeSetup = do
66 dir <- getEnv "LEKTORDIR"
67 setCurrentDirectory dir
68 mapM_ (createDirectoryIfMissing True)
69 [ "src", "tmp", "new", "cur" ]
70
71 writeAll :: (Feed, [Entry]) -> IO ()
72 writeAll (feed, entries) = do
73 writeSetup
74 writeFeed feed
75 mapM_ (writeEntry feed) entries
76
77 writeFeed :: Feed -> IO ()
78 writeFeed Feed { .. } = do
79 let dir = "src" </> hash feedId
80 mkdirP dir
81 writeFile (dir </> "id") feedId
82 writeFile (dir </> "name") feedName
83 writeFileMb (dir </> "description") feedDescr
84 writeFileMb (dir </> "language") feedLang
85 writeFileMb (dir </> "image") feedImage
86 writeFileMb (dir </> "copyright") feedCopy
87 writeFileMb (dir </> "author") feedAuthor
88
89 writeEntry :: Feed -> Entry -> IO ()
90 writeEntry (Feed { feedId = feedId }) (Entry { .. }) = do
91 let feedHash = hash feedId
92 uniq <- mkUniq
93 let dir = "tmp" </> feedHash </> uniq
94 cwd <- getCurrentDirectory
95 mkdirP dir
96 mkdirP ("new" </> hash feedId)
97 writeFile (dir </> "id") entryId
98 writeFile (dir </> "title") entryTitle
99 writeFile (dir </> "content") entryContent
100 writeFileMb (dir </> "author") entryAuthor
101 writeFileMb (dir </> "pubdate") entryPubdate
102 writeFileMb (dir </> "type") entryType
103 createSymbolicLink (cwd </> "src" </> feedHash) (dir </> "feed")
104 renameDirectory dir ("new" </> feedHash </> uniq)
105
106 integer :: Integer -> Integer
107 integer = id
108
109 mkUniq :: IO String
110 mkUniq = do
111 (t, m') <- properFraction `fmap` getPOSIXTime
112 let m = filter isDigit (show m')
113 r <- abs `fmap` randomIO
114 p <- getProcessID
115 h <- getHostName
116 let uniq = "P" <> show p <> "R" <> show (integer r) <> "M" <> m
117 return (show (integer t) <> "." <> uniq <> "." <> h)
118
119 readAll :: IO [(Feed, [Entry])]
120 readAll = undefined
121
122 readFeedAndEntries :: FeedId -> IO (Feed, [Entry])
123 readFeedAndEntries feed = do
124 return undefined
125
126 readFeed :: FeedId -> IO Feed
127 readFeed feed = do
128 return undefined
129
130 readEntry :: FeedId -> EntryId -> IO Entry
131 readEntry feed entry = do
132 return undefined
1 name: lektor-lib
2 version: 0.0.0
3 author: Getty Ritter<gettylefou@gmail.com>
4 maintainer: Getty Ritter<gettylefou@gmail.com>
5 license: BSD3
6 license-file: LICENSE
7 -- synopsis:
8 -- description:
9 cabal-version: >= 1.10
10 build-type: Simple
11
12 library
13 exposed-modules: Text.Lektor
14 default-language: Haskell2010
15 ghc-options: -Wall
16 build-depends: base >= 4 && < 5,
17 SHA,
18 directory,
19 bytestring,
20 filepath,
21 hostname,
22 time,
23 unix,
24 random,
25 errors
26 source-repository head
27 type: git
28 location: https://github.com/aisamanra/lektor/