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 ≥6, IE ≥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