{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Handler.Utils.Table.Pagination.Types
  ( FilterKey(FilterKey), SortingKey(SortingKey)
  , Sortable(..), _sortableKey, _sortableContent
  , sortable
  , ToSortable(..), FromSortable(..)
  , SortableP(..)
  , IsSortable, _Sortable
  , DBTableInvalid(..)
  , AsCornice(..)
  ) where

import Import hiding (singleton)

import Colonnade
import Colonnade.Encode

{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}

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
  }

makeLenses_ ''Sortable

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


class FromSortable s where
  fromSortable :: forall a. Sortable a -> s a

instance FromSortable Sortable where
  fromSortable = id

instance FromSortable Headed where
  fromSortable Sortable{..} = Headed sortableContent

instance FromSortable Headless where
  fromSortable _ = Headless


type IsSortable h = (ToSortable h, FromSortable h)

_Sortable :: IsSortable h => Prism' (h a) (Sortable a)
_Sortable = prism' fromSortable $ \x -> ($ x) . toSortable <$> pSortable


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

instance Exception DBTableInvalid

embedRenderMessage ''UniWorX ''DBTableInvalid id


class AsCornice h (p :: Pillar) a c x | x -> h p a c where
  _Cornice :: Iso' x (Cornice h p a c)

instance AsCornice h p a c (Cornice h p a c) where
  _Cornice = id

instance AsCornice h 'Base a c (Colonnade h a c) where
  _Cornice = iso CorniceBase $ \(CorniceBase c) -> c
