| 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
|