{-# OPTIONS_GHC -Wno-missing-role-annotations #-}

module Dashi.Components.Pagination where

import Clay hiding (Color, action, button, disabled, href, icon, label, span_)
import Clay qualified
import Dashi.Components.Button (Button (..), ButtonSize (..))
import Dashi.Components.Button qualified as Button
import Dashi.Components.Icon
    ( Icon (..)
    , Phosphor (..)
    , Weight (..)
    , iconContent
    , iconFontFamilyOverride
    )
import Dashi.Components.Util (ariaCurrent_)
import Dashi.Prelude hiding ((#), (&), (|>))
import Dashi.Style.Text (TextColour (TextColour))
import Dashi.Style.Tokens
import Dashi.Style.Util (ariaCurrent, color')
import Miso.Html.Element (div_, span_)
import Miso.Html.Property (class_, disabled_)

data Pagination action = Pagination
    { forall action. Pagination action -> Int
pages :: Int
    , forall action. Pagination action -> Int
currentPage :: Int
    , forall action. Pagination action -> Int -> action
onPageSelect :: Int -> action
    }

instance Widget (Pagination action) model action where
    widget' :: [Attribute action] -> Pagination action -> View model action
widget' [Attribute action]
attrs Pagination{Int
Int -> action
pages :: forall action. Pagination action -> Int
currentPage :: forall action. Pagination action -> Int
onPageSelect :: forall action. Pagination action -> Int -> action
pages :: Int
currentPage :: Int
onPageSelect :: Int -> action
..} =
        [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
div_ (MisoString -> Attribute action
forall action. MisoString -> Attribute action
class_ MisoString
"pagination" Attribute action -> [Attribute action] -> [Attribute action]
forall a. a -> [a] -> [a]
: [Attribute action]
attrs)
            ([View model action] -> View model action)
-> [View model action] -> View model action
forall a b. (a -> b) -> a -> b
$ [[View model action]] -> [View model action]
forall a. Monoid a => [a] -> a
mconcat
                [ View model action -> [View model action]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (View model action -> [View model action])
-> (Int -> View model action) -> Int -> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe Icon -> Int -> View model action
button (Icon -> Maybe Icon
forall a. a -> Maybe a
Just (Icon -> Maybe Icon) -> Icon -> Maybe Icon
forall a b. (a -> b) -> a -> b
$ Weight -> Phosphor -> Icon
Icon Weight
Bold Phosphor
ArrowLeft) (Int -> [View model action]) -> Int -> [View model action]
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
pred Int
currentPage
                , [View model action]
pageButtons
                , View model action -> [View model action]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (View model action -> [View model action])
-> (Int -> View model action) -> Int -> [View model action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Maybe Icon -> Int -> View model action
button (Icon -> Maybe Icon
forall a. a -> Maybe a
Just (Icon -> Maybe Icon) -> Icon -> Maybe Icon
forall a b. (a -> b) -> a -> b
$ Weight -> Phosphor -> Icon
Icon Weight
Bold Phosphor
ArrowRight) (Int -> [View model action]) -> Int -> [View model action]
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
succ Int
currentPage
                ]
      where
        pageButtons :: [View model action]
        pageButtons :: [View model action]
pageButtons
            | Int
pages Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = []
            | Int
pages Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7 = Int -> View model action
page (Int -> View model action) -> [Int] -> [View model action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. Int
pages]
            | Int
currentPage Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5 = (Int -> View model action
page (Int -> View model action) -> [Int] -> [View model action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. Int
5]) [View model action] -> [View model action] -> [View model action]
forall a. Semigroup a => a -> a -> a
<> [View model action
ellipsis, Int -> View model action
page Int
pages]
            | Int
currentPage Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pages Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4 =
                [Int -> View model action
page Int
1, View model action
ellipsis] [View model action] -> [View model action] -> [View model action]
forall a. Semigroup a => a -> a -> a
<> (Int -> View model action
page (Int -> View model action) -> [Int] -> [View model action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
pages Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4 .. Int
pages])
            | Bool
otherwise =
                [Int -> View model action
page Int
1, View model action
ellipsis]
                    [View model action] -> [View model action] -> [View model action]
forall a. Semigroup a => a -> a -> a
<> (Int -> View model action
page (Int -> View model action) -> [Int] -> [View model action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
currentPage Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 .. Int
currentPage Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1])
                    [View model action] -> [View model action] -> [View model action]
forall a. Semigroup a => a -> a -> a
<> [View model action
ellipsis, Int -> View model action
page Int
pages]
        ellipsis :: View model action
        ellipsis :: View model action
ellipsis = [Attribute action] -> [View model action] -> View model action
forall action model.
[Attribute action] -> [View model action] -> View model action
span_ [MisoString -> Attribute action
forall action. MisoString -> Attribute action
class_ MisoString
"ellipsis"] []
        page :: Int -> View model action
page = Maybe Icon -> Int -> View model action
button Maybe Icon
forall a. Maybe a
Nothing
        button :: Maybe Icon -> Int -> View model action
        button :: Maybe Icon -> Int -> View model action
button Maybe Icon
icon Int
page' =
            let
                current, disabled :: Bool
                current :: Bool
current = Int
page' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
currentPage
                disabled :: Bool
disabled = Int
page' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
page' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pages
             in
                forall w model action.
Widget w model action =>
[Attribute action] -> w -> View model action
widget' @(Button model action)
                    ([Bool -> Attribute action
forall action. Bool -> Attribute action
ariaCurrent_ Bool
True | Bool
current] [Attribute action] -> [Attribute action] -> [Attribute action]
forall a. Semigroup a => a -> a -> a
<> [Attribute action
forall action. Attribute action
disabled_ | Bool
disabled])
                    Button
                        { size :: ButtonSize
size = ButtonSize
DefaultSize
                        , appearance :: Appearance
appearance = Appearance
Default
                        , label :: [View model action]
label = [View model action
-> (Icon -> View model action) -> Maybe Icon -> View model action
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MisoString -> View model action
forall model action. MisoString -> View model action
text (MisoString -> View model action)
-> (Int -> MisoString) -> Int -> View model action
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString (Int -> View model action) -> Int -> View model action
forall a b. (a -> b) -> a -> b
$ Int
page') Icon -> View model action
forall w model action.
Widget w model action =>
w -> View model action
widget Maybe Icon
icon]
                        , onClick :: Maybe action
onClick =
                            if Bool
current Bool -> Bool -> Bool
|| Bool
disabled
                                then Maybe action
forall a. Maybe a
Nothing
                                else action -> Maybe action
forall a. a -> Maybe a
Just (Int -> action
onPageSelect Int
page')
                        }
    style :: Css
style =
        Selector
".pagination" Selector -> Css -> Css
? do
            Display -> Css
display Display
flex
            FlexDirection -> Css
flexDirection FlexDirection
row
            Selector
Clay.button Selector -> Css -> Css
? do
                Appearance -> Css
Button.appearanceStyle Appearance
Subtle
                ButtonSize -> Css
Button.sizeStyle ButtonSize
IconButton
                Size LengthUnit -> Css
forall a. Size a -> Css
minWidth (Size LengthUnit -> Css) -> Size LengthUnit -> Css
forall a b. (a -> b) -> a -> b
$ Number -> Size LengthUnit
em Number
2.5
                Bool -> Refinement
ariaCurrent Bool
True Refinement -> Css -> Css
& do
                    Appearance -> Css
Button.appearanceStyle Appearance
Default
                    TextColour -> Css
forall t. Token t => t -> Css
color' (TextColour -> Css) -> TextColour -> Css
forall a b. (a -> b) -> a -> b
$ Appearance -> TextColour
TextColour Appearance
Primary
            Selector
".ellipsis" Selector -> Css -> Css
? do
                Weight -> Css
iconFontFamilyOverride Weight
Fill
                Refinement
before Refinement -> Css -> Css
& Content -> Css
content (Phosphor -> Content
iconContent Phosphor
DotsThreeOutline)
                TextColour -> Css
forall t. Token t => t -> Css
color' (TextColour -> Css) -> TextColour -> Css
forall a b. (a -> b) -> a -> b
$ Appearance -> TextColour
TextColour Appearance
Subtle
                Size (ZonkAny 0) -> Css
forall a. Size a -> Css
lineHeight (Size (ZonkAny 0) -> Css) -> Size (ZonkAny 0) -> Css
forall a b. (a -> b) -> a -> b
$ Number -> Size (ZonkAny 0)
forall a. Number -> Size a
unitless Number
2
                Size LengthUnit -> Css
forall a. Size a -> Css
width (Size LengthUnit -> Css) -> Size LengthUnit -> Css
forall a b. (a -> b) -> a -> b
$ Number -> Size LengthUnit
em Number
2.3
                Number -> Css
opacity Number
0.7