{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Yesod.Paginator.Prelude
    ( module X
    , module Yesod.Paginator.Prelude
    ) where

import Prelude as X

import Control.Monad as X
import Data.List as X
    (genericDrop, genericLength, genericReplicate, genericTake, nubBy)
import Data.Maybe as X
import Data.Text as X (Text, pack, unpack)
import Numeric.Natural as X
import Safe as X

import Data.Function (on)
import Web.PathPieces

instance PathPiece Natural where
    toPathPiece :: Natural -> Text
toPathPiece = PathPiece Int => Int -> Text
forall s. PathPiece s => s -> Text
toPathPiece @Int (Int -> Text) -> (Natural -> Int) -> Natural -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    fromPathPiece :: Text -> Maybe Natural
fromPathPiece Text
p = do
        Int
n <- Text -> Maybe Int
forall s. PathPiece s => Text -> Maybe s
fromPathPiece @Int Text
p
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
        Natural -> Maybe Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Maybe Natural) -> Natural -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n

tshow :: Show a => a -> Text
tshow :: a -> Text
tshow = String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

nubOn :: Eq b => (a -> b) -> [a] -> [a]
nubOn :: (a -> b) -> [a] -> [a]
nubOn a -> b
f = (a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) (b -> b -> Bool) -> (a -> b) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f)