Other.hs

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

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

import Data.Map qualified as Map
import Data.Text qualified as T
import Data.UUID (UUID)
import Optics
import Relude
import Text.Blaze.Html
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import WikiMusic.Model.Artwork
import WikiMusic.SSR.Language
import WikiMusic.SSR.Model.Api
import WikiMusic.SSR.View.Components.DetailList
import WikiMusic.SSR.View.Components.Forms

likeCount ::
  ( Is k1 A_Getter,
    Is k2 A_Getter,
    JoinKinds k3 l k2,
    LabelOptic "isLike" l u v Bool Bool,
    LabelOptic "opinions" k1 s1 s1 (Map k4 s2) (Map k4 s2),
    LabelOptic "opinion" k3 s2 s2 u v
  ) =>
  s1 ->
  Text
likeCount entity =
  T.pack
    . show
    . length
    $ Map.elems
    $ Map.filter (^. #opinion % #isLike) (entity ^. #opinions)

dislikeCount ::
  ( Is k1 A_Getter,
    Is k2 A_Getter,
    JoinKinds k3 l k2,
    LabelOptic "opinions" k1 s1 s1 (Map k4 s2) (Map k4 s2),
    LabelOptic "opinion" k3 s2 s2 u v,
    LabelOptic "isDislike" l u v Bool Bool
  ) =>
  s1 ->
  Text
dislikeCount entity =
  T.pack
    . show
    . length
    $ Map.elems
    $ Map.filter (^. #opinion % #isDislike) (entity ^. #opinions)

mkIdentifierHref :: Text -> UUID -> AttributeValue
mkIdentifierHref path identifier = fromString ("/" <> T.unpack path <> "/" <> show identifier)

simpleEntityCard ::
  ( Is k1 A_Getter,
    Is k3 A_Getter,
    Is k4 A_Getter,
    Is k5 A_Getter,
    Is k6 A_Getter,
    Is k7 A_Getter,
    Is k8 A_Getter,
    Is k9 A_Getter,
    Show a,
    JoinKinds k10 l1 k4,
    JoinKinds k10 l2 k3,
    LabelOptic "displayName" k8 s1 s1 Text Text,
    LabelOptic "isLike" l1 u v Bool Bool,
    LabelOptic "artworks" k5 s1 s1 (Map k11 s2) (Map k11 s2),
    LabelOptic "identifier" k7 s1 s1 UUID UUID,
    LabelOptic "opinions" k9 s1 s1 (Map k12 s3) (Map k12 s3),
    LabelOptic "viewCount" k1 s1 s1 a a,
    LabelOptic "artwork" k6 s2 s2 Artwork Artwork,
    LabelOptic "opinion" k10 s3 s3 u v,
    LabelOptic "isDislike" l2 u v Bool Bool
  ) =>
  Language ->
  Text ->
  s1 ->
  Html
simpleEntityCard language path entity = article ! class_ "simple-entity-card" $ do
  maybeImg
  a
    ! href (mkIdentifierHref path (entity ^. #identifier))
    ! class_ "margin-top-large"
    $ h3
    . text
    $ entity
    ^. #displayName
  detailList $ do
    detailListEntry ((^. #more % #likes) |##| language) (text $ likeCount entity)
    detailListEntry ((^. #more % #dislikes) |##| language) (text $ dislikeCount entity)
    detailListEntry ((^. #more % #views) |##| language) (text $ T.pack . show $ entity ^. #viewCount)
  where
    artworks = Relude.map (\x -> x ^. #artwork) (Map.elems $ entity ^. #artworks) :: [Artwork]
    maybeImg = maybe (H.span "") (toImg . Relude.head) (nonEmpty artworks)
    toImg x =
      a
        ! href (mkIdentifierHref path (entity ^. #identifier))
        $ img
        ! customAttribute "loading" "lazy"
        ! src (fromString . T.unpack $ x ^. #contentUrl)

imageCarousel :: [Artwork] -> Html
imageCarousel artworks =
  section ! class_ "slider" $ do
    mapM_
      ( \x ->
          img
            ! customAttribute "loading" "lazy"
            ! src (fromString . T.unpack $ x ^. #contentUrl)
      )
      artworks

entityDetailsSkeleton :: Html -> Html -> Html
entityDetailsSkeleton slot0 slot1 =
  H.div ! class_ "flex direction-row justify-content-space-evenly" $ do
    H.div ! class_ "col" $ do
      slot0
    H.div ! class_ "col" $ do
      slot1

entityDetails ::
  ( Is k1 A_Getter,
    Is k2 A_Getter,
    Is k3 A_Getter,
    Is k4 A_Getter,
    Is k5 A_Getter,
    Is k6 A_Getter,
    Is k7 A_Getter,
    Is k8 A_Getter,
    Is k9 A_Getter,
    Is k10 A_Getter,
    Is k11 A_Getter,
    Is k12 A_Getter,
    Is k13 A_Getter,
    Foldable t1,
    Foldable t2,
    Foldable t3,
    Foldable t4,
    Foldable t5,
    Foldable t6,
    Show a1,
    Show a2,
    Show a3,
    Show a4,
    Show a5,
    Functor t4,
    LabelOptic "createdAt" k4 s s a2 a2,
    LabelOptic "createdBy" k3 s s a1 a1,
    LabelOptic "lastEditedAt" k11 s s (t4 a5) (t4 a5),
    LabelOptic "displayName" k5 s s Text Text,
    LabelOptic "artworks" k6 s s (Map k14 a6) (Map k14 a6),
    LabelOptic "identifier" k9 s s a3 a3,
    LabelOptic "viewCount" k10 s s a4 a4,
    LabelOptic "artwork" k7 a6 a6 Artwork Artwork,
    LabelOptic "description" k8 s s (t3 Text) (t3 Text),
    LabelOptic "soundcloudUrl" k1 s s (t1 Text) (t1 Text),
    LabelOptic "spotifyUrl" k12 s s (t5 Text) (t5 Text),
    LabelOptic "wikipediaUrl" k2 s s (t2 Text) (t2 Text),
    LabelOptic "youtubeUrl" k13 s s (t6 Text) (t6 Text)
  ) =>
  Language ->
  Text ->
  s ->
  Html
entityDetails language path x =
  entityDetailsSkeleton slot0 slot1
  where
    verboseLink' uri = a ! href (fromString . T.unpack $ uri) $ text uri
    path' = T.unpack path
    entityLinks = do
      mapM_
        (detailListEntry "Spotify" . verboseLink')
        (x ^. #spotifyUrl)
      mapM_
        (detailListEntry "Wikipedia" . verboseLink')
        (x ^. #wikipediaUrl)
      mapM_
        (detailListEntry "YouTube" . verboseLink')
        (x ^. #youtubeUrl)
      mapM_
        (detailListEntry "SoundCloud" . verboseLink')
        (x ^. #soundcloudUrl)
    slot0 = do
      imageCarousel (Relude.map (^. #artwork) (Map.elems $ x ^. #artworks))
      H.div ! class_ "flex direction-row" $ do
        a
          ! href (fromString ("/" <> path' <> "/edit/" <> show (x ^. #identifier)))
          $ button
          $ text ((^. #buttons % #edit) |##| language)
        a
          ! href (fromString ("/" <> path' <> "/delete/" <> show (x ^. #identifier)))
          $ button
          $ text ((^. #buttons % #delete) |##| language)
      mapM_ (p . text) (x ^. #description)

    slot1 = do
      (h3 ! class_ "text-align-center font-size-xxx-large font-weight-500") . fromString . T.unpack $ (x ^. #displayName)
      H.div ! class_ "flex direction-column" $ do
        section ! class_ "flex direction-row justify-content-center gap-small align-items-baseline" $ do
          postForm' (fromString ("/" <> path' <> "/like/" <> show (x ^. #identifier))) "" $ do
            button ! type_ "submit" $ do
              H.span "+"
              text ((^. #buttons % #like) |##| language)
          postForm' (fromString ("/" <> path' <> "/dislike/" <> show (x ^. #identifier))) "" $ do
            button ! type_ "submit" $ do
              H.span "-"
              text ((^. #buttons % #dislike) |##| language)

        section $ detailList $ do
          detailListEntry ((^. #more % #views) |##| language) (Relude.show $ x ^. #viewCount)
          detailListEntry ((^. #more % #createdAt) |##| language) (Relude.show $ x ^. #createdAt)
          mapM_
            (detailListEntry ((^. #more % #lastEditedAt) |##| language))
            (Relude.show <$> x ^. #lastEditedAt)
          detailListEntry ((^. #more % #createdBy) |##| language) (Relude.show $ x ^. #createdBy)

          hr
          entityLinks

warningBanner :: Language -> Html
warningBanner language =
  section ! class_ "warning-section text-align-center" $ do
    small
      ! class_ "warning-text"
      $ text
        ((^. #more % #warningHeavyDevelopment) |##| language)

simpleIcon :: Text -> Text -> Html
simpleIcon x txt =
  H.span $ do
    H.span ! class_ "margin-medium" $ (fromString . T.unpack $ x)
    H.span (fromString . T.unpack $ txt)