{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}

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

import Control.Monad.State.Lazy
import Data.Bool
import Data.ByteString (ByteString)
import Data.Functor.Identity
import MarkupParse
import Web.Rep.Page
import Web.Rep.Shared

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Web.Rep
-- >>> import MarkupParse

bootstrapCss :: Markup
bootstrapCss :: Markup
bootstrapCss =
  NameTag -> [Attr] -> Markup
element_
    NameTag
"link"
    [ NameTag -> NameTag -> Attr
Attr NameTag
"rel" NameTag
"stylesheet",
      NameTag -> NameTag -> Attr
Attr NameTag
"href" NameTag
"https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css",
      NameTag -> NameTag -> Attr
Attr NameTag
"integrity" NameTag
"sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC",
      NameTag -> NameTag -> Attr
Attr NameTag
"crossorigin" NameTag
"anonymous"
    ]

bootstrapJs :: Markup
bootstrapJs :: Markup
bootstrapJs =
  NameTag -> [Attr] -> Markup
element_
    NameTag
"script"
    [ NameTag -> NameTag -> Attr
Attr NameTag
"src" NameTag
"https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js",
      NameTag -> NameTag -> Attr
Attr NameTag
"integrity" NameTag
"sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM",
      NameTag -> NameTag -> Attr
Attr NameTag
"crossorigin" NameTag
"anonymous"
    ]
    forall a. Semigroup a => a -> a -> a
<> NameTag -> [Attr] -> Markup
element_
      NameTag
"script"
      [ NameTag -> NameTag -> Attr
Attr NameTag
"src" NameTag
"https://code.jquery.com/jquery-3.3.1.slim.min.js",
        NameTag -> NameTag -> Attr
Attr NameTag
"integrity" NameTag
"sha384-q8i/X+965DzO0rT7abK41JStQIAqVgRVzpbzo5smXKp4YfRvH+8abtTE1Pi6jizo",
        NameTag -> NameTag -> Attr
Attr NameTag
"crossorigin" NameTag
"anonymous"
      ]

bootstrapMeta :: Markup
bootstrapMeta :: Markup
bootstrapMeta =
  NameTag -> [Attr] -> Markup
element_ NameTag
"meta" [NameTag -> NameTag -> Attr
Attr NameTag
"charset" NameTag
"utf-8"]
    forall a. Semigroup a => a -> a -> a
<> NameTag -> [Attr] -> Markup
element_
      NameTag
"meta"
      [ NameTag -> NameTag -> Attr
Attr NameTag
"name" NameTag
"viewport",
        NameTag -> NameTag -> Attr
Attr NameTag
"content" NameTag
"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 =
  Markup -> Markup -> Css -> Js -> Js -> Markup -> Markup -> Page
Page
    Markup
bootstrapCss
    Markup
bootstrapJs
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    Markup
bootstrapMeta
    forall a. Monoid a => a
mempty

-- | wrap some Html with the bootstrap <https://getbootstrap.com/docs/4.3/components/card/ card> class
cardify :: (Markup, [Attr]) -> Maybe ByteString -> (Markup, [Attr]) -> Markup
cardify :: (Markup, [Attr]) -> Maybe NameTag -> (Markup, [Attr]) -> Markup
cardify (Markup
h, [Attr]
hatts) Maybe NameTag
t (Markup
b, [Attr]
batts) =
  NameTag -> [Attr] -> Markup -> Markup
element NameTag
"div" ([NameTag -> NameTag -> Attr
Attr NameTag
"class" NameTag
"card"] forall a. Semigroup a => a -> a -> a
<> [Attr]
hatts) forall a b. (a -> b) -> a -> b
$
    Markup
h
      forall a. Semigroup a => a -> a -> a
<> NameTag -> [Attr] -> Markup -> Markup
element
        NameTag
"div"
        ([NameTag -> NameTag -> Attr
Attr NameTag
"class" NameTag
"card-body"] forall a. Semigroup a => a -> a -> a
<> [Attr]
batts)
        ( forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (NameTag -> [Attr] -> NameTag -> Markup
elementc NameTag
"h5" [NameTag -> NameTag -> Attr
Attr NameTag
"class" NameTag
"card-title"]) Maybe NameTag
t forall a. Semigroup a => a -> a -> a
<> Markup
b
        )

-- | A Html object based on the bootstrap accordion card concept.
accordionCard :: Bool -> [Attr] -> ByteString -> ByteString -> ByteString -> ByteString -> Markup -> Markup
accordionCard :: Bool
-> [Attr]
-> NameTag
-> NameTag
-> NameTag
-> NameTag
-> Markup
-> Markup
accordionCard Bool
collapse [Attr]
atts NameTag
idp NameTag
idh NameTag
idb NameTag
t0 Markup
b =
  NameTag -> [Attr] -> Markup -> Markup
element
    NameTag
"div"
    ([NameTag -> NameTag -> Attr
Attr NameTag
"class" NameTag
"card"] forall a. Semigroup a => a -> a -> a
<> [Attr]
atts)
    ( NameTag -> [Attr] -> Markup -> Markup
element
        NameTag
"div"
        [NameTag -> NameTag -> Attr
Attr NameTag
"class" NameTag
"card-header p-0", NameTag -> NameTag -> Attr
Attr NameTag
"id" NameTag
idh]
        ( NameTag -> [Attr] -> Markup -> Markup
element
            NameTag
"h2"
            [NameTag -> NameTag -> Attr
Attr NameTag
"class" NameTag
"m-0"]
            ( NameTag -> [Attr] -> NameTag -> Markup
elementc
                NameTag
"button"
                [ NameTag -> NameTag -> Attr
Attr NameTag
"class" (NameTag
"btn btn-link" forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool NameTag
"" NameTag
" collapsed" Bool
collapse),
                  NameTag -> NameTag -> Attr
Attr NameTag
"type" NameTag
"button",
                  NameTag -> NameTag -> Attr
Attr NameTag
"data-toggle" NameTag
"collapse",
                  NameTag -> NameTag -> Attr
Attr NameTag
"data-target" (NameTag
"#" forall a. Semigroup a => a -> a -> a
<> NameTag
idb),
                  NameTag -> NameTag -> Attr
Attr NameTag
"aria-expanded" (forall a. a -> a -> Bool -> a
bool NameTag
"true" NameTag
"false" Bool
collapse),
                  NameTag -> NameTag -> Attr
Attr NameTag
"aria-controls" NameTag
idb
                ]
                NameTag
t0
            )
            forall a. Semigroup a => a -> a -> a
<> NameTag -> [Attr] -> Markup -> Markup
element
              NameTag
"div"
              [ NameTag -> NameTag -> Attr
Attr NameTag
"id" NameTag
"idb",
                NameTag -> NameTag -> Attr
Attr NameTag
"class" (NameTag
"collapse" forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool NameTag
" show" NameTag
"" Bool
collapse),
                NameTag -> NameTag -> Attr
Attr NameTag
"aria-labelledby" NameTag
idh,
                NameTag -> NameTag -> Attr
Attr NameTag
"data-parent" (NameTag
"#" forall a. Semigroup a => a -> a -> a
<> NameTag
idp)
              ]
              (NameTag -> [Attr] -> Markup -> Markup
element NameTag
"div" [NameTag -> NameTag -> Attr
Attr NameTag
"class" NameTag
"card-body"] Markup
b)
        )
    )

-- | A bootstrap accordion card attached to a checkbox.
accordionCardChecked :: Bool -> ByteString -> ByteString -> ByteString -> ByteString -> Markup -> Markup -> Markup
accordionCardChecked :: Bool
-> NameTag
-> NameTag
-> NameTag
-> NameTag
-> Markup
-> Markup
-> Markup
accordionCardChecked Bool
collapse NameTag
idp NameTag
idh NameTag
idb NameTag
label Markup
bodyhtml Markup
checkhtml =
  NameTag -> [Attr] -> Markup -> Markup
element
    NameTag
"div"
    [NameTag -> NameTag -> Attr
Attr NameTag
"class" NameTag
"card"]
    ( NameTag -> [Attr] -> Markup -> Markup
element
        NameTag
"div"
        [ NameTag -> NameTag -> Attr
Attr NameTag
"class" NameTag
"card-header p-0",
          NameTag -> NameTag -> Attr
Attr NameTag
"id" NameTag
idh
        ]
        ( Markup
checkhtml
            forall a. Semigroup a => a -> a -> a
<> NameTag -> [Attr] -> Markup -> Markup
element
              NameTag
"h2"
              [NameTag -> NameTag -> Attr
Attr NameTag
"class" NameTag
"m-0"]
              ( NameTag -> [Attr] -> NameTag -> Markup
elementc
                  NameTag
"button"
                  [ NameTag -> NameTag -> Attr
Attr NameTag
"class" (NameTag
"btn btn-link" forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool NameTag
"" NameTag
" collapsed" Bool
collapse),
                    NameTag -> NameTag -> Attr
Attr NameTag
"type" NameTag
"button",
                    NameTag -> NameTag -> Attr
Attr NameTag
"data-toggle" NameTag
"collapse",
                    NameTag -> NameTag -> Attr
Attr NameTag
"data-target" (NameTag
"#" forall a. Semigroup a => a -> a -> a
<> NameTag
idb),
                    NameTag -> NameTag -> Attr
Attr NameTag
"aria-expanded" (forall a. a -> a -> Bool -> a
bool NameTag
"true" NameTag
"false" Bool
collapse),
                    NameTag -> NameTag -> Attr
Attr NameTag
"aria-controls" NameTag
idb
                  ]
                  NameTag
label
              )
        )
        forall a. Semigroup a => a -> a -> a
<> NameTag -> [Attr] -> Markup -> Markup
element
          NameTag
"div"
          [ NameTag -> NameTag -> Attr
Attr NameTag
"id" NameTag
"idb",
            NameTag -> NameTag -> Attr
Attr NameTag
"class" (NameTag
"collapse" forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool NameTag
" show" NameTag
"" Bool
collapse),
            NameTag -> NameTag -> Attr
Attr NameTag
"aria-labelledby" NameTag
idh,
            NameTag -> NameTag -> Attr
Attr NameTag
"data-parent" (NameTag
"#" forall a. Semigroup a => a -> a -> a
<> NameTag
idp)
          ]
          (NameTag -> [Attr] -> Markup -> Markup
element NameTag
"div" [NameTag -> NameTag -> Attr
Attr NameTag
"class" NameTag
"card-body"] Markup
bodyhtml)
    )

-- | create a bootstrapped accordian class
accordion ::
  (MonadState Int m) =>
  ByteString ->
  -- | name prefix.  This is needed because an Int doesn't seem to be a valid name.
  Maybe ByteString ->
  -- | card title
  [(ByteString, Markup)] ->
  -- | title, html tuple for each item in the accordion.
  m Markup
accordion :: forall (m :: * -> *).
MonadState Int m =>
NameTag -> Maybe NameTag -> [(NameTag, Markup)] -> m Markup
accordion NameTag
pre Maybe NameTag
x [(NameTag, Markup)]
hs = do
  NameTag
idp' <- forall (m :: * -> *). MonadState Int m => NameTag -> m NameTag
genNamePre NameTag
pre
  NameTag -> [Attr] -> Markup -> Markup
element NameTag
"div" [NameTag -> NameTag -> Attr
Attr NameTag
"class" NameTag
"accordion m-1", NameTag -> NameTag -> Attr
Attr NameTag
"id" NameTag
idp'] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *}. MonadState Int m => NameTag -> m [Markup]
aCards NameTag
idp')
  where
    aCards :: NameTag -> m [Markup]
aCards NameTag
par = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *}.
MonadState Int m =>
NameTag -> (NameTag, Markup) -> m Markup
aCard NameTag
par) [(NameTag, Markup)]
hs
    aCard :: NameTag -> (NameTag, Markup) -> m Markup
aCard NameTag
par (NameTag
t, Markup
b) = do
      NameTag
idh <- forall (m :: * -> *). MonadState Int m => NameTag -> m NameTag
genNamePre NameTag
pre
      NameTag
idb <- forall (m :: * -> *). MonadState Int m => NameTag -> m NameTag
genNamePre NameTag
pre
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool
-> [Attr]
-> NameTag
-> NameTag
-> NameTag
-> NameTag
-> Markup
-> Markup
accordionCard (Maybe NameTag
x forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just NameTag
t) [] NameTag
par NameTag
idh NameTag
idb NameTag
t Markup
b

-- | create a bootstrapped accordian class
accordionChecked :: (MonadState Int m) => ByteString -> [(ByteString, Markup, Markup)] -> m Markup
accordionChecked :: forall (m :: * -> *).
MonadState Int m =>
NameTag -> [(NameTag, Markup, Markup)] -> m Markup
accordionChecked NameTag
pre [(NameTag, Markup, Markup)]
hs = do
  NameTag
idp' <- forall (m :: * -> *). MonadState Int m => NameTag -> m NameTag
genNamePre NameTag
pre
  NameTag -> [Attr] -> Markup -> Markup
element NameTag
"div" [NameTag -> NameTag -> Attr
Attr NameTag
"class" NameTag
"accordion m-1", NameTag -> NameTag -> Attr
Attr NameTag
"id" NameTag
idp'] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *}. MonadState Int m => NameTag -> m [Markup]
aCards NameTag
idp')
  where
    aCards :: NameTag -> m [Markup]
aCards NameTag
par = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *}.
MonadState Int m =>
NameTag -> (NameTag, Markup, Markup) -> m Markup
aCard NameTag
par) [(NameTag, Markup, Markup)]
hs
    aCard :: NameTag -> (NameTag, Markup, Markup) -> m Markup
aCard NameTag
par (NameTag
l, Markup
bodyhtml, Markup
checkhtml) = do
      NameTag
idh <- forall (m :: * -> *). MonadState Int m => NameTag -> m NameTag
genNamePre NameTag
pre
      NameTag
idb <- forall (m :: * -> *). MonadState Int m => NameTag -> m NameTag
genNamePre NameTag
pre
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool
-> NameTag
-> NameTag
-> NameTag
-> NameTag
-> Markup
-> Markup
-> Markup
accordionCardChecked Bool
True NameTag
par NameTag
idh NameTag
idb NameTag
l Markup
bodyhtml Markup
checkhtml

-- | This version of accordion runs a local state for naming, and will cause name clashes if the prefix is not unique.
accordion_ :: ByteString -> Maybe ByteString -> [(ByteString, Markup)] -> Markup
accordion_ :: NameTag -> Maybe NameTag -> [(NameTag, Markup)] -> Markup
accordion_ NameTag
pre Maybe NameTag
x [(NameTag, Markup)]
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 =>
NameTag -> Maybe NameTag -> [(NameTag, Markup)] -> m Markup
accordion NameTag
pre Maybe NameTag
x [(NameTag, Markup)]
hs) Int
0