{-# 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
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
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
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
""