packages feed

leaf-1.0.0.0: src/Wrapper.hs

{-# LANGUAGE OverloadedStrings #-}

module Wrapper where

import Control.Monad
import Data.Functor
import Control.Applicative
import Data.List (intercalate)
import Data.List.Split
import Leaf.String
import System.Directory (doesFileExist)
import System.IO
import Text.Blaze.Html as B
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A

-- construct a simple name with intercalated nick
prettyName :: (String,String,String) -> String
prettyName (f,l,n) = intercalate (" " ++ n ++ " ") [f,l]

-- take the first name, the last name and the nick of the portfolio, then
-- make a header
header :: String -> Html
header fln = H.div ! A.id "wrapper_header" $ titleElem
    where titleElem  = h1 ! A.id "wrapper_header_title" $ toHtml fln

-- take the name of the porfolio, the range year and make a footer
footer :: String -> Int -> Maybe Int -> Html
footer fln start rangeEnd = H.footer ! A.id "wrapper_footer" $ copyright >> generator
  where copyright  = p ! A.id "wrapper_footer_copyright" $ toHtml ("(C) " ++ fln ++ ", (" ++ show start ++ maybeRange ++ ")")
        generator  = p ! A.id "wrapper_footer_generator" $ toHtml ("Generated by " :: String) >> code "leaf"
        maybeRange = case rangeEnd of
                       Just end -> "-" ++ show end
                       _        -> ""

-- make a navbar
navbar :: [String] -> String -> Html
navbar links current = nav (ul ! A.id "wrapper_navbar" $ lis)
  where lis = foldl (\acc x -> acc >> (li ! class_ "wrapper_navbar_item" $ if x == current then toHtml x else toLink x)) (return ()) links
        toLink l = a ! href (toValue $ l++".html") $ toHtml l

-- a wrapper is a actually a function that takes a list of
-- elements, representing the per-page content, and makes the below
-- list:
--   header : navbar : concat content : footer
-- it also generates the head and body elements
wrapper :: Html -> Html -> (String -> Html) -> String -> Html -> Html
wrapper h f n t c = docTypeHtml $ headElem >> bodyElem
  where headElem  = H.head $ metaElem >> linkElem >> titleElem
        metaElem  = meta ! charset "utf-8"
        linkElem  =   link ! href "default.css" ! type_ "text/css" ! rel "stylesheet"
                  >>  link ! href "http://fonts.googleapis.com/css?family=Cantarell&v1" ! type_ "text/css" ! rel "stylesheet"
        titleElem = H.title $ toHtml t
        bodyElem  = body ! A.id "wrapper" $ h >> n t >> content >> f
        content   = H.div ! A.id "wrapper_content" $ c

-- A wrapper data helper to build a wrapper curryfied function
data WrapperHelper
  = WrapperHelper { _wrapperFN :: String
                  , _wrapperLN :: String
                  , _wrapperNick :: String
                  , _wrapperYear :: Int
                  , _wrapperItems :: [String]
                  , _wrapperStyle :: String
                  } deriving Show
                  
fromString :: String -> WrapperHelper
fromString content =
  let tokens = splitWhen (==':') <$> lines content -- careful, not stripped!
  in buildHelper  $ Prelude.map (Prelude.map strip) tokens
    where buildHelper = foldl buildByToken (WrapperHelper "" "" "" 0 [] "")
          buildByToken h (t:v:[])
            | t == "Firstname" = h { _wrapperFN   = v }
            | t == "Lastname"  = h { _wrapperLN   = v }
            | t == "Nick"      = h { _wrapperNick = v }
            | t == "Year"      = h { _wrapperYear = read v }
            | t == "Items"     = h { _wrapperItems = splitWhen (==',') v }
            | t == "Style"     = h { _wrapperStyle = v }
            | otherwise        = error "Invalid token"
          buildByToken _ _ = error "empty token is invalid"

templateWrapperString :: String
templateWrapperString =
  "Firstname: [your firstname]\n\
  \Lastname: [your lastname]\n\
  \Nick: [your nickname]\n\
  \Year: [year] or [start_year-current_year]\n\
  \Items: [all items in the nav, separated by comas, no blanks]\n\
  \Style: default"

minimalCSSString :: String
minimalCSSString =
  ""