{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wall #-}
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"
]
]
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"
]
]
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"
]
]
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
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
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
)
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]
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)
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)
accordion ::
(MonadState Int m) =>
Text ->
Maybe Text ->
[(Text, Html ())] ->
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
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
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