improve sorting

This commit is contained in:
Rhiannon Morris 2020-07-19 17:55:54 +02:00
parent cacce9d29b
commit 2d1a74ecb5
2 changed files with 14 additions and 8 deletions

View file

@ -1,10 +1,12 @@
{-# LANGUAGE TransformListComp #-}
module GalleryPage (make) where module GalleryPage (make) where
import Control.Exception import Control.Exception
import Data.Function (on, (&)) import Data.Function (on)
import Data.List (sortBy, groupBy) import Data.List (sortOn, groupBy)
import qualified Data.Text.Lazy as Lazy import qualified Data.Text.Lazy as Lazy
import System.FilePath ((</>), takeDirectory) import System.FilePath ((</>), takeDirectory)
import GHC.Exts (Down (..), the)
import BuilderQQ import BuilderQQ
import Depend (thumbFile) import Depend (thumbFile)
@ -42,12 +44,12 @@ make' title nsfw infos = [b|@0
where where
items = map (uncurry $ makeYearItems nsfw) infosByYear items = map (uncurry $ makeYearItems nsfw) infosByYear
infosByYear = infosByYear =
infos & sortBy (cmpInfo `on` #second) [(the year, infopath) |
& map (\fi -> (fi, #year $ #second fi)) infopath@(_, info) <- infos,
& groupBy ((==) `on` #second) then sortOn by Down info,
& map (\ys -> (#second (head ys), map #first ys)) let year = #year info,
cmpInfo (Info {date = d1, title = t1}) (Info {date = d2, title = t2}) = then group by Down year using groupBy']
compare d2 d1 <> compare t1 t2 groupBy' f = groupBy ((==) `on` f)
makeYearItems :: Bool -- ^ nsfw makeYearItems :: Bool -- ^ nsfw
-> Integer -- ^ year -> Integer -- ^ year

View file

@ -15,6 +15,7 @@ import Control.Applicative
import Data.Foldable (find) import Data.Foldable (find)
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Data.Maybe (isJust, isNothing) import Data.Maybe (isJust, isNothing)
import Data.Ord (comparing)
import Data.String (IsString) import Data.String (IsString)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
@ -87,6 +88,9 @@ instance HasField "year" Info Integer where getField = #first . #dmy
instance HasField "month" Info Int where getField = #second . #dmy instance HasField "month" Info Int where getField = #second . #dmy
instance HasField "day" Info Int where getField = #third . #dmy instance HasField "day" Info Int where getField = #third . #dmy
instance Ord Info where
compare = comparing \Info {date, title} -> (date, title)
instance FromYAML Info where instance FromYAML Info where
parseYAML = YAML.withMap "info" \m -> parseYAML = YAML.withMap "info" \m ->