content: {- | Support for resource pagination.
  -}
  {-# LANGUAGE DeriveGeneric              #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE RankNTypes                 #-}
  {-# LANGUAGE RecordWildCards            #-}
  
  module Pos.Util.Pagination (
        Page(..)
      , PerPage(..)
      , maxPerPageEntries
      , defaultPerPageEntries
      , PaginationMetadata(..)
      , PaginationParams(..)
      ) where
  
  import           Universum
  
  import           Control.Lens (at, ix, (?~))
  import           Data.Aeson (Value (Number))
  import qualified Data.Aeson.Options as Aeson
  import           Data.Aeson.TH
  import qualified Data.Char as Char
  import           Data.Default
  import           Data.Swagger as S
  import           Formatting (bprint, build, (%))
  import qualified Formatting.Buildable
  import           Test.QuickCheck (Arbitrary (..), choose, getPositive)
  import           Web.HttpApiData
  
  -- | A `Page` is used in paginated endpoints to request access to a particular
  -- subset of a collection.
  newtype Page = Page Int
               deriving (Show, Eq, Ord, Num)
  
  deriveJSON Aeson.defaultOptions ''Page
  
  instance Arbitrary Page where
      arbitrary = Page . getPositive <$> arbitrary
  
  instance FromHttpApiData Page where
      parseQueryParam qp = case parseQueryParam qp of
          Right (p :: Int) | p < 1 -> Left "A page number cannot be less than 1."
          Right (p :: Int)         -> Right (Page p)
          Left e                   -> Left e
  
  instance ToHttpApiData Page where
      toQueryParam (Page p) = fromString (show p)
  
  instance ToSchema Page where
      declareNamedSchema =
          pure . NamedSchema (Just "Page") . paramSchemaToSchema
  
  instance ToParamSchema Page where
      toParamSchema _ = mempty
          & type_ .~ SwaggerInteger
          & default_ ?~ (Number 1) -- Always show the first page by default.
          & minimum_ ?~ 1
  
  -- | If not specified otherwise, return first page.
  instance Default Page where
      def = Page 1
  
  instance Buildable Page where
      build (Page p) = bprint build p
  
  -- | A `PerPage` is used to specify the number of entries which should be returned
  -- as part of a paginated response.
  newtype PerPage = PerPage Int
      deriving (Show, Eq, Num, Ord)
  
  deriveJSON Aeson.defaultOptions ''PerPage
  
  instance ToSchema PerPage where
      declareNamedSchema =
          pure . NamedSchema (Just "PerPage") . paramSchemaToSchema
  
  instance ToParamSchema PerPage where
      toParamSchema _ = mempty
          & type_ .~ SwaggerInteger
          & default_ ?~ (Number $ fromIntegral defaultPerPageEntries)
          & minimum_ ?~ 1
          & maximum_ ?~ (fromIntegral maxPerPageEntries)
  
  -- | The maximum number of entries a paginated request can return on a single call.
  -- This value is currently arbitrary and it might need to be tweaked down to strike
  -- the right balance between number of requests and load of each of them on the system.
  maxPerPageEntries :: Int
  maxPerPageEntries = 50
  
  -- | If not specified otherwise, a default number of 10 entries from the collection will
  -- be returned as part of each paginated response.
  defaultPerPageEntries :: Int
  defaultPerPageEntries = 10
  
  instance Arbitrary PerPage where
      arbitrary = PerPage <$> choose (1, maxPerPageEntries)
  
  instance FromHttpApiData PerPage where
      parseQueryParam qp = case parseQueryParam qp of
          Right (p :: Int) | p < 1 -> Left "per_page should be at least 1."
          Right (p :: Int) | p > maxPerPageEntries ->
                             Left $ fromString $ "per_page cannot be greater than " <> show maxPerPageEntries <> "."
          Right (p :: Int) -> Right (PerPage p)
          Left e           -> Left e
  
  instance ToHttpApiData PerPage where
      toQueryParam (PerPage p) = fromString (show p)
  
  instance Default PerPage where
      def = PerPage defaultPerPageEntries
  
  instance Buildable PerPage where
    build (PerPage p) = bprint build p
  
  -- | Extra information associated with pagination
  data PaginationMetadata = PaginationMetadata
    { metaTotalPages   :: Int     -- ^ The total pages returned by this query.
    , metaPage         :: Page    -- ^ The current page number (index starts at 1).
    , metaPerPage      :: PerPage -- ^ The number of entries contained in this page.
    , metaTotalEntries :: Int     -- ^ The total number of entries in the collection.
    } deriving (Show, Eq, Generic)
  
  deriveJSON Aeson.defaultOptions ''PaginationMetadata
  
  instance Arbitrary PaginationMetadata where
    arbitrary = PaginationMetadata <$> fmap getPositive arbitrary
                                   <*> arbitrary
                                   <*> arbitrary
                                   <*> fmap getPositive arbitrary
  
  instance ToSchema PaginationMetadata where
      declareNamedSchema proxy = do
          schm <- genericDeclareNamedSchema defaultSchemaOptions
              { S.fieldLabelModifier =
                  over (ix 0) Char.toLower . drop 4 -- length "meta"
              } proxy
          pure $ over schema (over properties adjustPropsSchema) schm
        where
          totalSchema = Inline $ mempty
              & type_ .~ SwaggerNumber
              & minimum_ ?~ 0
              & maximum_ ?~ fromIntegral (maxBound :: Int)
          adjustPropsSchema s = s
              & at "totalPages" ?~ totalSchema
              & at "totalEntries" ?~ totalSchema
  
  instance Buildable PaginationMetadata where
      build PaginationMetadata{..} =
          bprint (build%"/"%build%" total="%build%" per_page="%build)
              metaPage
              metaTotalPages
              metaTotalEntries
              metaPerPage
  
  -- | `PaginationParams` is datatype which combines request params related
  -- to pagination together.
  data PaginationParams = PaginationParams
      { ppPage    :: Page -- ^ Greater than 0.
      , ppPerPage :: PerPage
      } deriving (Show, Eq, Generic)
  
  instance Buildable PaginationParams where
      build PaginationParams{..} =
          bprint ("page=" % build % ", per_page=" % build)
              ppPage
              ppPerPage
  