Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Fixing compile warnings

  • Loading branch information...
commit 66a6dda3857bb8020d1273bf0f358c534b5caf07 1 parent 13cf890
@deepakjois authored
Showing with 41 additions and 20 deletions.
  1. +0 −2  TODO
  2. +25 −15 bin/books.hs
  3. +15 −2 bin/site.hs
  4. +1 −1  compile.sh
View
2  TODO
@@ -1,3 +1 @@
-* Clean code
-* Add warnings for unused (check blaze-html cabal file)
* Figure out what to do with papaers and logbook
View
40 bin/books.hs
@@ -34,13 +34,13 @@ data Book = Book {
} deriving Show
instance JSON Book where
- showJSON (Book title link author category readable date) =
- makeObj [ ("title", showJSON title)
- , ("link", showJSON link)
- , ("author", showJSON author)
- , ("category", showJSON category)
- , ("readable", showJSON readable)
- , ("date", showJSON date)
+ showJSON (Book t l a c r d) =
+ makeObj [ ("title", showJSON t)
+ , ("link", showJSON l)
+ , ("author", showJSON a)
+ , ("category", showJSON c)
+ , ("readable", showJSON r)
+ , ("date", showJSON d)
]
readJSON (JSObject obj) =
@@ -57,16 +57,18 @@ instance JSON Book where
d <- lookupP "date"
return $ Book t l a c r d
+ readJSON _ = undefined
-- Convert a string representation of a JSON array to an list of 'Book's
books :: String -> [Book]
books json = rights
$ map (resultToEither . readJSON)
- $ objArray json where
- objArray json = case runGetJSON readJSArray json of
- Right (JSArray xs) -> xs
- _ -> []
+ $ objArray where
+ objArray = case runGetJSON readJSArray json of
+ Right (JSArray xs) -> xs
+ _ -> []
-- Month extracted from date
+month :: Book -> String
month = (take 2 . drop 5) . date
-- Convert a month number to its name
@@ -87,6 +89,7 @@ monthName n = [ "January"
] !! (n-1)
-- Convert a single book to an <li> element
+bookLiElem :: Book -> H.Html
bookLiElem book = H.li ! H.dataAttribute "category" (fromString c) $ do
booklink
starIfReadable
@@ -96,22 +99,29 @@ bookLiElem book = H.li ! H.dataAttribute "category" (fromString c) $ do
starIfReadable = if r then H.em ! A.class_ "impt" $ "*" else ""
-- Convert a list of books to a @ul@ element
-booksHtmlList books = H.ul $ mapM_ bookLiElem books
+booksHtmlList :: [Book] -> H.Html
+booksHtmlList b = H.ul $ mapM_ bookLiElem b
-- Convert a list of books to HTML with a month header and list
-booksMonthlyHtml books = do H.h2 ! A.id (fromString $ map toLower m) $ H.toHtml m
- booksHtmlList books
- where m = monthName $ (read . month) $ head books
+booksMonthlyHtml :: [Book] -> H.Html
+booksMonthlyHtml b = do H.h2 ! A.id (fromString $ map toLower m) $ H.toHtml m
+ booksHtmlList b
+ where m = monthName $ (read . month) $ head b
-- Convert a list of books grouped by month to HTML
+booksYearlyHtml :: [[Book]] -> H.Html
booksYearlyHtml = mapM_ booksMonthlyHtml
-- Group a list of books by the month they were read in
+booksGroupedByMonth :: [Book] -> [[Book]]
booksGroupedByMonth = groupBy sameMonth
where sameMonth a b = month a == month b
-- Render a JSON string representing a list of books to HTML
+booksJSONToHtml :: String -> H.Html
booksJSONToHtml = (booksYearlyHtml . booksGroupedByMonth) . books
+-- Test method
+printBooks :: IO ()
printBooks = do json <- readFile "data/books.json"
putStr $ renderHtml $ booksJSONToHtml json
View
17 bin/site.hs
@@ -1,9 +1,9 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, RankNTypes #-}
import Control.Monad (forM_)
import Control.Arrow (arr, (>>>))
import System.FilePath (joinPath, splitPath)
import Data.List.Split (splitOn)
-import Data.String (fromString)
+import Data.String()
import Text.Blaze.Renderer.String (renderHtml)
import Hakyll
@@ -56,9 +56,11 @@ main = hakyllWith config $ do
-- *****************
-- Inner pages
+innerPages :: forall a. Pattern a
innerPages = list ["source/code.markdown", "source/books/old_2006-2009.html"]
-- Pages containing list of books
+bookPages :: [String]
bookPages = ["source/books.markdown","source/books/2011.markdown", "source/books/2010.markdown"]
@@ -67,9 +69,11 @@ bookPages = ["source/books.markdown","source/books/2011.markdown", "source/books
-- *****************
-- Custom route to drop the topmost dir from the identifier
+stripTopDir :: Routes
stripTopDir = customRoute $ joinPath . tail . splitPath . toFilePath
-- Combination of dropping the topmost dir and adding the HTML extension
+defaultHtml :: Routes
defaultHtml = stripTopDir `composeRoutes` setExtension "html"
@@ -78,20 +82,28 @@ defaultHtml = stripTopDir `composeRoutes` setExtension "html"
-- *****************
-- Default compiler for all pages
+defaultCompiler :: Identifier Template
+ -> Compiler Resource (Page String)
defaultCompiler template = pageCompiler >>>
renderLayout template
-- Compiler for pages containing book list
+bookPageCompiler :: Identifier (Page String)
+ -> Compiler Resource (Page String)
bookPageCompiler json = pageCompiler >>>
renderBookPage json >>>
renderLayout "templates/inner.html"
-- Render a list of books
+renderBookPage :: Identifier (Page String)
+ -> Compiler (Page String) (Page String)
renderBookPage json = setFieldPage "books" json >>>
arr (changeField "books" $ renderHtml . booksJSONToHtml) >>>
applyTemplateCompiler "templates/books.html"
-- Render a standard layout containing some includes
+renderLayout :: Identifier Template
+ -> Compiler (Page String) (Page String)
renderLayout template = setFieldPage "analytics" "includes/analytics.html" >>>
setFieldPage "nav" "includes/nav.html" >>>
applyTemplateCompiler template
@@ -101,6 +113,7 @@ renderLayout template = setFieldPage "analytics" "includes/analytics.html" >>>
-- Configuration
-- *****************
+config :: HakyllConfiguration
config = defaultHakyllConfiguration {
deployCommand = "s3cmd sync -r _site/* s3://www.deepak.jois.name"
}
View
2  compile.sh
@@ -1,4 +1,4 @@
#!/bin/sh
-ghc -ibin --make bin/site.hs
+ghc -Wall -fno-warn-orphans -fno-warn-unused-do-bind -ibin --make bin/site.hs
Please sign in to comment.
Something went wrong with that request. Please try again.