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

-- | Some <https://getbootstrap.com/ bootstrap> assets and functionality.
module Web.Rep.Bootstrap
  ( BootstrapVersion (..),
    bootstrapPage,
    bootstrap5Page,
    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 GHC.Generics
import Lucid
import Lucid.Base
import Web.Rep.Html
import Web.Rep.Page
import Web.Rep.Shared

data BootstrapVersion = Boot4 | Boot5 deriving (BootstrapVersion -> BootstrapVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BootstrapVersion -> BootstrapVersion -> Bool
$c/= :: BootstrapVersion -> BootstrapVersion -> Bool
== :: BootstrapVersion -> BootstrapVersion -> Bool
$c== :: BootstrapVersion -> BootstrapVersion -> Bool
Eq, Int -> BootstrapVersion -> ShowS
[BootstrapVersion] -> ShowS
BootstrapVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BootstrapVersion] -> ShowS
$cshowList :: [BootstrapVersion] -> ShowS
show :: BootstrapVersion -> String
$cshow :: BootstrapVersion -> String
showsPrec :: Int -> BootstrapVersion -> ShowS
$cshowsPrec :: Int -> BootstrapVersion -> ShowS
Show, forall x. Rep BootstrapVersion x -> BootstrapVersion
forall x. BootstrapVersion -> Rep BootstrapVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BootstrapVersion x -> BootstrapVersion
$cfrom :: forall x. BootstrapVersion -> Rep BootstrapVersion x
Generic)

bootstrapCss :: [Html ()]
bootstrapCss :: [HtmlT Identity ()]
bootstrapCss =
  [ 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"
      ]
  ]

-- | <link href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css" rel="stylesheet" integrity="sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" crossorigin="anonymous">
bootstrap5Css :: [Html ()]
bootstrap5Css :: [HtmlT Identity ()]
bootstrap5Css =
  [ forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
link_
      [ Text -> Attribute
rel_ Text
"stylesheet",
        Text -> Attribute
href_ Text
"https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css",
        Text -> Attribute
integrity_ Text
"sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC",
        Text -> Attribute
crossorigin_ Text
"anonymous"
      ]
  ]

bootstrapJs :: [Html ()]
bootstrapJs :: [HtmlT Identity ()]
bootstrapJs =
  [ forall a. With a => a -> [Attribute] -> a
with
      (forall arg result. TermRaw arg result => arg -> result
script_ 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"
      ],
    forall a. With a => a -> [Attribute] -> a
with
      (forall arg result. TermRaw arg result => arg -> result
script_ 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"
      ],
    forall a. With a => a -> [Attribute] -> a
with
      (forall arg result. TermRaw arg result => arg -> result
script_ 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"
      ]
  ]

-- | <script src="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js" integrity="sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM" crossorigin="anonymous"></script>
bootstrap5Js :: [Html ()]
bootstrap5Js :: [HtmlT Identity ()]
bootstrap5Js =
  [ forall a. With a => a -> [Attribute] -> a
with
      (forall arg result. TermRaw arg result => arg -> result
script_ forall a. Monoid a => a
mempty)
      [ Text -> Attribute
src_ Text
"https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js",
        Text -> Attribute
integrity_ Text
"sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM",
        Text -> Attribute
crossorigin_ Text
"anonymous"
      ],
    forall a. With a => a -> [Attribute] -> a
with
      (forall arg result. TermRaw arg result => arg -> result
script_ 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"
      ]
  ]

bootstrapMeta :: [Html ()]
bootstrapMeta :: [HtmlT Identity ()]
bootstrapMeta =
  [ forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
meta_ [Text -> Attribute
charset_ Text
"utf-8"],
    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 =
  [HtmlT Identity ()]
-> [HtmlT Identity ()]
-> RepCss
-> RepJs
-> RepJs
-> HtmlT Identity ()
-> HtmlT Identity ()
-> Page
Page
    [HtmlT Identity ()]
bootstrapCss
    [HtmlT Identity ()]
bootstrapJs
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    (forall a. Monoid a => [a] -> a
mconcat [HtmlT Identity ()]
bootstrapMeta)
    forall a. Monoid a => a
mempty

-- | A page containing all the <https://getbootstrap.com/ bootstrap> needs for a web page.
bootstrap5Page :: Page
bootstrap5Page :: Page
bootstrap5Page =
  [HtmlT Identity ()]
-> [HtmlT Identity ()]
-> RepCss
-> RepJs
-> RepJs
-> HtmlT Identity ()
-> HtmlT Identity ()
-> Page
Page
    [HtmlT Identity ()]
bootstrap5Css
    [HtmlT Identity ()]
bootstrap5Js
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    (forall a. Monoid a => [a] -> a
mconcat [HtmlT Identity ()]
bootstrapMeta)
    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 :: (HtmlT Identity (), [Attribute])
-> Maybe Text
-> (HtmlT Identity (), [Attribute])
-> HtmlT Identity ()
cardify (HtmlT Identity ()
h, [Attribute]
hatts) Maybe Text
t (HtmlT Identity ()
b, [Attribute]
batts) =
  forall a. With a => a -> [Attribute] -> a
with forall arg result. Term arg result => arg -> result
div_ ([Text -> Attribute
class__ Text
"card"] forall a. Semigroup a => a -> a -> a
<> [Attribute]
hatts) forall a b. (a -> b) -> a -> b
$
    HtmlT Identity ()
h
      forall a. Semigroup a => a -> a -> a
<> forall a. With a => a -> [Attribute] -> a
with
        forall arg result. Term arg result => arg -> result
div_
        ([Text -> Attribute
class__ Text
"card-body"] forall a. Semigroup a => a -> a -> a
<> [Attribute]
batts)
        ( forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall a. With a => a -> [Attribute] -> a
with forall arg result. Term arg result => arg -> result
h5_ [Text -> Attribute
class__ Text
"card-title"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) Maybe Text
t
            forall a. Semigroup a => a -> a -> a
<> HtmlT Identity ()
b
        )

-- | wrap some html with a classed div
divClass_ :: Text -> Html () -> Html ()
divClass_ :: Text -> HtmlT Identity () -> HtmlT Identity ()
divClass_ Text
t = forall a. With a => a -> [Attribute] -> a
with 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
-> HtmlT Identity ()
-> HtmlT Identity ()
accordionCard Bool
collapse [Attribute]
atts Text
idp Text
idh Text
idb Text
t0 HtmlT Identity ()
b =
  forall a. With a => a -> [Attribute] -> a
with forall arg result. Term arg result => arg -> result
div_ ([Text -> Attribute
class__ Text
"card"] forall a. Semigroup a => a -> a -> a
<> [Attribute]
atts) forall a b. (a -> b) -> a -> b
$
    forall a. With a => a -> [Attribute] -> a
with
      forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"card-header p-0", Text -> Attribute
id_ Text
idh]
      ( forall a. With a => a -> [Attribute] -> a
with
          forall arg result. Term arg result => arg -> result
h2_
          [Text -> Attribute
class__ Text
"m-0"]
          (forall a. With a => a -> [Attribute] -> a
with forall arg result. Term arg result => arg -> result
button_ [Text -> Attribute
class__ (Text
"btn btn-link" forall a. Semigroup a => a -> a -> a
<> 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
"#" forall a. Semigroup a => a -> a -> a
<> Text
idb), Text -> Text -> Attribute
makeAttribute Text
"aria-expanded" (forall a. a -> a -> Bool -> a
bool Text
"true" Text
"false" Bool
collapse), Text -> Text -> Attribute
makeAttribute Text
"aria-controls" Text
idb] (forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
t0))
      )
      forall a. Semigroup a => a -> a -> a
<> forall a. With a => a -> [Attribute] -> a
with
        forall arg result. Term arg result => arg -> result
div_
        [Text -> Attribute
id_ Text
idb, Text -> Attribute
class__ (Text
"collapse" forall a. Semigroup a => a -> a -> a
<> 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
"#" forall a. Semigroup a => a -> a -> a
<> Text
idp)]
        (forall a. With a => a -> [Attribute] -> a
with forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
"card-body"] HtmlT Identity ()
b)

-- | A bootstrap accordion card attached to a checkbox.
accordionCardChecked :: Bool -> Text -> Text -> Text -> Text -> Html () -> Html () -> Html ()
accordionCardChecked :: Bool
-> Text
-> Text
-> Text
-> Text
-> HtmlT Identity ()
-> HtmlT Identity ()
-> HtmlT Identity ()
accordionCardChecked Bool
collapse Text
idp Text
idh Text
idb Text
label HtmlT Identity ()
bodyhtml HtmlT Identity ()
checkhtml =
  forall a. With a => a -> [Attribute] -> a
with forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
"card"] forall a b. (a -> b) -> a -> b
$
    forall a. With a => a -> [Attribute] -> a
with
      forall arg result. Term arg result => arg -> result
div_
      [Text -> Attribute
class__ Text
"card-header p-0", Text -> Attribute
id_ Text
idh]
      ( HtmlT Identity ()
checkhtml
          forall a. Semigroup a => a -> a -> a
<> forall a. With a => a -> [Attribute] -> a
with
            forall arg result. Term arg result => arg -> result
h2_
            [Text -> Attribute
class__ Text
"m-0"]
            (forall a. With a => a -> [Attribute] -> a
with forall arg result. Term arg result => arg -> result
button_ [Text -> Attribute
class__ (Text
"btn btn-link" forall a. Semigroup a => a -> a -> a
<> 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
"#" forall a. Semigroup a => a -> a -> a
<> Text
idb), Text -> Text -> Attribute
makeAttribute Text
"aria-expanded" (forall a. a -> a -> Bool -> a
bool Text
"true" Text
"false" Bool
collapse), Text -> Text -> Attribute
makeAttribute Text
"aria-controls" Text
idb] (forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
label))
      )
      forall a. Semigroup a => a -> a -> a
<> forall a. With a => a -> [Attribute] -> a
with
        forall arg result. Term arg result => arg -> result
div_
        [Text -> Attribute
id_ Text
idb, Text -> Attribute
class__ (Text
"collapse" forall a. Semigroup a => a -> a -> a
<> 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
"#" forall a. Semigroup a => a -> a -> a
<> Text
idp)]
        (forall a. With a => a -> [Attribute] -> a
with forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
"card-body"] HtmlT Identity ()
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 :: forall (m :: * -> *).
MonadState Int m =>
Text
-> Maybe Text
-> [(Text, HtmlT Identity ())]
-> m (HtmlT Identity ())
accordion Text
pre Maybe Text
x [(Text, HtmlT Identity ())]
hs = do
  Text
idp' <- forall (m :: * -> *). MonadState Int m => Text -> m Text
genNamePre Text
pre
  forall a. With a => a -> [Attribute] -> a
with forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
"accordion m-1", Text -> Attribute
id_ Text
idp'] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {f :: * -> *}.
MonadState Int f =>
Text -> f (HtmlT Identity ())
aCards Text
idp'
  where
    aCards :: Text -> f (HtmlT Identity ())
aCards Text
par = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *}.
MonadState Int m =>
Text -> (Text, HtmlT Identity ()) -> m (HtmlT Identity ())
aCard Text
par) [(Text, HtmlT Identity ())]
hs
    aCard :: Text -> (Text, HtmlT Identity ()) -> m (HtmlT Identity ())
aCard Text
par (Text
t, HtmlT Identity ()
b) = do
      Text
idh <- forall (m :: * -> *). MonadState Int m => Text -> m Text
genNamePre Text
pre
      Text
idb <- forall (m :: * -> *). MonadState Int m => Text -> m Text
genNamePre Text
pre
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool
-> [Attribute]
-> Text
-> Text
-> Text
-> Text
-> HtmlT Identity ()
-> HtmlT Identity ()
accordionCard (Maybe Text
x forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Text
t) [] Text
par Text
idh Text
idb Text
t HtmlT Identity ()
b

-- | create a bootstrapped accordian class
accordionChecked :: (MonadState Int m) => Text -> [(Text, Html (), Html ())] -> m (Html ())
accordionChecked :: forall (m :: * -> *).
MonadState Int m =>
Text
-> [(Text, HtmlT Identity (), HtmlT Identity ())]
-> m (HtmlT Identity ())
accordionChecked Text
pre [(Text, HtmlT Identity (), HtmlT Identity ())]
hs = do
  Text
idp' <- forall (m :: * -> *). MonadState Int m => Text -> m Text
genNamePre Text
pre
  forall a. With a => a -> [Attribute] -> a
with forall arg result. Term arg result => arg -> result
div_ [Text -> Attribute
class__ Text
"accordion m-1", Text -> Attribute
id_ Text
idp'] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {f :: * -> *}.
MonadState Int f =>
Text -> f (HtmlT Identity ())
aCards Text
idp'
  where
    aCards :: Text -> f (HtmlT Identity ())
aCards Text
par = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *}.
MonadState Int m =>
Text
-> (Text, HtmlT Identity (), HtmlT Identity ())
-> m (HtmlT Identity ())
aCard Text
par) [(Text, HtmlT Identity (), HtmlT Identity ())]
hs
    aCard :: Text
-> (Text, HtmlT Identity (), HtmlT Identity ())
-> m (HtmlT Identity ())
aCard Text
par (Text
l, HtmlT Identity ()
bodyhtml, HtmlT Identity ()
checkhtml) = do
      Text
idh <- forall (m :: * -> *). MonadState Int m => Text -> m Text
genNamePre Text
pre
      Text
idb <- forall (m :: * -> *). MonadState Int m => Text -> m Text
genNamePre Text
pre
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool
-> Text
-> Text
-> Text
-> Text
-> HtmlT Identity ()
-> HtmlT Identity ()
-> HtmlT Identity ()
accordionCardChecked Bool
True Text
par Text
idh Text
idb Text
l HtmlT Identity ()
bodyhtml HtmlT Identity ()
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, HtmlT Identity ())] -> HtmlT Identity ()
accordion_ Text
pre Maybe Text
x [(Text, HtmlT Identity ())]
hs = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *).
MonadState Int m =>
Text
-> Maybe Text
-> [(Text, HtmlT Identity ())]
-> m (HtmlT Identity ())
accordion Text
pre Maybe Text
x [(Text, HtmlT Identity ())]
hs) Int
0