{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Handler.Utils.Table.Pagination.Types
  ( FilterKey, SortingKey
  , Sortable(..)
  , sortable
  , ToSortable(..)
  , SortableP(..)
  , DBTableInvalid(..)
  ) where

import Import hiding (singleton)

import Colonnade
import Colonnade.Encode

import Data.CaseInsensitive (CI)

import Data.Aeson (FromJSON, ToJSON, FromJSONKey, ToJSONKey)


newtype FilterKey = FilterKey { _unFilterKey :: CI Text }
  deriving (Show, Read, Generic)
  deriving newtype (Ord, Eq, PathPiece, IsString, FromJSON, ToJSON, FromJSONKey, ToJSONKey)
newtype SortingKey = SortingKey { _unSortingKey :: CI Text }
  deriving (Show, Read, Generic)
  deriving newtype (Ord, Eq, PathPiece, IsString, FromJSON, ToJSON, FromJSONKey, ToJSONKey)


data Sortable a = Sortable
  { sortableKey :: Maybe SortingKey
  , sortableContent :: a
  }

sortable :: Maybe SortingKey -> c -> (a -> c) -> Colonnade Sortable a c
sortable k h = singleton (Sortable k h)

instance Headedness Sortable where
  headednessPure = Sortable Nothing
  headednessExtract = Just $ \(Sortable _ x) -> x
  headednessExtractForall = Just $ ExtractForall (\(Sortable _ x) -> x)

instance Functor Sortable where
  fmap f Sortable{..} = Sortable { sortableContent = f sortableContent, .. }
                                                 
newtype SortableP s = SortableP { toSortable :: forall a. s a -> Sortable a}

class Headedness s => ToSortable s where
  pSortable :: Maybe (SortableP s)

instance ToSortable Sortable where
  pSortable = Just $ SortableP id

instance ToSortable Headed where
  pSortable = Just $ SortableP (\(Headed x) -> Sortable Nothing x)

instance ToSortable Headless where
  pSortable = Nothing


data DBTableInvalid = DBTIRowsMissing Int
  deriving (Eq, Ord, Read, Show, Generic, Typeable)

instance Exception DBTableInvalid

embedRenderMessage ''UniWorX ''DBTableInvalid id
