{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module WikiMusic.SSR.View.HtmlUtil where

import Principium
import Text.Blaze.Html5 as H hiding (map)
import Text.Blaze.Html5.Attributes as A
import WikiMusic.SSR.View.Components.Footer
import WikiMusic.SSR.View.Components.PageTop

newtype SimplePageTitle = SimplePageTitle {SimplePageTitle -> Text
value :: Text} deriving (SimplePageTitle -> SimplePageTitle -> Bool
(SimplePageTitle -> SimplePageTitle -> Bool)
-> (SimplePageTitle -> SimplePageTitle -> Bool)
-> Eq SimplePageTitle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimplePageTitle -> SimplePageTitle -> Bool
== :: SimplePageTitle -> SimplePageTitle -> Bool
$c/= :: SimplePageTitle -> SimplePageTitle -> Bool
/= :: SimplePageTitle -> SimplePageTitle -> Bool
Eq, Int -> SimplePageTitle -> ShowS
[SimplePageTitle] -> ShowS
SimplePageTitle -> String
(Int -> SimplePageTitle -> ShowS)
-> (SimplePageTitle -> String)
-> ([SimplePageTitle] -> ShowS)
-> Show SimplePageTitle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimplePageTitle -> ShowS
showsPrec :: Int -> SimplePageTitle -> ShowS
$cshow :: SimplePageTitle -> String
show :: SimplePageTitle -> String
$cshowList :: [SimplePageTitle] -> ShowS
showList :: [SimplePageTitle] -> ShowS
Show)

makeFieldLabelsNoPrefix ''SimplePageTitle

mkSharedHead :: (MonadIO m) => Env -> ViewVars -> SimplePageTitle -> m Html
mkSharedHead :: forall (m :: * -> *).
MonadIO m =>
Env -> ViewVars -> SimplePageTitle -> m Html
mkSharedHead Env
_ ViewVars
_ SimplePageTitle
pageTitle = do
  Html -> m Html
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html -> m Html) -> Html -> m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.head (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html
H.meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
charset AttributeValue
"utf-8"
    Html
H.meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
lang AttributeValue
"en"
    Html -> Html
H.title (Html -> Html) -> (Text -> Html) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
text (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ (SimplePageTitle
pageTitle SimplePageTitle -> Optic' An_Iso NoIx SimplePageTitle Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx SimplePageTitle Text
#value)
    Html
meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name AttributeValue
"viewport" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
content AttributeValue
"width=device-width, initial-scale=1"
    Html -> Html
H.style
      (Html -> Html) -> (Text -> Html) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
text
      (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ [trimming|
        @import url('https://fonts.cdnfonts.com/css/liberation-sans');
        @import url('https://fonts.cdnfonts.com/css/liberation-serif');

@font-face {
  font-family: 'Intel One Mono';
  font-style: normal;
  font-weight: 400;
  src: url('/static/ttf/IntelOneMono-Regular.ttf') format('truetype');
}

@font-face {
  font-family: 'Intel One Mono';
  font-style: italic;
  font-weight: 400;
  src: url('/static/ttf/IntelOneMono-Italic.ttf') format('truetype');
}

@font-face {
  font-family: 'Intel One Mono';
  font-style: normal;
  font-weight: 500;
  src: url('/static/ttf/IntelOneMono-Medium.ttf') format('truetype');
}

@font-face {
  font-family: 'Intel One Mono';
  font-style: italic;
  font-weight: 500;
  src: url('/static/ttf/IntelOneMono-MediumItalic.ttf') format('truetype');
}

@font-face {
  font-family: 'Intel One Mono';
  font-style: normal;
  font-weight: 700;
  src: url('/static/ttf/IntelOneMono-Bold.ttf') format('truetype');
}

@font-face {
  font-family: 'Intel One Mono';
  font-style: italic;
  font-weight: 700;
  src: url('/static/ttf/IntelOneMono-BoldItalic.ttf') format('truetype');
}

@font-face {
  font-family: 'Intel One Mono';
  font-style: normal;
  font-weight: 300;
  src: url('/static/ttf/IntelOneMono-Light.ttf') format('truetype');
}

@font-face {
  font-family: 'Intel One Mono';
  font-style: italic;
  font-weight: 300;
  src: url('/static/ttf/IntelOneMono-LightItalic.ttf') format('truetype');
}
        |]
    Html -> Html
H.script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
src AttributeValue
"https://cdn.tailwindcss.com?plugins=forms,typography,aspect-ratio,container-queries" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
""
    Html -> Html
H.script
      (Html -> Html) -> (Text -> Html) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
text
      (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ [trimming|
      tailwind.config = {
        theme: {
          container: { center: true },
          fontFamily: {
            sans: ['Liberation Sans', 'sans-serif'],
            serif: ['Liberation Serif', 'serif'],
            mono: ['Intel One Mono', 'monospace']
          },
        }
      }                              
    |]

simplePage :: (MonadIO m) => Env -> ViewVars -> SimplePageTitle -> Html -> m Html
simplePage :: forall (m :: * -> *).
MonadIO m =>
Env -> ViewVars -> SimplePageTitle -> Html -> m Html
simplePage Env
env ViewVars
vv SimplePageTitle
title' Html
body' = do
  Html
sharedHead <- Env -> ViewVars -> SimplePageTitle -> m Html
forall (m :: * -> *).
MonadIO m =>
Env -> ViewVars -> SimplePageTitle -> m Html
mkSharedHead Env
env ViewVars
vv SimplePageTitle
title'
  Html -> m Html
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html -> m Html) -> Html -> m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.html (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html
sharedHead
    ViewVars -> Html -> Html
bodyWithFooter ViewVars
vv (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Maybe Text -> ViewVars -> Html
sharedPageTop Maybe Text
forall a. Maybe a
Nothing ViewVars
vv
      (Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"text-center", Text
"my-4"]) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        (Html -> Html
H.h2 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"text-xl", Text
"text-slate-600", Text
"font-mono", Text
"font-bold"]) (Html -> Html) -> (Text -> Html) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
text (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ SimplePageTitle
title' SimplePageTitle -> Optic' An_Iso NoIx SimplePageTitle Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx SimplePageTitle Text
#value
      Html
body'

paginationOffsetJS :: Text -> Text -> Text
paginationOffsetJS :: Text -> Text -> Text
paginationOffsetJS Text
offset' Text
newOffset =
  [trimming|(function(){
                 if(/offset/.test(window.location.toString())){
                     window.location = window.location.toString()
                       .replace("offset=$offset'", "offset=$newOffset");
                   }else{
                     window.location = window.location + "?offset=$newOffset";
                   }
                 })
                 ()|]

maybeNextPaginationButton :: ViewVars -> Limit -> Offset -> Int -> Html
maybeNextPaginationButton :: ViewVars -> Limit -> Offset -> Int -> Html
maybeNextPaginationButton ViewVars
_ Limit
_ Offset
_ Int
0 = () -> Html
forall a. a -> MarkupM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
maybeNextPaginationButton ViewVars
_ (Limit Int
0) Offset
_ Int
_ = () -> Html
forall a. a -> MarkupM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
maybeNextPaginationButton ViewVars
vv (Limit Int
limit) (Offset Int
offset) Int
itemSize =
  Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
itemSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
limit)
    (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.button
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Set Text -> Attribute
css (ViewVars -> Set Text
cssButton ViewVars
vv)
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onclick (Text -> AttributeValue
textToAttrValue (Text -> AttributeValue)
-> (Text -> Text) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
minify (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
paginationOffsetJS Text
offset' Text
newOffset)
    (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"("
    Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
pageNum
    Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
") next page >"
  where
    offset' :: Text
offset' = Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
offset
    newOffset :: Text
newOffset = Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
limit
    pageNum :: Html
pageNum = Int -> Html
forall b a. (Show a, IsString b) => a -> b
show (Int -> Html) -> Int -> Html
forall a b. (a -> b) -> a -> b
$ (Int
offset Int -> Int -> Int
forall a. Integral a => a -> a -> a
`Principium.div` Int
limit) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    minify :: Text -> Text
minify =
      Text -> Text -> Text -> Text
replaceText
        Text
"\n"
        Text
""

maybePrevPaginationButton :: ViewVars -> Limit -> Offset -> Int -> Html
maybePrevPaginationButton :: ViewVars -> Limit -> Offset -> Int -> Html
maybePrevPaginationButton ViewVars
_ (Limit Int
0) Offset
_ Int
_ = () -> Html
forall a. a -> MarkupM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
maybePrevPaginationButton ViewVars
vv (Limit Int
limit) (Offset Int
offset) Int
_ =
  Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
    (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.button
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Set Text -> Attribute
css (ViewVars -> Set Text
cssButton ViewVars
vv)
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onclick (Text -> AttributeValue
textToAttrValue (Text -> AttributeValue)
-> (Text -> Text) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
minify (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
paginationOffsetJS Text
offset' Text
newOffset)
    (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"< previous page ("
    Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
pageNum
    Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
")"
  where
    offset' :: Text
offset' = Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
offset
    newOffset :: Text
newOffset = Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
limit
    pageNum :: Html
pageNum = Int -> Html
forall b a. (Show a, IsString b) => a -> b
show (Int -> Html) -> Int -> Html
forall a b. (a -> b) -> a -> b
$ (Int
offset Int -> Int -> Int
forall a. Integral a => a -> a -> a
`Principium.div` Int
limit) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    minify :: Text -> Text
minify = Text -> Text -> Text -> Text
replaceText Text
"\n" Text
""