rezoom 0.0.1 → 0.0.2
raw patch · 3 files changed
+180/−1 lines, 3 files
Files
- Rezoom/Builder.hs +123/−0
- Rezoom/JSON.hs +55/−0
- rezoom.cabal +2/−1
+ Rezoom/Builder.hs view
@@ -0,0 +1,123 @@+module Rezoom.Builder (+ build+ ) 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 Paths_rezoom+ import System.IO++ eStr = extractString+ + type Opts = M.Map String String+ + instance Eq Html where+ x == y = showHtml x == showHtml y+ + build :: Opts -> Either String JSValue -> IO String+ build opts val = fmap (renderHtml) $ build_ opts val+ + build_ :: Opts -> Either String JSValue -> IO Html+ build_ _ (Left err) = buildErr err+ build_ opts (Right v) = case v $$ "repositories" of + Nothing -> error "Unknown username."+ Just repos -> do+ filename <- getDataFileName "Rezoom/rezoom.css"+ fileContents <- readFile filename+ return $ buildHeader fileContents +++ body <<+ thediv ! [identifier "container"] <<+ thediv ! [identifier "container-inner"] <<+ (header_ opts ++++ (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
+ Rezoom/JSON.hs view
@@ -0,0 +1,55 @@+module Rezoom.JSON(+ parse+ , extractList, extractString+ , getOr+ , hasKey+ + -- * JSON object accessors+ , ($$), ($$!)+ ) where+ import Text.JSON+ import Data.Maybe+ import Data.List+ import Control.Applicative ((<$>))+ + parse :: String -> Either String JSValue+ parse = resultToEither . decode+ + -- Look up a value in a JSON object+ ($$) :: JSValue -> String -> Maybe JSValue+ tree $$ idx = case filter (\x -> idx == (fst x)) (extractObject tree) of+ x:_ -> Just $ snd x+ [] -> Nothing+ + -- Unsafe version of $$+ ($$!) :: JSValue -> String -> JSValue+ tree $$! idx = fromJust $ tree $$ idx+ + hasKey :: String -> JSValue -> Bool+ hasKey idx tree = isJust $ tree $$ idx+ + -- Version of $$ that allows you to provide an alternative value+ getOr :: String -> String -> JSValue -> String+ getOr alt index tree = maybe alt id $ extractString <$> tree $$ index+ + -- map applied to a JSON list+ mapJ :: (JSValue -> a) -> JSValue -> [a]+ mapJ fn list = map fn $ extractList list+ + -- sort applied to a JSON list+ sortJ :: (JSValue -> JSValue -> Ordering) -> JSValue -> [JSValue]+ sortJ fn list = sortBy fn $ extractList list+ + -- Text.JSON's structure kind of sucks, so we need a bunch of+ -- generic extractor functions here+ extractObject :: JSValue -> [(String, JSValue)]+ extractObject (JSObject e) = fromJSObject e+ extractObject _ = error "invalid input"+ + extractString :: JSValue -> String+ extractString (JSString e) = fromJSString e+ extractString _ = error "invalid input"+ + extractList :: JSValue -> [JSValue]+ extractList (JSArray xs) = xs+ extractList _ = error "invalid input"
rezoom.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: >= 1.6 Name: rezoom-Version: 0.0.1+Version: 0.0.2 Synopsis: Github resume generator Description: Generates a resume from your github page. License: GPL@@ -19,3 +19,4 @@ Executable rezoom Main-is: Main.hs Build-Depends: base == 4.*, json == 0.5.*, xhtml == 3000.*, HTTP == 4000.*, nano-md5 == 0.1.*, bytestring == 0.9.*, datetime == 0.2.*, containers == 0.4.*+ Other-Modules: Rezoom.Builder, Rezoom.JSON