Not found :(
+Sorry, but the page you were trying to view does not exist.
+It looks like this was the result of either:
+-
+
- a mistyped address +
- an out-of-date link +
diff --git a/.gitignore b/.gitignore index bb34055..a1ade49 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,5 @@ cabal-dev *.chs.h _site _cache +*.*~ +src/site diff --git a/src/site.hs b/src/site.hs index d03337c..23a533b 100644 --- a/src/site.hs +++ b/src/site.hs @@ -1,12 +1,12 @@ {-# LANGUAGE DeriveDataTypeable, Arrows, OverloadedStrings #-} -import Control.Arrow (returnA, (>>>), arr) +import Control.Arrow (returnA, (>>>), arr, (***)) import Data.FileStore hiding (create) import Hakyll import Text.Blaze.Renderer.String (renderHtml) import Text.Blaze.Html5 ((!),toValue) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A -import Data.Monoid (mempty, mconcat, mempty) +import Data.Monoid (mempty, mconcat, mempty, mappend) import Data.List (elemIndex) import Data.Maybe (fromMaybe) import System.FilePath (combine, dropExtension, takeFileName) @@ -16,17 +16,14 @@ type Diff = [(DI, [String])] fileStore :: FileStore fileStore = gitFileStore "/home/irv/Projects/whistlepig/articles" -getRevisionList :: Compiler (String) (FilePath, [(Revision, Revision)]) +getRevisionList :: Compiler String (FilePath, [(Revision, Revision)]) getRevisionList = unsafeCompiler $ \path -> do - revs <- getRevisions $ takeFileName path - return (path, makePairList revs) - -- makePairList [1..4] => [(1,2),(2,3),(3,4)] - where makePairList xs = [(y, x) | x <- xs, y <- xs, y == getListPrev x (reverse xs), x /= y] + lst <- getRevisions $ takeFileName path + putStrLn $ show $ lst + return (path, lst) getDiff :: Compiler (FilePath, [(Revision, Revision)]) Diff getDiff = unsafeCompiler $ \(page,rl) -> do - putStrLn page - putStrLn $ show $ rl diffs <- mapM (getFileDiff (takeFileName page) ) rl return $ concat diffs @@ -43,20 +40,24 @@ renderDiff l = renderHtml $ H.pre ! A.class_ (attrCls (fst l)) $ diffCnt l getFileDiff :: FilePath -> (Revision, Revision) -> IO Diff getFileDiff f a = diff fileStore f (Just $ revId $ fst a) (Just $ revId $ snd a) -getRevisions :: FilePath -> IO [Revision] -getRevisions f = history fileStore [f] (TimeRange Nothing Nothing) +getRevisions :: FilePath -> IO [(Revision, Revision)] +getRevisions f = do + revList <- history fileStore [f] (TimeRange Nothing Nothing) + return $ makePairList revList + -- makePairList [1..4] => [(1,2),(2,3),(3,4)] + where makePairList xs = [(y, x) | x <- xs, y <- xs, y == getListPrev x (reverse xs), x /= y] getListPrev :: Eq a => a -> [a] -> a getListPrev i l = l !! checkBounds (fromMaybe 0 (i `elemIndex` l) +1 ) where checkBounds x | x > length l -1 = length l-1 | otherwise = x constructDiff :: String -> Diff -> Compiler () (Page String) -constructDiff i d = constA (mempty) +constructDiff i d = constA mempty >>> arr (setField "diff" (diff' d)) >>> arr (setField "title" ("Changes " ++ i)) >>> applyTemplateCompiler "templates/diff.html" >>> applyTemplateCompiler "templates/default.html" - where diff' l = concatMap renderDiff l + where diff' = concatMap renderDiff makeRevisionCompiler :: Compiler (Page String) @@ -66,7 +67,7 @@ makeRevisionCompiler = proc page -> do diff' <- getDiff -< revisionList let gd = constructDiff (getField "path" page) diff' returnA -< (diff_ident revisionList, gd) - where diff_ident i = parseIdentifier $ ("diffs/" ++ (revId ( fst $ head $ snd i))) ++ ("_" ++ (revId ( fst $ head $ snd i))) ++ ".markdown" + where diff_ident i = parseIdentifier $ ("diffs/" ++ revId ( fst $ head $ snd i)) ++ ("_" ++ revId ( snd $ head $ snd i)) ++ ".markdown" -- where diff_ident (_, (b,c):_) = parseIdentifier $ "diffs/" ++ (show $ revId b) ++ "_" ++ (show $ revId c) -- diff_ident (a, []) = parseIdentifier $ a @@ -76,37 +77,29 @@ routePage = customRoute fileToDirectory fileToDirectory :: Identifier a -> FilePath fileToDirectory = flip combine "index.html" . dropExtension . toFilePath -makeTagList :: String - -> [Page String] - -> Compiler () (Page String) -makeTagList tag posts = - constA (mempty, posts) - >>> addPostList - >>> arr (setField "title" ("Posts tagged ‘" ++ tag ++ "’")) - >>> applyTemplateCompiler "templates/posts.html" - >>> applyTemplateCompiler "templates/default.html" - >>> relativizeUrlsCompiler - -addPostList :: Compiler (Page String, [Page String]) (Page String) -addPostList = setFieldA "posts" $ - arr (reverse . chronological) - >>> require "templates/postitem.html" (\p t -> map (applyTemplate t) p) - >>> arr mconcat - >>> arr pageBody - --- addRevisionList :: Compiler (Page String) (Page String) --- addRevisionList = unsafeCompiler $ \path -> do --- -- helpfully, returns empty list if filepath can't be found --- let rev = path >>> getRevisionList --- --let rev' = applyRender rev --- return $ arr( setField "history" $ concatMap renderRevision rev) --- --where applyRender rev = concatMap renderRevision rev +-- makeTagList :: String +-- -> [Page String] +-- -> Compiler () (Page String) +-- makeTagList tag posts = +-- constA (mempty, posts) +-- >>> addPostList +-- >>> arr (setField "title" ("Posts tagged ‘" ++ tag ++ "’")) +-- >>> applyTemplateCompiler "templates/posts.html" +-- >>> applyTemplateCompiler "templates/default.html" +-- >>> relativizeUrlsCompiler + +-- addPostList :: Compiler (Page String, [Page String]) (Page String) +-- addPostList = setFieldA "posts" $ +-- arr (reverse . chronological) +-- >>> require "templates/postitem.html" (\p t -> map (applyTemplate t) p) +-- >>> arr mconcat +-- >>> arr pageBody addRevisionList :: Compiler (Page String) (Page String) -addRevisionList = proc page -> do - (_,rev) <- getRevisionList -< (getField "path" page) - let h = concatMap renderRevision rev - returnA -< ( setFieldA "history" h ) +addRevisionList = unsafeCompiler $ \page -> do + let path = getField "path" page + lst <- getRevisions $ takeFileName path + return $ setField "history" (concatMap renderRevision lst) page renderRevision :: (Revision, Revision) -> String renderRevision rl = renderHtml $ H.tr $ do @@ -117,6 +110,19 @@ renderRevision rl = renderHtml $ H.tr $ do main :: IO () main = hakyll $ do + match "files/*" $ do + route idRoute + compile copyFileCompiler + -- Compress CSS + match "css/*" $ do + route idRoute + compile compressCssCompiler + + match "about/*" $ do + route $ setExtension ".html" + compile $ pageCompiler + >>> applyTemplateCompiler "templates/default.html" + >>> relativizeUrlsCompiler -- Render articles _ <- ($) match "articles/*" $ do route $ setExtension ".html" @@ -130,19 +136,29 @@ main = hakyll $ do group "diffs" $ match "articles/*" $ metaCompile $ requireAll_ "articles/*" >>> mapCompiler makeRevisionCompiler - match "diffs/*" $ route $ setExtension ".html" - _ <- ($) match "templates/*" $ compile templateCompiler - + match "diffs/*" $ route $ gsubRoute "diffs/" (const "articles/diffs/") `composeRoutes` setExtension "html" + match "templates/*" $ compile templateCompiler + -- Index +-- match "index.html" $ route idRoute +-- create "index.html" $ constA mempty +-- >>> arr (setField "title" "Home") +-- >>> requireA "tags" (setFieldA "tagcloud" renderTagCloud') +-- >>> requireAllA ("articles/*" `mappend` inGroup Nothing) (id *** arr (take 3 . reverse . chronological) >>> addPostList) +-- >>> applyTemplateCompiler "templates/index.html" +-- >>> applyTemplateCompiler "templates/default.html" +-- >>> relativizeUrlsCompiler -- Tags - _ <- ($) create "tags" $ - requireAll "articles/*" (\_ ps -> readTags ps :: Tags String) - - -- Add a tag list compiler for every tag - match "tags/*" $ route $ setExtension ".html" - metaCompile $ require_ "tags" - >>> arr tagsMap - >>> arr (map (\(t, p) -> (tagIdentifier t, makeTagList t p))) +-- _ <- ($) create "tags" $ +-- requireAll "articles/*" (\_ ps -> readTags ps :: Tags String) +-- +-- -- Add a tag list compiler for every tag +-- match "tags/*" $ route $ setExtension ".html" +-- metaCompile $ require_ "tags" +-- >>> arr tagsMap +-- >>> arr (map (\(t, p) -> (tagIdentifier t, makeTagList t p))) where tagIdentifier :: String -> Identifier (Page String) tagIdentifier = fromCapture "tags/*" + renderTagCloud' :: Compiler (Tags String) String + renderTagCloud' = renderTagCloud tagIdentifier 100 120 diff --git a/templates/404.html b/templates/404.html new file mode 100644 index 0000000..4c8c841 --- /dev/null +++ b/templates/404.html @@ -0,0 +1,38 @@ + + +
+ +Sorry, but the page you were trying to view does not exist.
+It looks like this was the result of either:
++ Hi! My name's Andy, I'm a senior developer, rubbish alpinist and punk rock legend. +
+by $author$ on $date$
+ +Tagged as: $prettytags$.
+ +$body$ + +