diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 \ or \ tags. -Here's how you might do that: - - $ cat >> pages/mypage <My Custom Page -

This is a page I made!

- 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. diff --git a/changelog b/changelog new file mode 100644 --- /dev/null +++ b/changelog @@ -0,0 +1,4 @@ +0.1.0.8 Kaashif Hymabaccus +* Finished core functionality +* Converted all functions to using Text, not String +* Removed "not a blog" warnings on help and init commands diff --git a/muon.cabal b/muon.cabal --- a/muon.cabal +++ b/muon.cabal @@ -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 diff --git a/src/Archive.hs b/src/Archive.hs --- a/src/Archive.hs +++ b/src/Archive.hs @@ -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 = "" - ++ "" ++ T.unpack (title p) ++ "" - ++ "" ++ T.unpack (date p) ++ "" - ++ "" ++ T.unpack (comment p) ++ "" - ++ "" +makeTableRow :: Post -> T.Text +makeTableRow p = let a = T.append in "" + `a` "" `a` (title p) `a` "" + `a` "" `a` (date p) `a` "" + `a` "" `a` (comment p) `a` "" + `a` "" -makeTable :: [Post] -> T.Text -makeTable ps = T.pack - $ "" - ++ "" - ++ unlines (map makeTableRow ps) - ++ "
TitleDateComment
" +makeTable :: [Post] -> T.Text +makeTable ps = let a = T.append in "" + `a` "" + `a` T.unlines (map makeTableRow ps) + `a` "
TitleDateComment
" -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" diff --git a/src/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -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" diff --git a/src/Constant.hs b/src/Constant.hs --- a/src/Constant.hs +++ b/src/Constant.hs @@ -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) diff --git a/src/Home.hs b/src/Home.hs --- a/src/Home.hs +++ b/src/Home.hs @@ -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) diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/src/Page.hs b/src/Page.hs --- a/src/Page.hs +++ b/src/Page.hs @@ -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 diff --git a/src/Post.hs b/src/Post.hs --- a/src/Post.hs +++ b/src/Post.hs @@ -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 - $ "

" ++ T.unpack (title p) ++ "

" - ++ "

" ++ T.unpack (date p) ++ "

" - ++ unlines (take 25 $ lines $ T.unpack $ content p) - ++ "

" - ++ "
Read more..." - ++ "

" +makeExtract :: Post -> T.Text +makeExtract p = let a = T.append in "

" `a` (title p) `a` "

" + `a` "

" `a` (date p) `a` "

" + `a` T.unlines (take 25 $ T.lines $ content p) + `a` "

" + `a` "
Read more..." + `a` "

" -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" diff --git a/src/Server.hs b/src/Server.hs --- a/src/Server.hs +++ b/src/Server.hs @@ -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 diff --git a/src/Site.hs b/src/Site.hs --- a/src/Site.hs +++ b/src/Site.hs @@ -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" diff --git a/src/def/pages/about b/src/def/pages/about --- a/src/def/pages/about +++ b/src/def/pages/about @@ -1,1 +1,2 @@ -

This is about you.

+##About +This is about you diff --git a/src/def/pages/contact b/src/def/pages/contact --- a/src/def/pages/contact +++ b/src/def/pages/contact @@ -1,1 +1,2 @@ -

Contact you at your email

+##Contact +Contact me at my email diff --git a/src/def/posts/first.post b/src/def/posts/first.post --- a/src/def/posts/first.post +++ b/src/def/posts/first.post @@ -2,7 +2,7 @@ 2014-04-05 A comment -Something interesting. Here is some highlighted code: +Something interesting. Here is some code: #include