{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module WikiMusic.SSR.View.Components.Other
  ( likeCount,
    dislikeCount,
    simpleEntityCard,
    imageCarousel,
    warningBanner,
    entityDetails,
  )
where

import Principium
import Text.Blaze.Html5 as H hiding (head, map)
import Text.Blaze.Html5.Attributes as A
import WikiMusic.Model.Artwork
import WikiMusic.SSR.View.Components.DetailList
import WikiMusic.SSR.View.Components.Forms

likeCount :: s -> Text
likeCount s
entity =
  String -> Text
packText
    (String -> Text) -> ([a] -> String) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall b a. (Show a, IsString b) => a -> b
show
    (Int -> String) -> ([a] -> Int) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
    ([a] -> Text) -> [a] -> Text
forall a b. (a -> b) -> a -> b
$ Map k a -> [a]
forall k a. Map k a -> [a]
mapElems
    (Map k a -> [a]) -> Map k a -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> Map k a -> Map k a
forall a k. (a -> Bool) -> Map k a -> Map k a
mapFilter (a -> Optic' k NoIx a Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic k NoIx a a u v
#opinion Optic k NoIx a a u v
-> Optic l NoIx u v Bool Bool -> Optic' k NoIx a Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic l NoIx u v Bool Bool
#isLike) (s
entity s -> Optic' k NoIx s (Map k a) -> Map k a
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s (Map k a)
#opinions)

dislikeCount :: s -> Text
dislikeCount s
entity =
  String -> Text
packText
    (String -> Text) -> ([a] -> String) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall b a. (Show a, IsString b) => a -> b
show
    (Int -> String) -> ([a] -> Int) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
    ([a] -> Text) -> [a] -> Text
forall a b. (a -> b) -> a -> b
$ Map k a -> [a]
forall k a. Map k a -> [a]
mapElems
    (Map k a -> [a]) -> Map k a -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> Map k a -> Map k a
forall a k. (a -> Bool) -> Map k a -> Map k a
mapFilter (a -> Optic' k NoIx a Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic k NoIx a a u v
#opinion Optic k NoIx a a u v
-> Optic l NoIx u v Bool Bool -> Optic' k NoIx a Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic l NoIx u v Bool Bool
#isDislike) (s
entity s -> Optic' k NoIx s (Map k a) -> Map k a
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s (Map k a)
#opinions)

mkIdentifierHref :: Text -> UUID -> AttributeValue
mkIdentifierHref :: Text -> UUID -> AttributeValue
mkIdentifierHref Text
path UUID
identifier = String -> AttributeValue
forall a. IsString a => String -> a
fromString (String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpackText Text
path String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UUID -> String
forall b a. (Show a, IsString b) => a -> b
show UUID
identifier)

-- use dark: in tailwind to use system dark / light mode, or use vv to read from cookie
simpleEntityCard :: ViewVars -> Text -> s -> Markup
simpleEntityCard ViewVars
vv Text
path s
entity = Markup -> Markup
article
  (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css'
    [ Text
"bg-slate-100",
      Text
"rounded-2xl",
      Text
"flex",
      Text
"flex-wrap",
      Text
"gap-4",
      Text
"flex-row",
      Text
"md:flex-col",
      Text
"max-w-56",
      Text
"border",
      if ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
#uiMode Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
-> Optic An_Iso NoIx UiMode UiMode Text Text
-> Optic' A_Lens NoIx ViewVars Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic An_Iso NoIx UiMode UiMode Text Text
#value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dark" then Text
"dark:bg-black/70" else Text
"bg-white/80",
      Text
"border-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ViewVars ViewVars Palette Palette
#palette Optic A_Lens NoIx ViewVars ViewVars Palette Palette
-> Optic An_Iso NoIx Palette Palette Text Text
-> Optic' A_Lens NoIx ViewVars Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic An_Iso NoIx Palette Palette Text Text
#value Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-300/50"
    ]
  (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
    Markup
maybeImg
    Markup -> Markup
H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"px-4", Text
"py-4", Text
"flex", Text
"flex-col", Text
"gap-4", Text
"align-center"] (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
      Markup -> Markup
a
        (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href (Text -> UUID -> AttributeValue
mkIdentifierHref Text
path (s
entity s -> Optic' k NoIx s UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s UUID
#identifier))
        (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ (Markup -> Markup
h3 (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"text-xl", Text
"font-bold", Text
"break-words", Text
"text-center", if ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
#uiMode Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
-> Optic An_Iso NoIx UiMode UiMode Text Text
-> Optic' A_Lens NoIx ViewVars Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic An_Iso NoIx UiMode UiMode Text Text
#value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dark" then Text
"text-white" else Text
"text-black"])
        (Markup -> Markup) -> (Text -> Markup) -> Text -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Markup
text
        (Text -> Markup) -> Text -> Markup
forall a b. (a -> b) -> a -> b
$ s
entity
        s -> Optic' k NoIx s Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s Text
#displayName
      Markup -> Markup
detailList (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
        ViewVars -> Text -> Markup -> Markup
detailListEntry ViewVars
vv ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#likes) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language)) (Text -> Markup
text (Text -> Markup) -> Text -> Markup
forall a b. (a -> b) -> a -> b
$ s -> Text
forall {k} {k} {k} {l} {u} {v} {s} {k} {a}.
(Is k A_Getter, Is k A_Getter, JoinKinds k l k,
 LabelOptic "isLike" l u v Bool Bool,
 LabelOptic "opinions" k s s (Map k a) (Map k a),
 LabelOptic "opinion" k a a u v) =>
s -> Text
likeCount s
entity)
        ViewVars -> Text -> Markup -> Markup
detailListEntry ViewVars
vv ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#dislikes) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language)) (Text -> Markup
text (Text -> Markup) -> Text -> Markup
forall a b. (a -> b) -> a -> b
$ s -> Text
forall {k} {k} {k} {l} {s} {k} {a} {u} {v}.
(Is k A_Getter, Is k A_Getter, JoinKinds k l k,
 LabelOptic "opinions" k s s (Map k a) (Map k a),
 LabelOptic "opinion" k a a u v,
 LabelOptic "isDislike" l u v Bool Bool) =>
s -> Text
dislikeCount s
entity)
        ViewVars -> Text -> Markup -> Markup
detailListEntry ViewVars
vv ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#views) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language)) (Text -> Markup
text (Text -> Markup) -> (a -> Text) -> a -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
packText (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall b a. (Show a, IsString b) => a -> b
show (a -> Markup) -> a -> Markup
forall a b. (a -> b) -> a -> b
$ s
entity s -> Optic' k NoIx s a -> a
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s a
#viewCount)
  where
    artworks :: [Artwork]
artworks = (s -> Artwork) -> [s] -> [Artwork]
forall a b. (a -> b) -> [a] -> [b]
map (\s
x -> s
x s -> Optic' k NoIx s Artwork -> Artwork
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s Artwork
#artwork) (Map k s -> [s]
forall k a. Map k a -> [a]
mapElems (Map k s -> [s]) -> Map k s -> [s]
forall a b. (a -> b) -> a -> b
$ s
entity s -> Optic' k NoIx s (Map k s) -> Map k s
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s (Map k s)
#artworks) :: [Artwork]
    sortedArts :: [Artwork]
sortedArts = (Artwork -> Artwork -> Ordering) -> [Artwork] -> [Artwork]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\Artwork
x Artwork
y -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Artwork
x Artwork -> Optic' A_Lens NoIx Artwork Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Artwork Int
#orderValue) (Artwork
y Artwork -> Optic' A_Lens NoIx Artwork Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Artwork Int
#orderValue)) [Artwork]
artworks
    maybeImg :: Markup
maybeImg = Markup
-> (NonEmpty Artwork -> Markup)
-> Maybe (NonEmpty Artwork)
-> Markup
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Markup -> Markup
H.span Markup
"") (Artwork -> Markup
toImg (Artwork -> Markup)
-> (NonEmpty Artwork -> Artwork) -> NonEmpty Artwork -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Artwork -> Artwork
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head) ([Artwork] -> Maybe (NonEmpty Artwork)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Artwork]
sortedArts)
    toImg :: Artwork -> Markup
toImg Artwork
x =
      Markup -> Markup
a
        (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href (Text -> UUID -> AttributeValue
mkIdentifierHref Text
path (s
entity s -> Optic' k NoIx s UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s UUID
#identifier))
        (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ Markup
img
        Markup -> Attribute -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"object-cover", Text
"w-60", Text
"h-60", Text
"rounded-2xl"]
        Markup -> Attribute -> Markup
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute Tag
"loading" AttributeValue
"lazy"
        Markup -> Attribute -> Markup
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
src (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpackText (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Artwork
x Artwork -> Optic' A_Lens NoIx Artwork Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Artwork Text
#contentUrl)

imageCarousel :: [Artwork] -> Html
imageCarousel :: [Artwork] -> Markup
imageCarousel [Artwork]
artworks =
  Markup -> Markup
section (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"flex flex-wrap flex-col gap-6" (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
    (Artwork -> Markup) -> [Artwork] -> Markup
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
      ( \Artwork
x ->
          Markup -> Markup
H.div (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
            Markup
img
              Markup -> Attribute -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"object-cover", Text
"w-72", Text
"h-72", Text
"rounded-2xl"]
              Markup -> Attribute -> Markup
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute Tag
"loading" AttributeValue
"lazy"
              Markup -> Attribute -> Markup
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
src (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpackText (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Artwork
x Artwork -> Optic' A_Lens NoIx Artwork Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Artwork Text
#contentUrl)
            (Text -> Markup) -> Maybe Text -> Markup
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Markup -> Markup
H.span (Markup -> Markup) -> (Text -> Markup) -> Text -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Markup
text) (Artwork
x Artwork -> Optic' A_Lens NoIx Artwork (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Artwork (Maybe Text)
#contentCaption)
      )
      [Artwork]
artworks

entityDetailsSkeleton :: Html -> Html -> Html
entityDetailsSkeleton :: Markup -> Markup -> Markup
entityDetailsSkeleton Markup
slot0 Markup
slot1 =
  Markup -> Markup
H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"flex", Text
"flex-row", Text
"flex-wrap", Text
"container", Text
"mx-auto"] (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
    Markup -> Markup
H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"flex", Text
"flex-col", Text
"flex-wrap", Text
"w-full", Text
"md:w-1/2"] (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
      Markup
slot0
    Markup -> Markup
H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"flex", Text
"flex-col", Text
"flex-wrap", Text
"w-full", Text
"md:w-1/2", Text
"my-4"] (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
      Markup
slot1

hiddenUriLink' :: ViewVars -> Text -> Text -> Markup
hiddenUriLink' ViewVars
vv Text
txt Text
uri = Markup -> Markup
a (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
target AttributeValue
"_blank" (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! Set Text -> Attribute
css (ViewVars -> Set Text
cssLink ViewVars
vv) (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpackText (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
uri) (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ Text -> Markup
text (Text
"🔗 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt)

entityLinks :: ViewVars -> s -> Markup
entityLinks ViewVars
vv s
x = do
  (Text -> Markup) -> t Text -> Markup
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (ViewVars -> Text -> Text -> Markup
hiddenUriLink' ViewVars
vv Text
"Spotify")
    (s
x s -> Optic' k NoIx s (t Text) -> t Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s (t Text)
#spotifyUrl)
  (Text -> Markup) -> t Text -> Markup
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (ViewVars -> Text -> Text -> Markup
hiddenUriLink' ViewVars
vv Text
"Wikipedia")
    (s
x s -> Optic' k NoIx s (t Text) -> t Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s (t Text)
#wikipediaUrl)
  (Text -> Markup) -> t Text -> Markup
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (ViewVars -> Text -> Text -> Markup
hiddenUriLink' ViewVars
vv Text
"YouTube")
    (s
x s -> Optic' k NoIx s (t Text) -> t Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s (t Text)
#youtubeUrl)
  (Text -> Markup) -> t Text -> Markup
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (ViewVars -> Text -> Text -> Markup
hiddenUriLink' ViewVars
vv Text
"SoundCloud")
    (s
x s -> Optic' k NoIx s (t Text) -> t Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s (t Text)
#soundcloudUrl)

slot0 :: s -> s -> Markup
slot0 s
vv s
x = do
  Markup -> Markup
H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"flex", Text
"flex-col", Text
"flex-wrap", Text
"justify-center", Text
"align-center", Text
"gap-4"] (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
    [Artwork] -> Markup
imageCarousel ((a -> Artwork) -> [a] -> [Artwork]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Optic' k NoIx a Artwork -> Artwork
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx a Artwork
#artwork) (Map k a -> [a]
forall k a. Map k a -> [a]
mapElems (Map k a -> [a]) -> Map k a -> [a]
forall a b. (a -> b) -> a -> b
$ s
x s -> Optic' k NoIx s (Map k a) -> Map k a
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s (Map k a)
#artworks))
    (Text -> Markup) -> t Text -> Markup
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Markup -> Markup
p (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"white-space-break-spaces", if s
vv s -> Optic' k NoIx s a -> a
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic k NoIx s s u v
#uiMode Optic k NoIx s s u v -> Optic l NoIx u v a a -> Optic' k NoIx s a
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic l NoIx u v a a
#value a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"dark" then Text
"text-white" else Text
"text-black"]) (Markup -> Markup) -> (Text -> Markup) -> Text -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Markup
text) (s
x s -> Optic' k NoIx s (t Text) -> t Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s (t Text)
#description)

slot1 :: ViewVars -> Text -> s -> Markup
slot1 ViewVars
vv Text
path s
x = Markup -> Markup
section
  (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css'
    [ Text
"flex",
      Text
"flex-col",
      Text
"flex-wrap",
      Text
"items-center",
      Text
"gap-8"
    ]
  (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
    ( Markup -> Markup
h3
        (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css'
          [ Text
"text-3xl",
            Text
"text-black",
            Text
"font-bold",
            if ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
#uiMode Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
-> Optic An_Iso NoIx UiMode UiMode Text Text
-> Optic' A_Lens NoIx ViewVars Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic An_Iso NoIx UiMode UiMode Text Text
#value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dark" then Text
"text-white" else Text
"text-black"
          ]
      )
      (Markup -> Markup) -> (Text -> Markup) -> Text -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Markup
forall a. IsString a => String -> a
fromString
      (String -> Markup) -> (Text -> String) -> Text -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpackText
      (Text -> Markup) -> Text -> Markup
forall a b. (a -> b) -> a -> b
$ (s
x s -> Optic' k NoIx s Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s Text
#displayName)
    Markup -> Markup
H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"flex", Text
"flex-row", Text
"flex-wrap", Text
"justify-center", Text
"gap-4"] (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
      ViewVars -> String -> s -> Markup
forall {a} {k} {s}.
(Show a, LabelOptic "identifier" k s s a a, Is k A_Getter) =>
ViewVars -> String -> s -> Markup
likesDislikes ViewVars
vv String
path' s
x
      ViewVars -> String -> s -> Markup
forall {a} {k} {s}.
(Show a, Is k A_Getter, LabelOptic "identifier" k s s a a) =>
ViewVars -> String -> s -> Markup
entityButtons ViewVars
vv String
path' s
x

      Markup -> Markup
section
        (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"flex", Text
"flex-row", Text
"flex-wrap", Text
"justify-center", Text
"gap-4"]
        (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ Markup -> Markup
detailList
        (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
          ViewVars -> s -> Markup
forall {k} {k} {k} {k} {k} {k} {k} {a} {a} {a} {a} {t :: * -> *}
       {k} {l} {l} {s} {u} {v} {k} {a}.
(Is k A_Getter, Is k A_Getter, Is k A_Getter, Is k A_Getter,
 Is k A_Getter, Is k A_Getter, Is k A_Getter, Show a, Show a,
 Show a, Show a, Foldable t, Functor t, JoinKinds k l k,
 JoinKinds k l k, LabelOptic "createdBy" k s s a a,
 LabelOptic "createdAt" k s s a a,
 LabelOptic "lastEditedAt" k s s (t a) (t a),
 LabelOptic "isLike" l u v Bool Bool,
 LabelOptic "opinions" k s s (Map k a) (Map k a),
 LabelOptic "viewCount" k s s a a, LabelOptic "opinion" k a a u v,
 LabelOptic "isDislike" l u v Bool Bool) =>
ViewVars -> s -> Markup
entityBaseDetails ViewVars
vv s
x
      Markup
hr
    Markup -> Markup
H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"flex", Text
"flex-row", Text
"flex-wrap", Text
"justify-center", Text
"gap-6"] (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ ViewVars -> s -> Markup
forall {k} {k} {k} {k} {t :: * -> *} {t :: * -> *} {t :: * -> *}
       {t :: * -> *} {s}.
(Is k A_Getter, Is k A_Getter, Is k A_Getter, Is k A_Getter,
 Foldable t, Foldable t, Foldable t, Foldable t,
 LabelOptic "soundcloudUrl" k s s (t Text) (t Text),
 LabelOptic "spotifyUrl" k s s (t Text) (t Text),
 LabelOptic "wikipediaUrl" k s s (t Text) (t Text),
 LabelOptic "youtubeUrl" k s s (t Text) (t Text)) =>
ViewVars -> s -> Markup
entityLinks ViewVars
vv s
x
  where
    path' :: String
path' = Text -> String
unpackText Text
path

entityDetails :: ViewVars -> Text -> s -> Markup
entityDetails ViewVars
vv Text
path s
x = do
  Markup -> Markup -> Markup
entityDetailsSkeleton (ViewVars -> s -> Markup
forall {k} {k} {k} {k} {a} {t :: * -> *} {k} {l} {u} {v} {s} {s}
       {k} {a}.
(Is k A_Getter, Is k A_Getter, Is k A_Getter, Is k A_Getter,
 IsString a, Foldable t, Eq a, JoinKinds k l k,
 LabelOptic "value" l u v a a,
 LabelOptic "description" k s s (t Text) (t Text),
 LabelOptic "uiMode" k s s u v,
 LabelOptic "artworks" k s s (Map k a) (Map k a),
 LabelOptic "artwork" k a a Artwork Artwork) =>
s -> s -> Markup
slot0 ViewVars
vv s
x) (ViewVars -> Text -> s -> Markup
forall {a} {a} {a} {a} {a} {t :: * -> *} {k} {l} {k} {l} {k} {k}
       {k} {k} {k} {k} {k} {k} {k} {k} {k} {k} {t :: * -> *} {t :: * -> *}
       {t :: * -> *} {t :: * -> *} {s} {u} {v} {k} {a}.
(Show a, Show a, Show a, Show a, Show a, Functor t,
 JoinKinds k l k, JoinKinds k l k, Is k A_Getter, Is k A_Getter,
 Is k A_Getter, Is k A_Getter, Is k A_Getter, Is k A_Getter,
 Is k A_Getter, Is k A_Getter, Is k A_Getter, Is k A_Getter,
 Is k A_Getter, Is k A_Getter, Is k A_Getter, Foldable t,
 Foldable t, Foldable t, Foldable t, Foldable t,
 LabelOptic "identifier" k s s a a,
 LabelOptic "createdBy" k s s a a, LabelOptic "createdAt" k s s a a,
 LabelOptic "lastEditedAt" k s s (t a) (t a),
 LabelOptic "displayName" k s s Text Text,
 LabelOptic "soundcloudUrl" k s s (t Text) (t Text),
 LabelOptic "spotifyUrl" k s s (t Text) (t Text),
 LabelOptic "wikipediaUrl" k s s (t Text) (t Text),
 LabelOptic "youtubeUrl" k s s (t Text) (t Text),
 LabelOptic "isLike" l u v Bool Bool,
 LabelOptic "opinions" k s s (Map k a) (Map k a),
 LabelOptic "viewCount" k s s a a, LabelOptic "opinion" k a a u v,
 LabelOptic "isDislike" l u v Bool Bool) =>
ViewVars -> Text -> s -> Markup
slot1 ViewVars
vv Text
path s
x)

likesDislikes :: ViewVars -> String -> s -> Markup
likesDislikes ViewVars
vv String
path' s
x = do
  Text -> Markup -> Markup
postForm (String -> Text
forall a. IsString a => String -> a
fromString (String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/like/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall b a. (Show a, IsString b) => a -> b
show (s
x s -> Optic' k NoIx s a -> a
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s a
#identifier))) (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
    Markup -> Markup
button (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! Set Text -> Attribute
css (ViewVars -> Set Text
cssButton ViewVars
vv) (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"submit" (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
      Markup -> Markup
H.span Markup
"+"
      Text -> Markup
text ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  ApplicationDictionary
  ApplicationDictionary
  Buttons
  Buttons
#buttons Optic
  A_Lens
  NoIx
  ApplicationDictionary
  ApplicationDictionary
  Buttons
  Buttons
-> Optic A_Lens NoIx Buttons Buttons DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Buttons Buttons DictTerm DictTerm
#like) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language))
  Text -> Markup -> Markup
postForm (String -> Text
forall a. IsString a => String -> a
fromString (String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/dislike/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall b a. (Show a, IsString b) => a -> b
show (s
x s -> Optic' k NoIx s a -> a
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s a
#identifier))) (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
    Markup -> Markup
button (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! Set Text -> Attribute
css (ViewVars -> Set Text
cssButton ViewVars
vv) (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"submit" (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
      Markup -> Markup
H.span Markup
"-"
      Text -> Markup
text ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  ApplicationDictionary
  ApplicationDictionary
  Buttons
  Buttons
#buttons Optic
  A_Lens
  NoIx
  ApplicationDictionary
  ApplicationDictionary
  Buttons
  Buttons
-> Optic A_Lens NoIx Buttons Buttons DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Buttons Buttons DictTerm DictTerm
#dislike) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language))

entityBaseDetails :: ViewVars -> s -> Markup
entityBaseDetails ViewVars
vv s
x = do
  ViewVars -> Text -> Markup -> Markup
detailListEntry ViewVars
vv ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#likes) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language)) (Text -> Markup
text (Text -> Markup) -> Text -> Markup
forall a b. (a -> b) -> a -> b
$ s -> Text
forall {k} {k} {k} {l} {u} {v} {s} {k} {a}.
(Is k A_Getter, Is k A_Getter, JoinKinds k l k,
 LabelOptic "isLike" l u v Bool Bool,
 LabelOptic "opinions" k s s (Map k a) (Map k a),
 LabelOptic "opinion" k a a u v) =>
s -> Text
likeCount s
x)
  ViewVars -> Text -> Markup -> Markup
detailListEntry ViewVars
vv ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#dislikes) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language)) (Text -> Markup
text (Text -> Markup) -> Text -> Markup
forall a b. (a -> b) -> a -> b
$ s -> Text
forall {k} {k} {k} {l} {s} {k} {a} {u} {v}.
(Is k A_Getter, Is k A_Getter, JoinKinds k l k,
 LabelOptic "opinions" k s s (Map k a) (Map k a),
 LabelOptic "opinion" k a a u v,
 LabelOptic "isDislike" l u v Bool Bool) =>
s -> Text
dislikeCount s
x)
  ViewVars -> Text -> Markup -> Markup
detailListEntry ViewVars
vv ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#views) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language)) (a -> Markup
forall b a. (Show a, IsString b) => a -> b
show (a -> Markup) -> a -> Markup
forall a b. (a -> b) -> a -> b
$ s
x s -> Optic' k NoIx s a -> a
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s a
#viewCount)
  ViewVars -> Text -> Markup -> Markup
detailListEntry ViewVars
vv ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#createdAt) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language)) (a -> Markup
forall b a. (Show a, IsString b) => a -> b
show (a -> Markup) -> a -> Markup
forall a b. (a -> b) -> a -> b
$ s
x s -> Optic' k NoIx s a -> a
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s a
#createdAt)
  (Markup -> Markup) -> t Markup -> Markup
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    (ViewVars -> Text -> Markup -> Markup
detailListEntry ViewVars
vv ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#lastEditedAt) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language)))
    (a -> Markup
forall b a. (Show a, IsString b) => a -> b
show (a -> Markup) -> t a -> t Markup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s
x s -> Optic' k NoIx s (t a) -> t a
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s (t a)
#lastEditedAt)
  ViewVars -> Text -> Markup -> Markup
detailListEntry ViewVars
vv ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#createdBy) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language)) (a -> Markup
forall b a. (Show a, IsString b) => a -> b
show (a -> Markup) -> a -> Markup
forall a b. (a -> b) -> a -> b
$ s
x s -> Optic' k NoIx s a -> a
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s a
#createdBy)

entityButtons :: ViewVars -> String -> s -> Markup
entityButtons ViewVars
vv String
path' s
x = do
  Markup -> Markup
a
    (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/edit/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall b a. (Show a, IsString b) => a -> b
show (s
x s -> Optic' k NoIx s a -> a
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s a
#identifier)))
    (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ Markup -> Markup
button
    (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! Set Text -> Attribute
css (ViewVars -> Set Text
cssButton ViewVars
vv)
    (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ Text -> Markup
text ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  ApplicationDictionary
  ApplicationDictionary
  Buttons
  Buttons
#buttons Optic
  A_Lens
  NoIx
  ApplicationDictionary
  ApplicationDictionary
  Buttons
  Buttons
-> Optic A_Lens NoIx Buttons Buttons DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Buttons Buttons DictTerm DictTerm
#edit) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language))
  ViewVars -> Text -> Markup -> Markup
dangerPostForm ViewVars
vv (String -> Text
forall a. IsString a => String -> a
fromString (String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/delete/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall b a. (Show a, IsString b) => a -> b
show (s
x s -> Optic' k NoIx s a -> a
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx s a
#identifier))) (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
    ViewVars -> Markup
deleteButton ViewVars
vv

warningBanner :: ViewVars -> Html
warningBanner :: ViewVars -> Markup
warningBanner ViewVars
vv =
  Markup -> Markup
section (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ do
    Markup -> Markup
small
      (Markup -> Markup) -> Attribute -> Markup -> Markup
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"warning-text"
      (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ Text -> Markup
text
        ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#warningHeavyDevelopment) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language))