{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wall #-}

-- | Some <https://getbootstrap.com/ bootstrap> assets and functionality.
module Web.Rep.Bootstrap
  ( bootstrapPage,
    cardify,
    divClass_,
    accordion,
    accordionChecked,
    accordionCard,
    accordionCardChecked,
    accordion_,
  )
where

import Control.Monad.State.Lazy
import Data.Bool
import Data.Functor.Identity
import Data.Text (Text)
import Lucid
import Lucid.Base
import Web.Rep.Html
import Web.Rep.Page
import Web.Rep.Shared

bootstrapCss :: [Html ()]
bootstrapCss :: [Html ()]
bootstrapCss =
  [ [Attribute] -> Html ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
link_
      [ Text -> Attribute
rel_ Text
"stylesheet",
        Text -> Attribute
href_ Text
"https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/css/bootstrap.min.css",
        Text -> Attribute
integrity_ Text
"sha384-ggOyR0iXCbMQv3Xipma34MD+dH/1fQ784/j6cY/iJTQUOhcWr7x9JvoRxT2MZw1T",
        Text -> Attribute
crossorigin_ Text
"anonymous"
      ]
  ]

bootstrapJs :: [Html ()]
bootstrapJs :: [Html ()]
bootstrapJs =
  [ Html () -> [Attribute] -> Html ()
forall a. With a => a -> [Attribute] -> a
with
      (Text -> Html ()
forall arg result. TermRaw arg result => arg -> result
script_ Text
forall a. Monoid a => a
mempty)
      [ Text -> Attribute
src_ Text
"https://code.jquery.com/jquery-3.3.1.slim.min.js",
        Text -> Attribute
integrity_ Text
"sha384-q8i/X+965DzO0rT7abK41JStQIAqVgRVzpbzo5smXKp4YfRvH+8abtTE1Pi6jizo",
        Text -> Attribute
crossorigin_ Text
"anonymous"
      ],
    Html () -> [Attribute] -> Html ()
forall a. With a => a -> [Attribute] -> a
with
      (Text -> Html ()
forall arg result. TermRaw arg result => arg -> result
script_ Text
forall a. Monoid a => a
mempty)
      [ Text -> Attribute
src_ Text
"https://cdnjs.cloudflare.com/ajax/libs/popper.js/1.14.7/umd/popper.min.js",
        Text -> Attribute
integrity_ Text
"sha384-UO2eT0CpHqdSJQ6hJty5KVphtPhzWj9WO1clHTMGa3JDZwrnQq4sF86dIHNDz0W1",
        Text -> Attribute
crossorigin_ Text
"anonymous"
      ],
    Html () -> [Attribute] -> Html ()
forall a. With a => a -> [Attribute] -> a
with
      (Text -> Html ()
forall arg result. TermRaw arg result => arg -> result
script_ Text
forall a. Monoid a => a
mempty)
      [ Text -> Attribute
src_ Text
"https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/js/bootstrap.min.js",
        Text -> Attribute
integrity_ Text
"sha384-JjSmVgyd0p3pXB1rRibZUAYoIIy6OrQ6VrjIEaFf/nJGzIxFDsf4x0xIM+B07jRM",
        Text -> Attribute
crossorigin_ Text
"anonymous"
      ]
  ]

bootstrapMeta :: [Html ()]
bootstrapMeta :: [Html ()]
bootstrapMeta =
  [ [Attribute] -> Html ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
meta_ [Text -> Attribute
charset_ Text
"utf-8"],
    [Attribute] -> Html ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
meta_
      [ Text -> Attribute
name_ Text
"viewport",
        Text -> Attribute
content_ Text
"width=device-width, initial-scale=1, shrink-to-fit=no"
      ]
  ]

-- | A page containing all the <https://getbootstrap.com/ bootstrap> needs for a web page.
bootstrapPage :: Page
bootstrapPage :: Page
bootstrapPage =
  [Html ()]
-> [Html ()]
-> RepCss
-> RepJs
-> RepJs
-> Html ()
-> Html ()
-> Page
Page
    [Html ()]
bootstrapCss
    [Html ()]
bootstrapJs
    RepCss
forall a. Monoid a => a
mempty
    RepJs
forall a. Monoid a => a
mempty
    RepJs
forall a. Monoid a => a
mempty
    ([Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat [Html ()]
bootstrapMeta)
    Html ()
forall a. Monoid a => a
mempty

-- | wrap some Html with the bootstrap <https://getbootstrap.com/docs/4.3/components/card/ card> class
cardify :: (Html (), [Attribute]) -> Maybe Text -> (Html (), [Attribute]) -> Html ()
cardify :: (Html (), [Attribute])
-> Maybe Text -> (Html (), [Attribute]) -> Html ()
cardify (Html ()
h, [Attribute]
hatts) Maybe Text
t (Html ()
b, [Attribute]
batts) =
  (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ ([Text -> Attribute
class__ Text
"card"] [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> [Attribute]
hatts) (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$
    Html ()
h
      Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with
        Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_
        ([Text -> Attribute
class__ Text
"card-body"] [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> [Attribute]
batts)
        ( Html () -> (Text -> Html ()) -> Maybe Text -> Html ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html ()
forall a. Monoid a => a
mempty ((Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with Html () -> Html ()
forall arg result. Term arg result => arg -> result
h5_ [Text -> Attribute
class__ Text
"card-title"] (Html () -> Html ()) -> (Text -> Html ()) -> Text -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
t
            Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> Html ()
b
        )

-- | wrap some html with a classed div
divClass_ :: Text -> Html () -> Html ()
divClass_ :: Text -> Html () -> Html ()
divClass_ Text
t = (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
t]

-- | A Html object based on the bootstrap accordion card concept.
accordionCard :: Bool -> [Attribute] -> Text -> Text -> Text -> Text -> Html () -> Html ()
accordionCard :: Bool
-> [Attribute]
-> Text
-> Text
-> Text
-> Text
-> Html ()
-> Html ()
accordionCard Bool
collapse [Attribute]
atts Text
idp Text
idh Text
idb Text
t0 Html ()
b =
  (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ ([Text -> Attribute
class__ Text
"card"] [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> [Attribute]
atts) (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$
    (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with
      Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"card-header p-0", Text -> Attribute
id_ Text
idh]
      ( (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with
          Html () -> Html ()
forall arg result. Term arg result => arg -> result
h2_
          [Text -> Attribute
class__ Text
"m-0"]
          ((Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with Html () -> Html ()
forall arg result. Term arg result => arg -> result
button_ [Text -> Attribute
class__ (Text
"btn btn-link" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"" Text
" collapsed" Bool
collapse), Text -> Attribute
type_ Text
"button", Text -> Text -> Attribute
data_ Text
"toggle" Text
"collapse", Text -> Text -> Attribute
data_ Text
"target" (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idb), Text -> Text -> Attribute
makeAttribute Text
"aria-expanded" (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"true" Text
"false" Bool
collapse), Text -> Text -> Attribute
makeAttribute Text
"aria-controls" Text
idb] (Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t0))
      )
      Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with
        Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_
        [Text -> Attribute
id_ Text
idb, Text -> Attribute
class__ (Text
"collapse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
" show" Text
"" Bool
collapse), Text -> Text -> Attribute
makeAttribute Text
"aria-labelledby" Text
idh, Text -> Text -> Attribute
data_ Text
"parent" (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idp)]
        ((Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
"card-body"] Html ()
b)

-- | A bootstrap accordion card attached to a checkbox.
accordionCardChecked :: Bool -> Text -> Text -> Text -> Text -> Html () -> Html () -> Html ()
accordionCardChecked :: Bool
-> Text -> Text -> Text -> Text -> Html () -> Html () -> Html ()
accordionCardChecked Bool
collapse Text
idp Text
idh Text
idb Text
label Html ()
bodyhtml Html ()
checkhtml =
  (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
"card"] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$
    (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with
      Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"card-header p-0", Text -> Attribute
id_ Text
idh]
      ( Html ()
checkhtml
          Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with
            Html () -> Html ()
forall arg result. Term arg result => arg -> result
h2_
            [Text -> Attribute
class__ Text
"m-0"]
            ((Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with Html () -> Html ()
forall arg result. Term arg result => arg -> result
button_ [Text -> Attribute
class__ (Text
"btn btn-link" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"" Text
" collapsed" Bool
collapse), Text -> Attribute
type_ Text
"button", Text -> Text -> Attribute
data_ Text
"toggle" Text
"collapse", Text -> Text -> Attribute
data_ Text
"target" (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idb), Text -> Text -> Attribute
makeAttribute Text
"aria-expanded" (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"true" Text
"false" Bool
collapse), Text -> Text -> Attribute
makeAttribute Text
"aria-controls" Text
idb] (Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
label))
      )
      Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with
        Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_
        [Text -> Attribute
id_ Text
idb, Text -> Attribute
class__ (Text
"collapse" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
" show" Text
"" Bool
collapse), Text -> Text -> Attribute
makeAttribute Text
"aria-labelledby" Text
idh, Text -> Text -> Attribute
data_ Text
"parent" (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idp)]
        ((Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
"card-body"] Html ()
bodyhtml)

-- | create a bootstrapped accordian class
accordion ::
  (MonadState Int m) =>
  Text ->
  -- | name prefix.  This is needed because an Int doesn't seem to be a valid name.
  Maybe Text ->
  -- | card title
  [(Text, Html ())] ->
  -- | title, html tuple for each item in the accordion.
  m (Html ())
accordion :: Text -> Maybe Text -> [(Text, Html ())] -> m (Html ())
accordion Text
pre Maybe Text
x [(Text, Html ())]
hs = do
  Text
idp' <- Text -> m Text
forall (m :: * -> *). MonadState Int m => Text -> m Text
genNamePre Text
pre
  (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
"accordion m-1", Text -> Attribute
id_ Text
idp'] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (Html ())
forall (f :: * -> *). MonadState Int f => Text -> f (Html ())
aCards Text
idp'
  where
    aCards :: Text -> f (Html ())
aCards Text
par = [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> f [Html ()] -> f (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Html ())] -> f [Html ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Text -> (Text, Html ()) -> f (Html ())
forall (m :: * -> *).
MonadState Int m =>
Text -> (Text, Html ()) -> m (Html ())
aCard Text
par ((Text, Html ()) -> f (Html ()))
-> [(Text, Html ())] -> [f (Html ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Html ())]
hs)
    aCard :: Text -> (Text, Html ()) -> m (Html ())
aCard Text
par (Text
t, Html ()
b) = do
      Text
idh <- Text -> m Text
forall (m :: * -> *). MonadState Int m => Text -> m Text
genNamePre Text
pre
      Text
idb <- Text -> m Text
forall (m :: * -> *). MonadState Int m => Text -> m Text
genNamePre Text
pre
      Html () -> m (Html ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ Bool
-> [Attribute]
-> Text
-> Text
-> Text
-> Text
-> Html ()
-> Html ()
accordionCard (Maybe Text
x Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t) [] Text
par Text
idh Text
idb Text
t Html ()
b

-- | create a bootstrapped accordian class
accordionChecked :: (MonadState Int m) => Text -> [(Text, Html (), Html ())] -> m (Html ())
accordionChecked :: Text -> [(Text, Html (), Html ())] -> m (Html ())
accordionChecked Text
pre [(Text, Html (), Html ())]
hs = do
  Text
idp' <- Text -> m Text
forall (m :: * -> *). MonadState Int m => Text -> m Text
genNamePre Text
pre
  (Html () -> Html ()) -> [Attribute] -> Html () -> Html ()
forall a. With a => a -> [Attribute] -> a
with Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
"accordion m-1", Text -> Attribute
id_ Text
idp'] (Html () -> Html ()) -> m (Html ()) -> m (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (Html ())
forall (f :: * -> *). MonadState Int f => Text -> f (Html ())
aCards Text
idp'
  where
    aCards :: Text -> f (Html ())
aCards Text
par = [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> f [Html ()] -> f (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Html ())] -> f [Html ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Text -> (Text, Html (), Html ()) -> f (Html ())
forall (m :: * -> *).
MonadState Int m =>
Text -> (Text, Html (), Html ()) -> m (Html ())
aCard Text
par ((Text, Html (), Html ()) -> f (Html ()))
-> [(Text, Html (), Html ())] -> [f (Html ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Html (), Html ())]
hs)
    aCard :: Text -> (Text, Html (), Html ()) -> m (Html ())
aCard Text
par (Text
l, Html ()
bodyhtml, Html ()
checkhtml) = do
      Text
idh <- Text -> m Text
forall (m :: * -> *). MonadState Int m => Text -> m Text
genNamePre Text
pre
      Text
idb <- Text -> m Text
forall (m :: * -> *). MonadState Int m => Text -> m Text
genNamePre Text
pre
      Html () -> m (Html ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html () -> m (Html ())) -> Html () -> m (Html ())
forall a b. (a -> b) -> a -> b
$ Bool
-> Text -> Text -> Text -> Text -> Html () -> Html () -> Html ()
accordionCardChecked Bool
True Text
par Text
idh Text
idb Text
l Html ()
bodyhtml Html ()
checkhtml

-- | This version of accordion runs a local state for naming, and will cause name clashes if the prefix is not unique.
accordion_ :: Text -> Maybe Text -> [(Text, Html ())] -> Html ()
accordion_ :: Text -> Maybe Text -> [(Text, Html ())] -> Html ()
accordion_ Text
pre Maybe Text
x [(Text, Html ())]
hs = Identity (Html ()) -> Html ()
forall a. Identity a -> a
runIdentity (Identity (Html ()) -> Html ()) -> Identity (Html ()) -> Html ()
forall a b. (a -> b) -> a -> b
$ StateT Int Identity (Html ()) -> Int -> Identity (Html ())
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Text
-> Maybe Text -> [(Text, Html ())] -> StateT Int Identity (Html ())
forall (m :: * -> *).
MonadState Int m =>
Text -> Maybe Text -> [(Text, Html ())] -> m (Html ())
accordion Text
pre Maybe Text
x [(Text, Html ())]
hs) Int
0