yesod-bootstrap 0.2.1 → 0.3
raw patch · 3 files changed
+250/−8 lines, 3 files
Files
- src/Yesod/Bootstrap.hs +248/−6
- src/Yesod/Form/Generic/Bootstrap.hs +1/−1
- yesod-bootstrap.cabal +1/−1
src/Yesod/Bootstrap.hs view
@@ -1,6 +1,7 @@ module Yesod.Bootstrap where import Prelude hiding (div)+import Data.Foldable import Yesod.Core import Yesod.Core.Widget import Yesod.Core.Handler@@ -17,6 +18,8 @@ import qualified Text.Blaze.Html5.Attributes as HA import Data.Function (on) import Data.String (IsString(..))+import Data.Char (isDigit)+import Text.Julius (rawJS) data Context = Success | Info | Warning | Danger | Default | Primary | Link | Error data Size = ExtraSmall | Small | Medium | Large@@ -38,10 +41,12 @@ span_ attrs inner = [whamlet|<span *{mkStrAttrs attrs}>^{inner}|] strong_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()-strong_ attrs inner = [whamlet|<strong *{mkStrAttrs attrs}>^{inner}|]+strong_ attrs inner = [whamlet|$newline never+<strong *{mkStrAttrs attrs}>^{inner}|] em_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()-em_ attrs inner = [whamlet|<em *{mkStrAttrs attrs}>^{inner}|]+em_ attrs inner = [whamlet|$newline never+<em *{mkStrAttrs attrs}>^{inner}|] s_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO () s_ attrs inner = [whamlet|<s *{mkStrAttrs attrs}>^{inner}|]@@ -61,18 +66,42 @@ pre_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO () pre_ attrs inner = [whamlet|<pre *{mkStrAttrs attrs}>^{inner}|] +code_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()+code_ attrs inner = [whamlet|<code *{mkStrAttrs attrs}>^{inner}|]+ input_ :: [(Text,Text)] -> WidgetT site IO () input_ attrs = [whamlet|<input *{mkStrAttrs attrs}>|] hr_ :: [(Text,Text)] -> WidgetT site IO () hr_ attrs = [whamlet|<hr *{mkStrAttrs attrs}>|] +br_ :: [(Text,Text)] -> WidgetT site IO ()+br_ attrs = [whamlet|<br *{mkStrAttrs attrs}>|]+ img_ :: [(Text,Text)] -> WidgetT site IO () img_ attrs = [whamlet|<img *{mkStrAttrs attrs}>|] textarea_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO () textarea_ attrs inner = [whamlet|<textarea *{mkStrAttrs attrs}>^{inner}|] +td_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()+td_ attrs inner = [whamlet|<td *{mkStrAttrs attrs}>^{inner}|]++th_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()+th_ attrs inner = [whamlet|<th *{mkStrAttrs attrs}>^{inner}|]++table_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()+table_ attrs inner = [whamlet|<table *{mkStrAttrs attrs}>^{inner}|]++tbody_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()+tbody_ attrs inner = [whamlet|<tbody *{mkStrAttrs attrs}>^{inner}|]++thead_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()+thead_ attrs inner = [whamlet|<thead *{mkStrAttrs attrs}>^{inner}|]++tr_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()+tr_ attrs inner = [whamlet|<tr *{mkStrAttrs attrs}>^{inner}|]+ h1_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO () h1_ attrs inner = [whamlet|<h1 *{mkStrAttrs attrs}>^{inner}|] @@ -103,6 +132,9 @@ li_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO () li_ attrs inner = [whamlet|<li *{mkStrAttrs attrs}>^{inner}|] +blockquote_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()+blockquote_ attrs inner = [whamlet|<blockquote *{mkStrAttrs attrs}>^{inner}|]+ small_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO () small_ attrs inner = [whamlet|<small *{mkStrAttrs attrs}>^{inner}|] @@ -110,7 +142,8 @@ i_ attrs inner = [whamlet|<i *{mkStrAttrs attrs}>^{inner}|] a_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()-a_ attrs inner = [whamlet|<a *{mkStrAttrs attrs}>^{inner}|]+a_ attrs inner = [whamlet|$newline never+<a *{mkStrAttrs attrs}>^{inner}|] audio_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO () audio_ attrs inner = [whamlet|<audio *{mkStrAttrs attrs}>^{inner}|]@@ -121,6 +154,19 @@ anchor :: Route site -> WidgetT site IO () -> WidgetT site IO () anchor route inner = [whamlet|<a href="@{route}">^{inner}|] +anchorEmail :: Text -> WidgetT site IO () -> WidgetT site IO ()+anchorEmail email inner = [whamlet|<a href="mailto:#{email}">^{inner}|]++anchorPhone :: Text -> WidgetT site IO ()+anchorPhone phone = [whamlet|<a href="tel:#{cleanedPhone}">#{phone}|]+ where + strippedPhone = Text.filter ((||) <$> isDigit <*> (== '+')) phone+ cleanedPhone = case Text.uncons strippedPhone of+ Nothing -> Text.empty+ Just (c,cs) -> if c == '+' + then strippedPhone+ else Text.append "+1" strippedPhone+ button_ :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO () button_ attrs inner = [whamlet|<button *{mkStrAttrs attrs}>^{inner}|] @@ -133,6 +179,9 @@ container :: WidgetT site IO () -> WidgetT site IO () container = div_ [("class","container")] +well :: Size -> WidgetT site IO () -> WidgetT site IO ()+well size = div_ [("class","well well-" <> colSizeShortName size)]+ col :: [ColSize] -> WidgetT site IO () -> WidgetT site IO () col cs = div_ [("class", Text.intercalate " " (map mkAttr cs))] where mkAttr (ColSize s n) = Text.concat ["col-", colSizeShortName s, "-", Text.pack (show n)]@@ -146,6 +195,11 @@ alertHtml :: Context -> Html -> Html alertHtml ctx inner = H.div H.! HA.class_ (fromString $ Text.unpack $ "alert alert-" <> contextName ctx) $ inner +alertHtmlDismiss :: Context -> Html -> Html+alertHtmlDismiss ctx inner = H.div H.! HA.class_ (fromString $ Text.unpack $ "alert alert-dismissable alert-" <> contextName ctx) $ do+ H.button H.! HA.class_ "close" H.! HA.type_ "button" H.! H.dataAttribute "dismiss" "alert" $ H.preEscapedToHtml ("×" :: Text)+ inner+ caret :: WidgetT site IO () caret = span_ [("class","caret")] mempty @@ -177,17 +231,77 @@ button ctx size inner = do button_ [("class","btn btn-" <> contextName ctx <> " btn-" <> colSizeShortName size)] inner -anchorButton :: Context -> Route site -> WidgetT site IO () -> WidgetT site IO ()-anchorButton ctx route inner = do+buttonRaised :: Context -> Size -> WidgetT site IO () -> WidgetT site IO ()+buttonRaised ctx size inner = do+ button_ [("class","btn btn-raised btn-" <> contextName ctx <> " btn-" <> colSizeShortName size)] inner++buttonRaisedBlock :: Context -> Size -> WidgetT site IO () -> WidgetT site IO ()+buttonRaisedBlock ctx size inner = do+ button_ [("class","btn btn-raised btn-block btn-" <> contextName ctx <> " btn-" <> colSizeShortName size)] inner++formButtonPost :: Context -> Size -> Route site -> WidgetT site IO () -> WidgetT site IO ()+formButtonPost ctx size route inner = do render <- getUrlRender- a_ [("href",render route),("class","btn btn-" <> contextName ctx)] inner+ form_ [("method","POST"),("action",render route)] $ do+ button ctx size inner +formButtonRaisedPost :: Context -> Size -> Route site -> WidgetT site IO () -> WidgetT site IO ()+formButtonRaisedPost ctx size route inner = do+ render <- getUrlRender+ form_ [("method","POST"),("action",render route)] $ do+ buttonRaised ctx size inner++formButtonRaisedPostBlock :: Context -> Size -> Route site -> WidgetT site IO () -> WidgetT site IO ()+formButtonRaisedPostBlock ctx size route inner = do+ render <- getUrlRender+ form_ [("method","POST"),("action",render route)] $ do+ buttonRaisedBlock ctx size inner++anchorButton :: Context -> Size -> Route site -> WidgetT site IO () -> WidgetT site IO ()+anchorButton ctx size route inner = do+ render <- getUrlRender+ a_ [("href",render route),("class","btn btn-" <> contextName ctx <> " btn-" <> colSizeShortName size)] inner++anchorButtonDropdown :: Context -> Size -> WidgetT site IO () -> [(Route site, WidgetT site IO ())] -> WidgetT site IO ()+anchorButtonDropdown ctx size inner xs = div_ [("class","btn-group")] $ do+ button_ [ ("type","button")+ , ("class","btn btn-" <> contextName ctx <> " btn-" <> colSizeShortName size)+ , ("data-toggle","dropdown")+ , ("aria-haspopup","true")+ , ("aria-expanded","false")+ ] inner+ ul_ [("class","dropdown-menu")] $ forM_ xs $ \(route,content) -> do+ li_ [] $ anchor route content++anchorButtonRaised :: Context -> Size -> Route site -> WidgetT site IO () -> WidgetT site IO ()+anchorButtonRaised ctx size route inner = do+ render <- getUrlRender+ a_ [("href",render route),("class","btn btn-raised btn-" <> contextName ctx <> " btn-" <> colSizeShortName size)] inner++anchorButtonBlock :: Context -> Size -> Route site -> WidgetT site IO () -> WidgetT site IO ()+anchorButtonBlock ctx size route inner = do+ render <- getUrlRender+ a_ [("href",render route),("class","btn btn-block btn-" <> contextName ctx <> " btn-" <> colSizeShortName size)] inner++anchorButtonRaisedBlock :: Context -> Size -> Route site -> WidgetT site IO () -> WidgetT site IO ()+anchorButtonRaisedBlock ctx size route inner = do+ render <- getUrlRender+ a_ [("href",render route),("class","btn btn-raised btn-block btn-" <> contextName ctx <> " btn-" <> colSizeShortName size)] inner+ label :: Context -> WidgetT site IO () -> WidgetT site IO () label ctx = span_ [("class","label label-" <> contextName ctx)] badge :: WidgetT site IO () -> WidgetT site IO () badge = span_ [("class","badge")] +panel :: Panel site -> WidgetT site IO ()+panel (Panel title content ctx) = do+ div_ [("class","panel panel-" <> contextName ctx)] $ do+ div_ [("class", "panel-heading")] $ do+ h4_ [("class","panel-title")] title+ div_ [("class","panel-body")] $ do+ content+ panelAccordion :: [Panel site] -> WidgetT site IO () panelAccordion tcs = do groupId <- newIdent @@ -308,6 +422,62 @@ tw :: Text -> WidgetT site IO () tw = toWidget . toHtml +preEscapedWidget :: Text -> WidgetT site IO ()+preEscapedWidget = toWidget . H.preEscapedToHtml++data CarouselItem site = CarouselItem+ { ciImage :: Route site+ , ciLink :: Maybe (Route site)+ , ciCaption :: Maybe (WidgetT site IO ())+ }++data CarouselIndicators = CarouselIndicatorsOn | CarouselIndicatorsOff+ deriving (Eq)+data CarouselControls = CarouselControlsOn | CarouselControlsOff+ deriving (Eq)++-- Carousel Element +carousel :: CarouselIndicators -> CarouselControls -> [CarouselItem site] -> WidgetT site IO ()+carousel indicators controls items = if length items == 0 then mempty else do+ render <- getUrlRender+ carouselId <- newIdent+ div_ [("class","carousel slide"),("data-ride","carousel"),("id",carouselId)] $ do+ when (indicators == CarouselIndicatorsOn) $ do+ ol_ [("class","carousel-indicators")] $ do+ forM_ (zip [0,1..] itemsActive) $ \(i,(active,_)) -> do+ li_ [ ("data-target", "#" <> carouselId)+ , ("data-slide-to", Text.pack (show i))+ , ("class", if active then "active" else "")+ ] mempty+ div_ [("class","carousel-inner"), ("role","listbox")] $ do+ forM_ itemsActive $ \(active,item) -> do+ div_ [("class","item " <> if active then "active" else "")] $ do+ wrapWithLink (ciLink item) mempty+ img_ [("src",render (ciImage item))]+ for_ (ciCaption item) $ \caption -> do+ div_ [("class","carousel-caption")] caption+ when (controls == CarouselControlsOn) $ do+ a_ [ ("class","left carousel-control")+ , ("href","#" <> carouselId)+ , ("role","button")+ , ("data-slide","prev")+ ] $ do+ glyphicon "chevron-left"+ span_ [("class","sr-only")] "Previous"+ a_ [ ("class","right carousel-control")+ , ("href","#" <> carouselId)+ , ("role","button")+ , ("data-slide","next")+ ] $ do+ glyphicon "chevron-right"+ span_ [("class","sr-only")] "Next"+ where + itemsActive = zip (True : repeat False) items+ wrapWithLink :: Maybe (Route site) -> WidgetT site IO () -> WidgetT site IO ()+ wrapWithLink mroute w = (\ww -> maybe w ww mroute) $ \route -> do+ render <- getUrlRender+ a_ [("href", render route),("style","position:absolute;left:0;right:0;width:100%;height:100%;")] w+ -- Togglable tabs data ToggleTab site = ToggleSection Text (WidgetT site IO ()) | ToggleDropdown Text [(Text,WidgetT site IO ())] data ToggleStyle = ToggleStyleTab | ToggleStylePill@@ -339,6 +509,16 @@ Nothing -> ("class",klass) : attrs Just c -> ("class",c <> " " <> klass) : List.deleteBy ((==) `on` fst) ("class","") attrs +radioButtons :: Context -> Text -> [(Text, WidgetT site IO ())] -> WidgetT site IO ()+radioButtons ctx name xs = do+ div_ [("class","btn-group"),("data-toggle","buttons")] $ do+ forM_ (zip trueThenFalse xs) $ \(isFirst, (theValue,w)) -> do+ label_ [("class", "btn btn-" <> contextName ctx <> if isFirst then " active" else "")] $ do+ input_ $ (if isFirst then [("checked","checked")] else [])+ ++ [("type","radio"),("name",name),("value",theValue),("autocomplete","off")] + " "+ w+ listGroupLinked :: [(Route site,WidgetT site IO ())] -> WidgetT site IO () listGroupLinked items = do render <- getUrlRender@@ -351,4 +531,66 @@ forM_ (reverse crumbs) $ \(route,name) -> li_ [] $ anchor route name li_ [("class","active")] lastCrumbWidget [] -> mempty++popover :: WidgetT site IO () -> WidgetT site IO () -> WidgetT site IO () -> WidgetT site IO ()+popover title popup inner = do+ innerId <- newIdent+ popupWrapId <- newIdent+ titleWrapId <- newIdent+ a_ [("href","javascript://"),("id",innerId)] inner+ div_ [("id",popupWrapId),("style","display:none;")] $ do+ popup+ div_ [("id",titleWrapId),("style","display:none;")] $ do+ title+ toWidget [julius|+$().ready(function(){+ $('##{rawJS innerId}').popover(+ { html: true+ , trigger: 'focus'+ , content: function() { return $('##{rawJS popupWrapId}').html(); }+ , title: function() { return $('##{rawJS titleWrapId}').html(); }+ }+ );+});+|]++popoverClickable :: WidgetT site IO () -> WidgetT site IO () -> WidgetT site IO () -> WidgetT site IO ()+popoverClickable title popup inner = do+ containerId <- newIdent+ innerId <- newIdent+ popupWrapId <- newIdent+ titleWrapId <- newIdent+ span_ [("id",containerId)] $ do+ a_ [("href","javascript://"),("id",innerId)] inner+ div_ [("id",popupWrapId),("style","display:none;")] $ do+ popup+ div_ [("id",titleWrapId),("style","display:none;")] $ do+ title+ toWidget [julius|+$().ready(function(){+ $('##{rawJS innerId}').popover(+ { html: true+ , trigger: 'manual'+ , content: function() { return $('##{rawJS popupWrapId}').html(); }+ , title: function() { return $('##{rawJS titleWrapId}').html(); }+ }+ );+ var hidePopover#{rawJS innerId} = function () {+ $('##{rawJS innerId}').popover('hide');+ $(document).off("click keypress", hidePopover#{rawJS innerId} );+ };+ $('##{rawJS innerId}').focusin(function() {+ $('##{rawJS innerId}').popover('show');+ });+ $('##{rawJS innerId}').on("shown.bs.popover", function() {+ $('##{rawJS containerId}').find(".popover").on("click keypress", function(e) {+ e.stopPropagation();+ });+ $(document).on("click keypress", hidePopover#{rawJS innerId});+ });+});+|]++trueThenFalse :: [Bool]+trueThenFalse = True : repeat False
src/Yesod/Form/Generic/Bootstrap.hs view
@@ -209,7 +209,7 @@ view theId name [("class","form-control")] r True where Field parse view enctype = selectField opts -newtype UploadFilename = UploadFilename Text+newtype UploadFilename = UploadFilename { getUploadFilename :: Text } deriving (PersistField, PersistFieldSql, Show, Read) class YesodUpload site where
yesod-bootstrap.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: yesod-bootstrap-version: 0.2.1+version: 0.3 synopsis: Bootstrap widgets for yesod -- description: license: MIT