module Yesod.Contrib.League.Crud.Sort
( Sort(..)
, Sorts(..)
, SortC
, ToEntityField
, cancelLink
, cancelSort
, getSorts
, isSortedBy
, sortIndicator
, sortToSelectOpt
, sortsQuery
, sortsToSelectOpts
, toggleLink
, toggleSort
) where
import ClassyPrelude
import Data.String.Utils (split)
import Database.Persist
import Yesod.Contrib.League.Crud
import Yesod.Core
import Safe (toEnumMay)
data Sort k =
Sort { sortKey :: k
, sortAsc :: Bool
}
deriving (Eq, Show)
instance Enum k => Enum (Sort k) where
fromEnum (Sort k True) = fromEnum k + 1
fromEnum (Sort k False) = (fromEnum k + 1)
toEnum i = Sort (toEnum (abs i 1)) (i > 0)
instance Bounded k => Bounded (Sort k) where
minBound = Sort maxBound False
maxBound = Sort maxBound True
newtype Sorts k =
Sorts { sortsList :: [Sort k] }
deriving (Eq, Show)
type SortC k = (Eq k, Enum k, Bounded k)
type ToEntityField k f = forall a. k -> (forall t. EntityField f t -> a) -> a
getSorts :: (SortC k, Crud sub) => CrudM sub (Sorts k)
getSorts = decodeSorts . maybe "" unpack <$> lookupGetParam "s"
encodeSorts :: SortC k => Sorts k -> String
encodeSorts = intercalate "." . map (show . fromEnum) . sortsList
decodeSorts :: SortC k => String -> Sorts k
decodeSorts = Sorts . catMaybes . map readEnumMay . split "."
readEnumMay :: SortC k => String -> Maybe k
readEnumMay s = readMay s >>= toEnumMay
sortToSelectOpt :: ToEntityField k f -> Sort k -> SelectOpt f
sortToSelectOpt f (Sort c True) = f c Asc
sortToSelectOpt f (Sort c False) = f c Desc
sortsToSelectOpts :: ToEntityField k f -> Sorts k -> [SelectOpt f]
sortsToSelectOpts f = map (sortToSelectOpt f) . sortsList
sortsQuery :: SortC k => Sorts k -> [(Text, Text)]
sortsQuery s =
if null e then [] else [("s", pack e)]
where e = encodeSorts s
toggleSort :: SortC k => k -> Bool -> Sorts k -> Sorts k
toggleSort k f s =
case isSortedBy k s of
Nothing -> liftSorts (Sort k f :) $ cancelSort k s
Just (_, asc) -> liftSorts (Sort k (not asc) :) $ cancelSort k s
sortEq :: SortC k => k -> Sort k -> Bool
sortEq k (Sort j _) = j == k
cancelSort :: SortC k => k -> Sorts k -> Sorts k
cancelSort k = liftSorts $ filter (not . sortEq k)
liftSorts :: ([Sort j] -> [Sort k]) -> Sorts j -> Sorts k
liftSorts f = Sorts . f . sortsList
isSortedBy :: SortC k => k -> Sorts k -> Maybe (Int, Bool)
isSortedBy k = loop 1 . sortsList
where loop _ [] = Nothing
loop i (Sort j asc : _) | j == k = Just (i, asc)
loop i (_: s) = loop (i+1) s
toggleLink
:: (SortC k, Crud sub)
=> k
-> Bool
-> Sorts k
-> (Route (CrudSubsite sub) -> Route (Site sub))
-> (Route (Site sub), [(Text, Text)])
toggleLink criterion defaultAscending sorts r =
(r CrudListR, sortsQuery (toggleSort criterion defaultAscending sorts))
cancelLink
:: (SortC k, Crud sub)
=> k
-> Sorts k
-> (Route (CrudSubsite sub) -> Route (Site sub))
-> (Route (Site sub), [(Text, Text)])
cancelLink criterion sorts r =
(r CrudListR, sortsQuery (cancelSort criterion sorts))
sortIndicator
:: (SortC k, Crud sub)
=> k
-> Sorts k
-> (Route (CrudSubsite sub) -> Route (Site sub))
-> CrudWidget sub
sortIndicator criterion sorts r =
[whamlet|
$maybe (i,k) <- isSortedBy criterion sorts
<span .crudsorts>
$if k
↑
$else
↓
#{i}
<a href=@?{cancelLink criterion sorts r}>×
|]