muon 0.1.0.7 → 0.1.0.8
raw patch · 15 files changed
+180/−251 lines, 15 filesdep −HTTP
Dependencies removed: HTTP
Files
- README.md +6/−116
- changelog +4/−0
- muon.cabal +6/−3
- src/Archive.hs +29/−27
- src/Config.hs +4/−3
- src/Constant.hs +3/−1
- src/Home.hs +8/−8
- src/Main.hs +35/−17
- src/Page.hs +25/−18
- src/Post.hs +48/−51
- src/Server.hs +6/−3
- src/Site.hs +1/−1
- src/def/pages/about +2/−1
- src/def/pages/contact +2/−1
- src/def/posts/first.post +1/−1
README.md view
@@ -1,121 +1,11 @@-muon+Muon ====-Muon is a static blog generator, meaning that it takes files written in+Muon is a static site generator, meaning that it takes files written in convenient markup and converts it to HTML and CSS ready to deploy to a web server. -Installing from Darcs-----------------------First, install the package by getting the darcs repo.-- $ git clone https://code.kaashif.co.uk/kaashif/muon.git--You can install it using cabal, which you should have installed.-- $ cd muon- $ cabal install--After that, assuming you have configured cabal and/or your PATH-correctly, muon should be usable. Here are some things you may want to-do:--Installing from Hackage-------------------------Installing from Hackage using Cabal is as simple as:-- $ cabal install muon--Bear in mind this may not be the most up-to-date version, but it will be-a stable version.--Using Muon------------Initialising a blog:-- $ mkdir new-blog- $ cd new-blog- $ muon init--Writing a post:-- $ vi posts/new.post--Regenerating the site, creating a tree of files in the ./site directory.-- $ muon generate--Previewng the site locally:-- $ muon serve--Uploading site to server:-- $ muon upload--Multiple commands in sequence:-- $ muon init generate upload- $ muon generate serve--Configuring Muon------------------After "muon init" is run, a file called "config.ini" is created. This is-where you configure the blog. By default, it should look like this:-- [site]- title=Default site- author=Your Name- tagline=Something descriptive- style=/style.css-- [remote]- user=root- server=webserver- dir=/var/www/htdocs/--The [site] section needs little explanation - you can preview the site-yourself and see where those strings go. The "style" option denotes the-location of a custom CSS file.--The [remote] section is to configure the command run by Muon to upload-the site. The command is "rsync -a --delete site/ user@server:dir", with-the key words replaced with your SSH credentials on a server. If you're-not sure if the configuration is correct, remember: the directory must-end in a slash!--Extra Pages-------------Aside from a homepage, archive, and posts, you might want some extra-pages on your site, like "example.com/recipes" or "example.com/laptop".-You can add such pages to your site simply by creating a file with the-right name in the "pages/" directory of your blog.--For example, if your blog is at "myblog.com" and you want a page at-"myblog.com/mypage", edit the file "pages/mypage" and fill it with-HTML. Bear in mind, this content will go in between the "header" and-"footer" templates, so you don't need to include \<body\> or \<html\> tags.-Here's how you might do that:-- $ cat >> pages/mypage <<EOF- <h2>My Custom Page</h2>- <p>This is a page I made!</p>- EOF--And that's that! Next time you "muon generate upload", the pages will be-accessible at "myblog.com/mypage".--Writing Posts---------------To add a new post, create a new file in the "posts/" directory with the-suffix ".post".--When writing posts, make sure you put the title on the first line, the date on-the second, and a short description (for the archive) on the third line. The-rest should be valid Markdown. See the "posts/" directory after site-initialisation for some examples.+See [this site](http://kaashif.co.uk/muon/) for some sort of website for+Muon. -In the archive, posts are ordered lexicographically, _not_ by date.-This means "aaa.post" will always come above "bbb.post", regardless of-the date contained in the file itself. This allows you to decide the-order of your posts yourself, if you want to separate tutorials and-rants, for example.+See [the documentation](http://kaashif.co.uk/muon/docs/) for info on how+to use Muon.
+ changelog view
@@ -0,0 +1,4 @@+0.1.0.8 Kaashif Hymabaccus <kaashif@kaashif.co.uk>+* Finished core functionality+* Converted all functions to using Text, not String+* Removed "not a blog" warnings on help and init commands
muon.cabal view
@@ -1,5 +1,5 @@ name: muon-version: 0.1.0.7+version: 0.1.0.8 synopsis: Static blog generator description: Program which takes blog posts and pages written in Markdown and@@ -30,7 +30,7 @@ def/pages/about def/pages/contact def/config.ini-extra-source-files: src/*.hs README.md+extra-source-files: src/*.hs README.md changelog source-repository head type: git@@ -38,5 +38,8 @@ executable muon main-is: Main.hs- build-depends: base ==4.6.*, text ==0.11.*, HStringTemplate ==0.7.*, directory ==1.2.*, Glob ==0.7.*, process ==1.2.*, blaze-html ==0.7.*, markdown ==0.1.*, ConfigFile==1.1.*, MissingH==1.2.*, happstack-server==7.3.*, HTTP ==4000.2.*+ build-depends: base ==4.6.*, text ==0.11.*, HStringTemplate ==0.7.*,+ directory ==1.2.*, Glob ==0.7.*, process ==1.2.*,+ blaze-html ==0.7.*, markdown ==0.1.*, ConfigFile==1.1.*,+ MissingH==1.2.*, happstack-server==7.3.* hs-source-dirs: src
src/Archive.hs view
@@ -1,46 +1,48 @@+{-# LANGUAGE OverloadedStrings #-} module Archive where import System.Directory import qualified Data.Text as T+import qualified Data.Text.IO as T import Site import Text.StringTemplate import Post--sitePath = "site/"-mkdir = createDirectoryIfMissing False+import Constant archiveTemplate = do templates <- directoryGroup "templates" :: IO (STGroup T.Text)- let Just t = getStringTemplate "generic" templates- return t+ return $ maybe (newSTMP "generic.st not found")+ id+ (getStringTemplate "generic" templates) -makeTableRow :: Post -> String-makeTableRow p = "<tr>"- ++ "<td><a href=" ++ T.unpack (link p) ++ ">" ++ T.unpack (title p) ++ "</a></td>"- ++ "<td>" ++ T.unpack (date p) ++ "</td>"- ++ "<td>" ++ T.unpack (comment p) ++ "</td>"- ++ "</tr>"+makeTableRow :: Post -> T.Text+makeTableRow p = let a = T.append in "<tr>"+ `a` "<td><a href=" `a` (link p)+ `a` ">" `a` (title p) `a` "</a></td>"+ `a` "<td>" `a` (date p) `a` "</td>"+ `a` "<td>" `a` (comment p) `a` "</td>"+ `a` "</tr>" -makeTable :: [Post] -> T.Text-makeTable ps = T.pack- $ "<table>"- ++ "<tr><td>Title</td><td>Date</td><td>Comment</td></tr>"- ++ unlines (map makeTableRow ps)- ++ "</table>"+makeTable :: [Post] -> T.Text+makeTable ps = let a = T.append in "<table>"+ `a` "<tr><td>Title</td><td>Date</td><td>Comment</td></tr>"+ `a` T.unlines (map makeTableRow ps)+ `a` "</table>" -renderGenericArchive s t c = render- $ setAttribute "site" s- $ setAttribute "content" c t+renderGenericArchive site template content = render+ $ setAttribute "site" site+ $ setAttribute "content" content template renderArchive = do- ps <- getAllPosts- t <- archiveTemplate- s <- readSite- return $ renderGenericArchive s t (makeTable $ reverse ps)+ posts <- getAllPosts+ template <- archiveTemplate+ site <- readSite+ return $ renderGenericArchive site template (makeTable $ reverse posts) -writeArchive :: T.Text -> IO ()-writeArchive s = do+writeArchive :: T.Text -> IO ()+writeArchive html = do+ let a = T.append mkdir $ sitePath ++ "archive/"- writeFile (sitePath ++ "archive/index.html") (T.unpack s)+ T.writeFile (sitePath ++ "archive/index.html") html generateArchive = renderArchive >>= writeArchive >> putStrLn "Generated archive"
src/Config.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module Config (getSetting, rsyncCmd) where import System.Directory@@ -5,15 +6,15 @@ import Data.Either.Utils import qualified Data.Text as T -blogCP :: IO ConfigParser+blogCP :: IO ConfigParser blogCP = fmap forceEither $ readfile emptyCP "config.ini" -getSetting :: String -> String -> IO String+getSetting :: String -> String -> IO String getSetting sect c = do cp <- blogCP return $ forceEither $ get cp sect c -rsyncCmd :: IO String+rsyncCmd :: IO String rsyncCmd = do user <- getSetting "remote" "user" server <- getSetting "remote" "server"
src/Constant.hs view
@@ -2,7 +2,9 @@ module Constant where import System.Directory+import qualified Data.Text as T +sitePath :: FilePath sitePath = "site/" siteDirs = ["site", "style", "posts", "templates", "pages"]-mkdir = createDirectoryIfMissing True+mkdir = (createDirectoryIfMissing True)
src/Home.hs view
@@ -5,29 +5,29 @@ import Text.StringTemplate import System.Directory import Site+import Constant import qualified Data.Text as T--sitePath = "site/"-mkdir = createDirectoryIfMissing False+import qualified Data.Text.IO as T homeTemplate = do templates <- directoryGroup "templates" :: IO (STGroup T.Text)- let Just t = getStringTemplate "generic" templates- return t+ return $ maybe (newSTMP "generic.st not found")+ id+ (getStringTemplate "generic" templates) -renderGenericHome :: Site -> StringTemplate T.Text -> [T.Text] -> T.Text+renderGenericHome :: Site -> StringTemplate T.Text -> [T.Text] -> T.Text renderGenericHome s t cs = render $ setAttribute "site" s $ setAttribute "content" (T.unlines cs) t -renderHome :: IO T.Text+renderHome :: IO T.Text renderHome = do cs <- getAllExtracts t <- homeTemplate s <- readSite return $ renderGenericHome s t $ reverse cs -writeHome :: T.Text -> IO ()+writeHome :: T.Text -> IO () writeHome s = do mkdir $ sitePath ++ "home/" writeFile (sitePath ++ "home/index.html") (T.unpack s)
src/Main.hs view
@@ -4,6 +4,7 @@ import qualified Data.Text as T import Text.StringTemplate import Control.Monad+import Control.Exception import System.Directory import System.FilePath.Glob import System.Environment@@ -17,22 +18,25 @@ import Config import Paths_muon +checkBlog = doesFileExist "config.ini" ensureDirs = mkdir sitePath +copyDef dir file = copyFile (dir ++ "/" ++ file) file+ createDefaults = do d <- getDataFileName "def" mapM_ mkdir siteDirs mkdir "static"- copyFile (d ++ "/style/style.css") "style/style.css"- copyFile (d ++ "/posts/first.post") "posts/first.post"- copyFile (d ++ "/posts/second.post") "posts/second.post"- copyFile (d ++ "/templates/post.st") "templates/post.st"- copyFile (d ++ "/templates/header.st") "templates/header.st"- copyFile (d ++ "/templates/footer.st") "templates/footer.st"- copyFile (d ++ "/templates/generic.st") "templates/generic.st"- copyFile (d ++ "/pages/about") "pages/about"- copyFile (d ++ "/pages/contact") "pages/contact"- copyFile (d ++ "/config.ini") "config.ini"+ copyDef d "style/style.css"+ copyDef d "posts/first.post"+ copyDef d "posts/second.post"+ copyDef d "templates/post.st"+ copyDef d "templates/header.st"+ copyDef d "templates/footer.st"+ copyDef d "templates/generic.st"+ copyDef d "pages/about"+ copyDef d "pages/contact"+ copyDef d "config.ini" putStrLn "Initialised site directory" copyStatic = do@@ -57,16 +61,19 @@ >> removeDirectoryRecursive sitePath >> mkdir sitePath -printRun :: String -> IO ()-printRun cmd = putStrLn ("Running \'" ++ cmd ++ "\'") >> runInteractiveCommand cmd >> return ()+printRun :: String -> IO ()+printRun cmd = putStrLn ("Running \'" ++ cmd ++ "\'")+ >> runInteractiveCommand cmd >> return () -proc :: String -> IO ()+proc :: String -> IO () proc cmd+ | cmd == "help" = showHelp | cmd == "init" = createDefaults | cmd == "generate" = clearSite >> generateSite- | cmd == "serve" = putStrLn "Serving site at http://127.0.0.1:8000/" >> startServer+ | cmd == "serve" = putStrLn "Serving site at http://127.0.0.1:8000/"+ >> startServer | cmd == "upload" = rsyncCmd >>= printRun- | otherwise = showHelp+ | otherwise = putStrLn (cmd ++ " is not a valid command!") >> showHelp getArgsHelp = do a <- getArgs@@ -74,6 +81,17 @@ then return ["help"] else return a -takeAction = getArgsHelp >>= mapM_ proc+takeAction :: [String] -> IO ()+takeAction args = mapM_ proc args -main = ensureDirs >> takeAction+specialCase :: [String] -> Bool+specialCase args = elem (args !! 0) ["help", "init"]++main = do+ isBlog <- checkBlog+ args <- getArgsHelp+ special <- catch (return $ specialCase args)+ (\e -> let _ = (e :: ArrayException) in return False)+ if (isBlog || special)+ then ensureDirs >> takeAction args+ else putStrLn "This directory is not a blog." >> showHelp
src/Page.hs view
@@ -3,48 +3,55 @@ module Page where import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy as TL import Site import Text.StringTemplate import Text.StringTemplate.GenericStandard import System.Directory import Control.Monad+import Control.Arrow ((>>>)) import Constant+import Text.Blaze.Html.Renderer.Text+import Text.Markdown pageTemplate = do templates <- directoryGroup "templates" :: IO (STGroup T.Text)- let Just t = getStringTemplate "generic" templates- return t+ return $ maybe (newSTMP "generic.st not found")+ id+ (getStringTemplate "generic" templates) -onlyFiles :: [FilePath] -> IO [FilePath]+onlyFiles :: [FilePath] -> IO [FilePath] onlyFiles fs = filterM doesFileExist fs -pageNames :: IO [String]+pageNames :: IO [String] pageNames = do cs <- getDirectoryContents "pages" let fs = map (\x -> "pages/" ++ x) cs fmap ( map (drop 6) ) (onlyFiles fs) -renderPage :: Site -> StringTemplate T.Text -> T.Text -> T.Text+renderMarkdown :: T.Text -> T.Text+renderMarkdown = TL.fromStrict >>> markdown def >>> renderHtml >>> TL.toStrict++renderPage :: Site -> StringTemplate T.Text -> T.Text -> T.Text renderPage s t c = render $ setAttribute "site" s- $ setAttribute "content" c t+ $ setAttribute "content" (renderMarkdown c) t -renderPageFile :: String -> IO T.Text+renderPageFile :: FilePath -> IO T.Text renderPageFile p = do- c <- readFile $ "pages/" ++ p- t <- pageTemplate- s <- readSite- return $ renderPage s t (T.pack c)+ content <- T.readFile $ "pages/" ++ p+ template <- pageTemplate+ site <- readSite+ return $ renderPage site template content -writePage :: String -> T.Text -> IO ()+writePage :: FilePath -> T.Text -> IO () writePage p c = do mkdir $ sitePath ++ p- writeFile (sitePath ++ p ++ "/index.html") (T.unpack c)--generatePage p = do- c <- renderPageFile p- writePage p c- putStrLn $ "Generated " ++ p+ T.writeFile (sitePath ++ p ++ "/index.html") c +generatePage p = renderPageFile p+ >>= writePage p+ >> putStrLn ("Generated " ++ p) generatePages = pageNames >>= mapM_ generatePage
src/Post.hs view
@@ -3,6 +3,7 @@ module Post where import qualified Data.Text as T+import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL import qualified Data.String.Utils as S import Text.StringTemplate@@ -18,11 +19,11 @@ import Site import Control.Monad import Constant-import Network.HTTP.Base (urlEncode) -postPath = "posts/" :: String+postPath = "posts/" -replace a b c = S.replace a b (T.unpack c)+replace :: String -> String -> T.Text -> T.Text+replace a b c = T.pack $ S.replace a b (T.unpack c) data Post = Post { title :: T.Text , link :: T.Text@@ -33,78 +34,74 @@ postTemplate = do templates <- directoryGroup "templates" :: IO (STGroup T.Text)- let Just t = getStringTemplate "post" templates- return t+ return $ maybe (newSTMP "post.st not found")+ id+ (getStringTemplate "post" templates) -renderPost :: Site -> StringTemplate T.Text -> Post -> T.Text+renderPost :: Site -> StringTemplate T.Text -> Post -> T.Text renderPost s t p = render $ setAttribute "site" s $ setAttribute "post" p t -renderPostT :: Post -> IO T.Text+renderPostT :: Post -> IO T.Text renderPostT p = do- t <- postTemplate- s <- readSite- return $ renderPost s t p+ template <- postTemplate+ site <- readSite+ return $ renderPost site template p -makeExtract :: Post -> T.Text-makeExtract p = T.pack- $ "<h2>" ++ T.unpack (title p) ++ "</h2>"- ++ "<h3>" ++ T.unpack (date p) ++ "</h3>"- ++ unlines (take 25 $ lines $ T.unpack $ content p)- ++ "</code></pre></li></ul></ol></p>"- ++ "<br/><a href=\'" ++ T.unpack (link p) ++ "\'>Read more...</a>"- ++ "<br/><br/><hr/>"+makeExtract :: Post -> T.Text+makeExtract p = let a = T.append in "<h2>" `a` (title p) `a` "</h2>"+ `a` "<h3>" `a` (date p) `a` "</h3>"+ `a` T.unlines (take 25 $ T.lines $ content p)+ `a` "</code></pre></li></ul></ol></p>"+ `a` "<br/><a href=\'" `a` (link p) `a` "\'>Read more...</a>"+ `a` "<br/><br/><hr/>" -makePost :: [String] -> Post-makePost l = Post { title = T.pack $ head l- , link = T.pack $ "/" ++ S.replace "-" "/" (l !! 1) ++ "/" ++ linkify (head l)- , date = T.pack $ l !! 1- , comment = T.pack $ l !! 2- , content = T.pack $ extractContent l+makePost :: [T.Text] -> Post+makePost l = let a = T.append in Post { title = head l+ , link = "/" `a` (replace "-" "/" (l !! 1))+ `a` "/" `a` linkify (head l)+ , date = l !! 1+ , comment = l !! 2+ , content = extractContent l } -extractContent :: [String] -> String-extractContent l = TL.unpack+extractContent :: [T.Text] -> T.Text+extractContent lines = TL.toStrict $ renderHtml $ markdown def- $ TL.pack- $ unlines- $ drop 3 l+ $ TL.fromStrict+ $ T.unlines+ $ drop 3 lines -getPost :: FilePath -> IO Post-getPost n = do- c <- readFile n- return $ makePost $ lines c+getPost :: FilePath -> IO Post+getPost n = T.readFile n >>= (return . makePost . T.lines) -getNames :: IO [FilePath]+getNames :: IO [FilePath] getNames = do d <- globDir [compile "*.post"] postPath return $ (sort . head . fst) d -linkify :: [Char] -> [Char]-linkify s = filter (\x -> isAlphaNum x || x=='-')- $ map toLower- $ S.replace " " "-" s+linkify :: T.Text -> T.Text+linkify s = T.filter (\x -> isAlphaNum x || x == '-')+ $ T.map toLower+ $ replace " " "-" s -writePosts :: [Post] -> IO ()+writePosts :: [Post] -> IO () writePosts ps = mapM_ writePost ps -writePost :: Post -> IO ()+writePost :: Post -> IO () writePost p = do- let d = S.replace "-" "/" (T.unpack $ date p) ++ "/" ++ (linkify $ T.unpack $ title p)- mkdir $ sitePath ++ d+ let a = T.append+ let d = (replace "-" "/" $ date p) `a` "/" `a` (linkify $ title p)+ mkdir $ sitePath ++ (T.unpack d) c <- renderPostT p- writeFile (sitePath ++ d ++ "/index.html") (T.unpack $ T.append "\n" c)+ T.writeFile (sitePath ++ (T.unpack d) ++ "/index.html") (T.append "\n" c) -getAllPosts :: IO [Post]-getAllPosts = do- ns <- getNames- mapM getPost ns+getAllPosts :: IO [Post]+getAllPosts = getNames >>= mapM getPost -getAllExtracts :: IO [T.Text]-getAllExtracts = do- ps <- getAllPosts- return $ map makeExtract ps+getAllExtracts :: IO [T.Text]+getAllExtracts = getAllPosts >>= (return . (map makeExtract)) generatePosts = getAllPosts >>= writePosts >> putStrLn "Generated posts"
src/Server.hs view
@@ -1,7 +1,10 @@ module Server where -import Happstack.Server ( Browsing(EnableBrowsing), nullConf+import Happstack.Server ( Browsing (EnableBrowsing), nullConf , serveDirectory, simpleHTTP )-startServer :: IO ()-startServer = simpleHTTP nullConf $ serveDirectory EnableBrowsing ["index.html"] "site/"+import Constant++startServer :: IO ()+startServer = simpleHTTP nullConf+ $ serveDirectory EnableBrowsing ["index.html"] sitePath
src/Site.hs view
@@ -21,7 +21,7 @@ , tagline = "Description of this blog" } -readSite :: IO Site+readSite :: IO Site readSite = do t <- getSetting "site" "title" s <- getSetting "site" "style"
src/def/pages/about view
@@ -1,1 +1,2 @@-<p>This is about you.</p>+##About+This is about you
src/def/pages/contact view
@@ -1,1 +1,2 @@-<p>Contact you at your email</p>+##Contact+Contact me at my email
src/def/posts/first.post view
@@ -2,7 +2,7 @@ 2014-04-05 A comment -Something interesting. Here is some highlighted code:+Something interesting. Here is some code: #include <stdio.h>