module Rezoom.Builder ( build, Resume(..) ) where import Text.XHtml.Strict import Text.JSON import Rezoom.JSON import Data.Digest.OpenSSL.MD5 (md5sum) import qualified Data.Map as M import qualified Data.ByteString.Char8 as B import Data.Maybe import Data.Char (toLower) import Data.Ord (comparing) import Data.List import Data.DateTime import System.IO import Control.Monad.Reader eStr = extractString type Opts = M.Map String String data Resume = Resume { opts :: Opts, source :: JSValue, css :: String } instance Eq Html where x == y = showHtml x == showHtml y build :: Resume -> String build = do v <- source case v $$ "repositories" of Nothing -> error "Unknown username." Just repos -> do fileContents <- css options <- opts return $ renderHtml $ buildHeader fileContents +++ body << thediv ! [identifier "container"] << thediv ! [identifier "container-inner"] << (header_ options +++ (subsection "Skills" ["langs"] $ skillList knownRepos) +++ sectionize knownRepos) where knownRepos = sortBy (comparing ($$! "language")) $ filter (hasKey "language") $ extractList repos sectionize :: [JSValue] -> [Html] sectionize = map (\e -> (<<) (thediv ! (secAttrs $ langname e)) [sectionHeader $ langname e, thediv ! [theclass "subsection"] << ulist << projectList e] ) . groupBy (\x y -> x $$! "language" == y $$! "language") where langname e = eStr $ (head e) $$! "language" secAttrs str = let lower = map toLower str in [theclass $ "section lang-" ++ lower ++ " lang", identifier $ lower] sectionHeader :: String -> Html sectionHeader js = h3 ! [theclass "side"] << js projectList :: [JSValue] -> [Html] projectList vals = map (\e -> li ! [theclass "project"] << (projectHeader e +++ (thediv ! [theclass "description"] << (eStr $ e $$! "description"))) ) $ reverse $ sortBy (comparing ($$! "pushed_at")) vals header_ :: Opts -> Html header_ opts = thediv ! [identifier "header"] << [gravatar opts, headerName opts, h4 << ulist << linkList opts] projectHeader :: JSValue -> Html projectHeader js = h3 << (anchor ! [href $ eStr $ js $$! "url"] << (eStr $ js $$! "name") +++ " " +++ thespan ! [theclass "pushed"] << ("↑ " ++ ctsr)) where create_time = fromJust $ parseDateTime "%Y/%m/%d %T %Z" $ eStr $ js $$! "pushed_at" ctsr = formatDateTime "%b %d, %Y" create_time gravatar :: Opts -> Html gravatar opts = case M.lookup "email" opts of Just email -> thediv ! [identifier "avatar"] << image ! [src $ "http://www.gravatar.com/avatar/" ++ hash ++ "?size=96"] where hash = md5sum $ B.pack $ map toLower email Nothing -> thediv << "" headerName :: Opts -> Html headerName opts = h2 << (case M.lookup "realname" opts of Just name -> name +++ bold << "/" +++ unamelink Nothing -> unamelink) where username = fromJust $ M.lookup "username" opts unamelink = anchor ! [href $ "http://github.com/" ++ username] << username subsection :: String -> [String] -> Html -> Html subsection secname classes cont = thediv ! [theclass $ intercalate " " ("section":classes)] << [h3 ! [theclass "side"] << secname, thediv ! [theclass "subsection"] << cont] linkList :: Opts -> [Html] linkList opts = map (\r -> li << anchor ! [href $ fromJust $ M.lookup r opts] << r ) $ filter (not . isNothing . flip M.lookup opts) ["email", "facebook", "twitter"] skillList :: [JSValue] -> Html skillList list = (<<) ulist $ nub $ map (\e -> let val = eStr $ e $$! "language" in li << anchor ! [href $ map (toLower) ('#':val)] << val) list format_ :: String -> [String] -> String format_ [] args = [] format_ str [] = str format_ (x:xs) args = case x of '%' -> head args ++ format_ xs (tail args) y -> y:format_ xs args buildErr :: String -> IO Html buildErr str = return $ (<<) body $ "Error: " ++ str buildHeader :: String -> Html buildHeader str = header << style ! [thetype "text/css"] << str