1 {-# LANGUAGE OverloadedStrings #-}
    2 module Databrary.View.Template
    3   ( htmlHeader
    4   , htmlFooter
    5   , htmlTemplate
    6   , htmlSocialMedia
    7   ) where
    8 
    9 import Control.Monad (void, when, forM_)
   10 import qualified Data.ByteString.Builder as BSB
   11 import Data.Monoid ((<>))
   12 import qualified Data.Text as T
   13 import Data.Version (showVersion)
   14 import qualified Text.Blaze.Html5 as H
   15 import qualified Text.Blaze.Html5.Attributes as HA
   16 import Network.HTTP.Types (methodGet)
   17 import qualified Network.Wai as Wai
   18 
   19 import Paths_databrary (version)
   20 import Databrary.Ops
   21 import Databrary.Has (view)
   22 import Databrary.Model.Identity
   23 import Databrary.Action.Types
   24 import Databrary.Action.Route
   25 import Databrary.Controller.Paths
   26 import Databrary.View.Html
   27 
   28 import {-# SOURCE #-} Databrary.Controller.Angular
   29 import {-# SOURCE #-} Databrary.Controller.Root
   30 import {-# SOURCE #-} Databrary.Controller.Login
   31 import {-# SOURCE #-} Databrary.Controller.Party
   32 import {-# SOURCE #-} Databrary.Controller.Web
   33 
   34 htmlHeader :: Maybe BSB.Builder -> JSOpt -> H.Html
   35 htmlHeader canon hasjs = do
   36   forM_ canon $ \c ->
   37     H.link
   38       H.! HA.rel "canonical"
   39       H.! HA.href (builderValue c)
   40   H.link
   41     H.! HA.rel "shortcut icon"
   42     H.! HA.href (builderValue $ actionURL Nothing webFile (Just $ staticPath ["icons", "favicon.png"]) [])
   43   H.link
   44     H.! HA.rel "start"
   45     H.! actionLink viewRoot HTML hasjs
   46   forM_ ["news", "about", "access", "community"] $ \l -> H.link
   47     H.! HA.rel l
   48     H.! HA.href ("//databrary.org/" <> l <> ".html")
   49 
   50 htmlAddress :: H.Html
   51 htmlAddress =
   52   H.p H.! HA.class_ "footer-address" $ do
   53     H.strong $ do
   54       void "Databrary"
   55     H.br
   56     void "196 Mercer Street, Room 807 | New York, NY 10012"
   57     H.br
   58     void "212.998.5800"
   59     
   60 htmlSocialMedia :: H.Html
   61 htmlSocialMedia =
   62   H.p H.! HA.class_ "footer-social-media" $ do
   63     let sm n l a =
   64           H.a H.! HA.href l H.! HA.target "_blank" H.! HA.class_ "img" $
   65             H.img H.! HA.id n H.! HA.src ("/web/images/social/16px/" <> n <> ".png") H.! HA.alt a
   66     void "Find us on "
   67     sm "twitter" "https://twitter.com/databrary" "Twitter"
   68     void " "
   69     sm "facebook" "https://www.facebook.com/databrary" "Facebook"
   70     void " "
   71     sm "linkedin" "https://www.linkedin.com/company/databrary-project" "LinkedIn"
   72     void " "
   73     sm "google-plus" "https://plus.google.com/u/1/111083162045777800330/posts" "Google+"
   74     void " "
   75     sm "github" "https://github.com/databrary/" "GitHub"
   76 
   77 htmlFooter :: H.Html
   78 htmlFooter = H.footer H.! HA.id "site-footer" H.! HA.class_ "site-footer" $
   79   H.div H.! HA.class_ "wrap" $
   80     H.div H.! HA.class_ "row" $ do
   81       H.div H.! HA.class_ "site-footer-social-address" $ do
   82         htmlAddress
   83         htmlSocialMedia
   84       H.ul H.! HA.class_ "site-footer-grants" $ do
   85         H.li $
   86           H.a H.! HA.href "http://www.nyu.edu" $ do
   87             H.img H.! HA.src "/web/images/grants/nyu-small.jpg" H.! HA.class_ "nyu"
   88         H.li $
   89           H.a H.! HA.href "http://www.psu.edu" $ do
   90             H.img H.! HA.src "/web/images/grants/pennstate.png" H.! HA.class_ "psu"
   91         H.li $
   92           H.a H.! HA.href "http://www.nsf.gov/awardsearch/showAward?AWD_ID=1238599&HistoricalAwards=false" $ do
   93             H.img H.! HA.src "/web/images/grants/nsf.png" H.! HA.class_ "nsf"
   94             " BCS-1238599"
   95         H.li $
   96           H.a H.! HA.href "http://projectreporter.nih.gov/project_info_description.cfm?aid=8531595&icde=15908155&ddparam=&ddvalue=&ddsub=&cr=1&csb=default&cs=ASC" $ do
   97             H.img H.! HA.src "/web/images/grants/nih.png" H.! HA.class_ "nih"
   98             " U01-HD-076595"
   99         H.li $
  100           H.a H.! HA.href "https://www.srcd.org/" $ do
  101             H.img H.! HA.src "/web/images/grants/srcd.png" H.! HA.class_ "srcd"
  102         H.li $
  103           H.a H.! HA.href "https://sloan.org/" $ do
  104             H.img H.! HA.src "/web/images/grants/sloan.png" H.! HA.class_ "sloan"
  105         H.li $
  106           H.a H.! HA.href "http://www.legofoundation.com" $ do
  107             H.img H.! HA.src "/web/images/grants/lego.png" H.! HA.class_ "lego"
  108       H.div H.! HA.class_ "site-footer-legal col" $ do
  109         H.p $ do
  110           void "Each dataset on Databrary represents an individual work owned by the party who contributed it. Data on Databrary are provided for non-commercial use and are subject to the terms of use outlined in the "
  111           H.a H.! HA.href "//databrary.org/access/policies/agreement.html" H.! HA.target "_blank" $
  112             "Databrary Access Agreement"
  113           void ". ["
  114           H.string $ showVersion version
  115           "]"
  116 
  117 htmlTemplate :: RequestContext -> Maybe T.Text -> (JSOpt -> H.Html) -> H.Html
  118 htmlTemplate req title body = H.docTypeHtml $ do
  119   H.head $ do
  120     htmlHeader canon hasjs
  121     H.link
  122       H.! HA.rel "stylesheet"
  123       H.! actionLink webFile (Just $ StaticPath "all.min.css") ([] :: Query)
  124     H.title $ do
  125       mapM_ (\t -> H.toHtml t >> " || ") title
  126       "Databrary"
  127   H.body H.! H.customAttribute "vocab" "http://schema.org" $ do
  128     H.section
  129       H.! HA.id "toolbar"
  130       H.! HA.class_ "toolbar"
  131       $ H.div
  132         H.! HA.class_ "wrap toolbar-main"
  133         $ H.div
  134           H.! HA.class_ "row"
  135           $ H.nav
  136             H.! HA.class_ "toolbar-nav no-angular cf"
  137             $ do
  138               H.ul
  139                 H.! HA.class_ "inline-block flat cf"
  140                 $ do
  141                   H.li $ H.a
  142                     H.! actionLink viewRoot HTML hasjs
  143                     $ "Databrary"
  144                   forM_ ["news", "about", "access", "community"] $ \l ->
  145                     H.li $ H.a H.! HA.href (H.stringValue $ "//databrary.org/" ++ l ++ ".html") $ do
  146                       H.string l
  147               H.ul
  148                 H.! HA.class_ "toolbar-user inline-block flat cf"
  149                 $ extractFromIdentifiedSessOrDefault
  150                   (H.li $ H.a H.! actionLink viewLogin () hasjs $ "Login")
  151                   (\_ -> do
  152                     H.li $ H.a H.! actionLink viewParty (HTML, TargetProfile) hasjs $ "Your Dashboard"
  153                     H.li $ actionForm postLogout HTML hasjs $
  154                       H.button
  155                         H.! HA.class_ "mini"
  156                         H.! HA.type_ "submit"
  157                         $ "Logout")
  158                   $ requestIdentity req
  159     H.section
  160       H.! HA.id "main"
  161       H.! HA.class_ "main"
  162         $ H.div
  163           H.! HA.class_ "wrap"
  164           $ H.div
  165             H.! HA.class_ "row"
  166             $ do
  167               when (hasjs /= JSEnabled) $ forM_ canon $ \c -> H.div $ do
  168                 H.preEscapedString "Our site works best with modern browsers (Firefox, Chrome, Safari &ge;6, IE &ge;10, and others). \
  169                   \You are viewing the simple version of our site: some functionality may not be available. \
  170                   \Try switching to the "
  171                 H.a H.! HA.href (builderValue c) $ "modern version"
  172                 " to see if it will work on your browser."
  173               mapM_ (H.h1 . H.toHtml) title
  174                 H.! HA.class_ "view-title"
  175               r <- body hasjs
  176               htmlFooter
  177               return r
  178   where
  179   -- FIXME: I don't think these lines do what they think they do.
  180   (hasjs, nojs) = jsURL JSDefault (view req)
  181   canon = (Wai.requestMethod (view req) == methodGet && hasjs == JSDefault) `unlessUse` nojs