lucid-extras 0.1.0.0 → 0.1.0.1

raw patch · 5 files changed

+136/−25 lines, 5 filesdep +aesonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: aeson

API changes (from Hackage documentation)

Files

• lib/Lucid/Bootstrap3.hs +19/−2
• lib/Lucid/DataTables.hs +33/−0
• lib/Lucid/Leaflet.hs +54/−0
• lib/Lucid/Rdash.hs +26/−22
• lucid-extras.cabal +4/−1

@@ -42,9 +42,9 @@   =  scriptSrc "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js"  cdnFontAwesome-  =  link_ [href_ "https://maxcdn.bootstrapcdn.com/font-awesome/4.7.0/css/font-awesome.min.css",+  =  link_ [href_ "https://use.fontawesome.com/releases/v5.0.13/css/all.css",             rel_ "stylesheet",-            type_ "text/css"]+            type_ "text/css", crossorigin_ "anonymous"]  data NavAttribute = Inverse | Transparent | FixedTop | NavBarClass T.Text deriving Eq @@ -70,3 +70,20 @@     div_ [class_ "collapse navbar-collapse"] $ do       ul_ [class_ "nav navbar-nav navbar-right"] $ do         mapM_ li_ items++loginForm :: Monad m => T.Text -> Maybe (HtmlT m ()) -> HtmlT m ()+loginForm url mwarn = form_ [class_ "form-signin", method_ "post", action_ url] $ do+  h2_ [class_ "form-signin-heading"] $ "Please sign in"+  case mwarn of+    Nothing -> return ()+    Just warn -> warn+  label_ [for_ "inputEmail", class_ "sr-only"] "Email address"+  input_ [type_ "email", id_ "inputEmail", name_ "inputEmail", class_ "form-control", placeholder_ "Email address", required_ "", autofocus_]+  label_ [for_ "inputPassword", class_ "sr-only"] "Password"+  input_ [type_ "password", id_ "inputPassword", name_ "inputPassword", class_ "form-control", placeholder_ "Password", required_ ""]+  div_ [class_ "checkbox"] $+    label_ $ do+      input_ [type_ "checkbox", value_ "remember-me"]+      "Remember me"+  button_ [class_ "btn btn-lg btn-primary btn-block", type_ "submit"] "Sign in"+

@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings, StandaloneDeriving #-}++module Lucid.DataTables where++import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Lazy as BSL+import Lucid+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Lucid.PreEscaped+import Data.Monoid++dataTablesCDN :: Monad m => HtmlT m ()+dataTablesCDN+  =  scriptSrc "https://cdn.datatables.net/1.10.16/js/jquery.dataTables.min.js"+  +-- | Additional properties to pass to the table.+--   See https://datatables.net/reference/option/ for values+--   we might wish to use here.+activateDataTable :: Monad m => T.Text+                  -> Maybe (Aeson.Value)+                  -> HtmlT m ()+activateDataTable elm props = script_ $+    "$(document).ready(function(){ $('"<> elm<>"').DataTable("<> propStr <> "); })"+  where+    propStr = case props of+      Just val -> T.decodeUtf8 . BSL.toStrict . Aeson.encode $ val+      Nothing -> ""++dataTablesCssCDN :: Monad m => HtmlT m ()+dataTablesCssCDN =+  link_ [rel_ "stylesheet",+         href_ "https://cdn.datatables.net/1.10.16/css/jquery.dataTables.min.css"]

@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings, StandaloneDeriving,  DeriveGeneric #-}++module Lucid.Leaflet where++import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Lazy as BSL+import Lucid+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Lucid.PreEscaped+import Data.Monoid+import GHC.Generics++leafletCDN :: Monad m => HtmlT m ()+leafletCDN +  =  scriptSrc "https://unpkg.com/leaflet@1.2.0/dist/leaflet.js"++data LMap = LMap T.Text | SetView (Double, Double) Double LMap++data LMapElement = TileLayer T.Text TileLayerProperties+                 | Marker (Double, Double)+                 | BindPopup T.Text LMapElement ++data TileLayerProperties = TileLayerProperties { attribution :: T.Text } deriving (Generic)+instance Aeson.ToJSON TileLayerProperties ++mapElementToJS :: LMapElement -> T.Text+mapElementToJS e' = "\n" <> f e' <> ".addTo(lmap);" where+ tshow = T.pack . show+ f (Marker (x, y)) = "L.marker(["<> tshow x<>", "<> tshow y<>"])"+ f (BindPopup t e) = f e <> ".bindPopup('"<>t<>"')"+ f (TileLayer url ps) = "L.tileLayer('"<>url<>"',"<>g ps<>")"+ g = T.decodeUtf8 . BSL.toStrict . Aeson.encode++++osmTileLayer :: LMapElement +osmTileLayer +   = TileLayer "http://{s}.tile.osm.org/{z}/{x}/{y}.png" +     $ TileLayerProperties "&copy; <a href=\"http://osm.org/copyright\">OpenStreetMap</a> contributors"++leafletCssCDN :: Monad m => HtmlT m ()+leafletCssCDN =+  link_ [rel_ "stylesheet",+         href_ "https://unpkg.com/leaflet@1.2.0/dist/leaflet.css"]++leafletMap ::  Monad m => LMap -> [LMapElement] -> HtmlT m ()+leafletMap mp elms = script_ $ writeMap mp <> writeElems elms where+  writeMap m = "\nvar lmap = " <> writeMap' m <> ";"+  writeMap' (LMap e) = "L.map('"<>e<>"')"+  writeMap' (SetView (x,y) z m) = writeMap' m <> ".setView(["<> tshow x<>", "<> tshow y<>"], "<> tshow z<>")"+  writeElems = T.unlines . map mapElementToJS +  tshow = T.pack . show+

@@ -1,10 +1,9 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}  module Lucid.Rdash (     indexPage   , mkAlert   , mkAlerts-  , mkBody   , mkHead   , mkHeaderBar   , mkIndexPage@@ -14,7 +13,6 @@   , mkPageWrapperOpen   , mkSidebar   , mkSidebarFooter-  , mkSidebarItem   , mkSidebarWrapper   , mkWidget   , mkWidgets@@ -25,17 +23,18 @@   , widget_   , widgetBody_   , spacer_+  , rdashCSS+  , SidebarItem(..)   ) where  import qualified Data.Text as T import Data.List -import Control.Monad- import Lucid.Bootstrap3  import Lucid hiding (toHtml) import qualified Lucid (toHtml)+import Data.Monoid ((<>))  toHtml :: Monad m => T.Text -> HtmlT m () toHtml = Lucid.toHtml@@ -51,7 +50,7 @@ tooltip_ = term "tooltip"  fa_ :: Monad m => T.Text -> HtmlT m ()-fa_ x = i_ [class_ $ T.unwords ["fa", x]] (return ())+fa_ x = i_ [class_ $ T.unwords ["fas", x]] (return ())  aHash_ :: Monad m => HtmlT m () -> HtmlT m () aHash_ = a_ [href_ "#"]@@ -67,18 +66,26 @@ mkSidebarWrapper :: (Monad m) => HtmlT m () -> HtmlT m () -> HtmlT m () mkSidebarWrapper sb sbf = div_ [id_ "sidebar-wrapper"] $ sb >> sbf -mkSidebar :: (Monad m) => HtmlT m () -> HtmlT m () -> [HtmlT m ()] -> HtmlT m ()-mkSidebar sbm sbt sbl = ul_ [class_ "sidebar"] $ do+data SidebarItem = SidebarTitle T.Text+                 | SidebarLink+                    { itemText :: T.Text+                    , linkUrl ::  T.Text+                    , iconName :: T.Text+                    }++mkSidebar :: forall m. (Monad m) => HtmlT m () -> [SidebarItem] -> HtmlT m ()+mkSidebar sbm sbl = ul_ [class_ "sidebar"] $ do   li_ [class_ "sidebar-main",        id_ "toggle-sidebar",        onclick_ "$('#page-wrapper').toggleClass('open');"] sbm-  li_ [class_ "sidebar-title"] sbt-  forM_ sbl $ \l -> do-    li_ [class_ "sidebar-list"] l--mkSidebarItem :: (Monad m) => HtmlT m () -> T.Text -> HtmlT m ()-mkSidebarItem s icon = a_ [href_ "#"] $ s >> do-  span_ [class_ $ T.append icon " menu-icon"] (return ())+  let render :: SidebarItem -> HtmlT m ()+      render (SidebarTitle sbt)+        = li_ [class_ "sidebar-title"] $ span_ $ toHtml sbt+      render (SidebarLink t dest fa)+        = li_ [class_ "sidebar-list"]+          $ a_ [href_ dest]+          $ toHtml t <> i_ [class_ (fa<>" menu-icon")] mempty+  mapM_ render sbl  mkSidebarFooter :: (Monad m) => HtmlT m () -> HtmlT m () mkSidebarFooter footerItems = div_ [class_ "sidebar-footer"] footerItems@@ -94,9 +101,6 @@   cdnJqueryJS   cdnBootstrapJS -mkBody :: (Monad m) => HtmlT m () -> HtmlT m ()-mkBody pgw = body_ pgw- mkPageContent :: Monad m => HtmlT m () -> HtmlT m () mkPageContent = div_ [id_ "content-wrapper"] . div_ [class_ "page-content"] @@ -187,9 +191,9 @@   where      -- SIDEBAR-    dashboardSI = mkSidebarItem (toHtml "Dashboard") "fa fa-tachometer"-    tablesSI    = mkSidebarItem (toHtml "Tables") "fa fa-table"-    sb = mkSidebar sidebarMain sidebarTitle [dashboardSI, tablesSI]+    dashboardSI = SidebarLink ("Dashboard") "#" "tachometer"+    tablesSI    = SidebarLink ("Tables") "#" "table"+    sb = mkSidebar sidebarMain [SidebarTitle "NAVIGATION", dashboardSI, tablesSI]     footerContent =       rowEven XS       [ a_ [href_ "https://github.com/rdash/rdash-barebones", target_ "blank_"] "Github"@@ -220,7 +224,7 @@      pgw = mkPageWrapperOpen sbw pcw -    body = mkBody pgw+    body = body_ pgw     hd = mkHead "Dashboard"  

@@ -1,5 +1,5 @@ Name:                lucid-extras-Version:             0.1.0.0+Version:             0.1.0.1 Synopsis:            Generate more HTML with Lucid Description:         Generate more HTML with Lucid - Bootstrap, Rdash and Email. License:             MIT@@ -27,9 +27,12 @@    Exposed-modules:                    Lucid.Bootstrap3                  , Lucid.PreEscaped+                 , Lucid.DataTables                  , Lucid.Rdash+                 , Lucid.Leaflet    Build-depends:                  base                    >= 4.6 && < 5+               , aeson                , lucid                , text                , blaze-builder