-
|]
where
- title = fromMaybe (#title info) $ #galleryTitle info
- dir = takeDirectory file
- thumb = getThumb dir info
- nsfw' = if nsfw && #anyNsfw info then [b| nsfw|] else ""
- tags' = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info
- date = #latestDate info nsfw
- date' = formatTooltip date
- year' = #year date
- updated' = if #updated info nsfw then [b|true|] else [b|false|]
- bgStyle = case bg of Other col -> [b| style="background: $col"|]; _ -> ""
- tooltip =
- let upd = if #updated info nsfw then "updated " else "" :: Builder in
- [b|$title ($upd$date')|]
+ title = fromMaybe info.title $ info.galleryTitle
+ dir = takeDirectory file
+ thumbnail = getThumb dir info
+ nsfw' = if nsfw && anyNsfw info then [b| nsfw|] else ""
+ tags' = fold $ intersperse ";" $ map fromText $ tagsFor nsfw info
+ date = latestDateFor nsfw info
+ date' = formatTooltip date
+ year' = date.year
+ updated' = if hasUpdatesFor nsfw info then [b|true|] else [b|false|]
+ bgStyle = case bg of Other col -> [b| style="background: $col"|]; _ -> ""
+ tooltip = [b|$title ($upd$date')|]
+ where upd = if hasUpdatesFor nsfw info then "updated " else "" :: Builder
diff --git a/make-pages/Info.hs b/make-pages/Info.hs
index b8eb425..a74901b 100644
--- a/make-pages/Info.hs
+++ b/make-pages/Info.hs
@@ -3,20 +3,31 @@
{-# OPTIONS_GHC -Wno-orphans #-}
module Info
(Info (..),
- tagsFor, descFor, imagesFor, linksFor, updatesFor, lastUpdate,
+ anySfw, anyNsfw, allSfw, allNsfw,
+ allImages, sfwImages, nsfwImages,
+ thumb, latestDateFor, latestYearFor,
+ sfwLinks, nsfwLinks, sfwUpdates, nsfwUpdates,
+ updatesFor, hasUpdatesFor, lastUpdateFor,
+ tagsFor, descFor, imagesFor, linksFor,
+
CompareKey (..), compareKeyFor, compareFor, sortFor,
+
Artist (..), Images' (..), Images, Image (..), Desc (..), DescField (..),
+
Link (..), Update (..), Bg (..),
+
GalleryInfo (..), GalleryFilters (..), ArtistFilter (..), NsfwFilter (..),
- IndexInfo (..),
readArtistFilter, matchArtist, readNsfwFilter, matchNsfw, matchFilters,
+
+ IndexInfo (..),
+
NoThumb (..), getThumb, thumbFile, pageFile, bigFile,
-- ** Reexports
Date (..), Day (..), Text, NonEmpty (..))
where
import Date
-import Records
+import GHC.Records
import Control.Applicative
import Control.Monad
@@ -38,7 +49,6 @@ import qualified Data.Text as Text
import Data.YAML (FromYAML (..), (.:), (.:?), (.!=))
import qualified Data.YAML as YAML
import System.FilePath ((>), takeBaseName, takeExtension, splitExtension)
-import Data.Bifunctor (second)
import Data.Semigroup
@@ -49,7 +59,7 @@ data Info =
-- e.g. multiple things on the same day might have a,b,c in @sortEx@ to
-- put them in the right order in the gallery
sortEx :: !Text,
- updates :: ![(Date, [Update])],
+ updates :: ![(Date, NonEmpty Update)],
-- | if false, don't show updated emblem even if @updates@ is non-empty
showUpdated :: !Bool,
-- | hide from gallery view
@@ -123,13 +133,13 @@ data Update =
}
deriving (Eq, Ord, Show)
-instance HasField "sfw" Image Bool where getField = not . #nsfw
-instance HasField "sfw" Link Bool where getField = not . #nsfw
-instance HasField "sfw" Update Bool where getField = not . #nsfw
+instance HasField "sfw" Image Bool where getField i = not i.nsfw
+instance HasField "sfw" Link Bool where getField i = not i.nsfw
+instance HasField "sfw" Update Bool where getField i = not i.nsfw
-instance HasField "all" (Images' a) (NonEmpty a) where
- getField (Uncat is) = is
- getField (Cat cats) = sconcat $ fmap snd cats
+allImages :: Images' a -> NonEmpty a
+allImages (Uncat is) = is
+allImages (Cat cats) = sconcat $ fmap snd cats
filterNE :: (a -> Bool) -> NonEmpty a -> Maybe (NonEmpty a)
filterNE p = nonEmpty . filter p . toList
@@ -142,45 +152,51 @@ filterImages p (Uncat is) = Uncat <$> filterNE p is
filterImages p (Cat cats) =
fmap Cat $ catMaybesNE $ fmap (traverse $ filterNE p) cats
-instance HasField "sfwImages" Info (Maybe Images) where
- getField = filterImages #sfw . #images
-instance HasField "nsfwImages" Info (Maybe Images) where
- getField = filterImages #nsfw . #images
-instance HasField "anySfw" Info Bool where getField = isJust . #sfwImages
-instance HasField "anyNsfw" Info Bool where getField = isJust . #nsfwImages
-instance HasField "allNsfw" Info Bool where getField = not . #anySfw
-instance HasField "allSfw" Info Bool where getField = not . #anyNsfw
+sfwImages, nsfwImages :: Info -> Maybe Images
+sfwImages i = filterImages (.sfw) i.images
+nsfwImages i = filterImages (.nsfw) i.images
-instance HasField "sfwLinks" Info [Link] where
- getField = filter #sfw . #links
-instance HasField "nsfwLinks" Info [Link] where
- getField = filter #nsfw . #links
+anySfw, anyNsfw, allSfw, allNsfw :: Info -> Bool
+anySfw = isJust . sfwImages
+anyNsfw = isJust . nsfwImages
+allSfw = not . anyNsfw
+allNsfw = not . anySfw
-instance HasField "sfwUpdates" Info [(Date, [Update])] where
- getField = filter (not . null) . map (second (filter #sfw)) . #updates
-instance HasField "nsfwUpdates" Info [(Date, [Update])] where
- getField = filter (not . null) . map (second (filter #nsfw)) . #updates
+sfwLinks, nsfwLinks :: Info -> [Link]
+sfwLinks i = filter (.sfw) i.links
+nsfwLinks i = filter (.nsfw) i.links
-instance HasField "thumb" Info (Maybe FilePath) where
- getField (Info {thumb', images}) =
- thumb' <|> #path <$> find #sfw (#all images)
+updatesWith :: (Update -> Bool) -> Info -> [(Date, NonEmpty Update)]
+updatesWith p i = mapMaybe (traverse $ filterNE p) i.updates
-instance HasField "mine" Info Bool where getField = isNothing . #artist
-instance HasField "notMine" Info Bool where getField = isJust . #artist
+updatesFor :: Bool -> Info -> [(Date, NonEmpty Update)]
+updatesFor nsfw = updatesWith \u -> nsfw || u.sfw
-instance HasField "latestDate" Info (Bool -> Date) where
- getField info@(Info {date=date₀}) nsfw =
- maximum $ date₀ : mapMaybe relDate (updatesFor nsfw info)
- where
- relDate (date, us) = date <$ guard (not $ null us || any #ignoreSort us)
+sfwUpdates, nsfwUpdates :: Info -> [(Date, NonEmpty Update)]
+sfwUpdates = updatesWith (.sfw)
+nsfwUpdates = updatesWith (.nsfw)
-instance HasField "latestYear" Info (Bool -> Int) where
- getField info nsfw = #year $ #latestDate info nsfw
+lastUpdateFor :: Bool -> Info -> Maybe Date
+lastUpdateFor nsfw info = case updatesFor nsfw info of
+ [] -> Nothing
+ us -> Just $ fst $ last us
-instance HasField "updated" Info (Bool -> Bool) where
- getField (Info {updates, showUpdated}) nsfw = showUpdated && updated where
- updated = if nsfw then not $ null updates else any (any #sfw . snd) updates
+thumb :: Info -> Maybe FilePath
+thumb (Info {thumb', images}) =
+ thumb' <|> (.path) <$> find (.sfw) (allImages images)
+
+latestDateFor :: Bool -> Info -> Date
+latestDateFor nsfw i = maximum $ i.date : mapMaybe relDate (updatesFor nsfw i)
+ where
+ relDate (date, us) = date <$ guard (not $ null us || any (.ignoreSort) us)
+
+latestYearFor :: Bool -> Info -> Int
+latestYearFor nsfw info = (latestDateFor nsfw info).year
+
+
+hasUpdatesFor :: Bool -> Info -> Bool
+hasUpdatesFor i nsfw = not $ null $ updatesFor i nsfw
defDescKey :: Text
defDescKey = "about"
@@ -202,8 +218,8 @@ merge fs1 fs2 = go fs1 [] fs2 where
Nothing -> go first (x:unused) xs
insert [] _ = Nothing
insert (x:xs) y =
- if #name x == #name y then
- Just $ x {text = #text x <> #text y} : xs
+ if x.name == y.name then
+ Just $ x {text = x.text <> y.text} : xs
else
(x :) <$> insert xs y
@@ -218,26 +234,19 @@ descFor :: Bool -> Info -> Desc
descFor nsfw (Info {desc, nsfwDesc}) = if nsfw then desc <> nsfwDesc else desc
tagsFor :: Bool -> Info -> [Text]
-tagsFor nsfw i = if nsfw then nub (#tags i <> #nsfwTags i) else #tags i
+tagsFor nsfw i = if nsfw then nub $ i.tags <> i.nsfwTags else i.tags
imagesFor :: Bool -> Info -> Maybe Images
-imagesFor nsfw = if nsfw then Just . #images else #sfwImages
+imagesFor nsfw i = if nsfw then Just i.images else sfwImages i
linksFor :: Bool -> Info -> [Link]
-linksFor nsfw = if nsfw then #links else #sfwLinks
-
-updatesFor :: Bool -> Info -> [(Date, [Update])]
-updatesFor nsfw = if nsfw then #updates else #sfwUpdates
-
-lastUpdate :: Bool -> Info -> Maybe Date
-lastUpdate nsfw info =
- case updatesFor nsfw info of [] -> Nothing; us -> Just $ fst $ last us
+linksFor nsfw i = if nsfw then i.links else sfwLinks i
data CompareKey = MkCompareKey !Date !Text !Text
deriving (Eq, Ord)
compareKeyFor :: Bool -> Info -> CompareKey
-compareKeyFor nsfw i = MkCompareKey (#latestDate i nsfw) (#sortEx i) (#title i)
+compareKeyFor nsfw i = MkCompareKey (latestDateFor nsfw i) i.sortEx i.title
compareFor :: Bool -> Info -> Info -> Ordering
compareFor nsfw = comparing $ compareKeyFor nsfw
@@ -252,7 +261,7 @@ instance Show NoThumb where show (NoThumb dir) = "no thumbnail for " ++ dir
getThumb :: FilePath -> Info -> FilePath
getThumb dir =
- maybe (throw $ NoThumb dir) (\t -> dir > thumbFile t) . #thumb
+ maybe (throw $ NoThumb dir) (\t -> dir > thumbFile t) . thumb
thumbFile :: FilePath -> FilePath
thumbFile = addSuffix "_small"
@@ -385,9 +394,11 @@ instance FromYAML Link where
pure $ Link {title, url, nsfw}
-updateList :: Maybe (YAML.Node YAML.Pos) -> YAML.Parser [(Date, [Update])]
+updateList :: Maybe (YAML.Node YAML.Pos) ->
+ YAML.Parser [(Date, NonEmpty Update)]
updateList =
- maybe (pure []) $ YAML.withMap "updates" $ traverse bodies . Map.toList
+ maybe (pure []) $ YAML.withMap "updates" $
+ nonEmptys <=< traverse bodies . Map.toList
where
bodies (date', rest) = (,) <$> parseYAML date' <*> body rest
body b =
@@ -402,6 +413,8 @@ updateList =
nsfw <- m .:? "nsfw" .!= False
ignoreSort <- m .:? "ignore-sort" .!= False
pure $ Update {desc, nsfw, ignoreSort}
+ nonEmptys = traverse $ traverse $
+ maybe (fail "expected non-empty list") pure . nonEmpty
data GalleryInfo =
@@ -415,7 +428,7 @@ data GalleryInfo =
deriving (Eq, Show)
instance HasField "nsfw" GalleryInfo Bool where
- getField g = #nsfw (#filters g) /= NoNsfw
+ getField g = g.filters.nsfw /= NoNsfw
data GalleryFilters =
GalleryFilters {
@@ -434,8 +447,8 @@ readNsfwFilter "all" = pure AllN
readNsfwFilter _ = empty
matchNsfw :: NsfwFilter -> Info -> Bool
-matchNsfw NoNsfw i = #anySfw i && not (#nsfwOnly i)
-matchNsfw OnlyNsfw i = #anyNsfw i
+matchNsfw NoNsfw i = anySfw i && not i.nsfwOnly
+matchNsfw OnlyNsfw i = anyNsfw i
matchNsfw AllN _ = True
instance FromYAML NsfwFilter where
@@ -452,9 +465,9 @@ readArtistFilter "all" = pure AllA
readArtistFilter _ = empty
matchArtist :: ArtistFilter -> Info -> Bool
-matchArtist Me = #mine
-matchArtist NotMe = #notMine
-matchArtist AllA = const True
+matchArtist Me i = isNothing i.artist
+matchArtist NotMe i = isJust i.artist
+matchArtist AllA _ = True
noFilters :: GalleryFilters
noFilters =
@@ -465,7 +478,7 @@ matchFilters (GalleryFilters {nsfw, artist, require, exclude}) i =
matchNsfw nsfw i && matchArtist artist i &&
all (\t -> HashSet.member t tags) require &&
all (\t -> not $ HashSet.member t tags) exclude
- where tags = HashSet.fromList $ #tags i
+ where tags = HashSet.fromList i.tags
instance FromYAML GalleryInfo where
diff --git a/make-pages/Main.hs b/make-pages/Main.hs
index 22d6e7d..0c4ca25 100644
--- a/make-pages/Main.hs
+++ b/make-pages/Main.hs
@@ -48,7 +48,7 @@ main = do
main2 :: HasVerbose => ModeOptions -> IO ()
main2 (SinglePage {root, file, prefix, index, dataDir, nsfw, output}) = do
- siteName <- #title <$> readYAML @IndexInfo index
+ siteName <- (.title) <$> readYAML @IndexInfo index
info <- readYAML file
printV $ "contents" := info
let dir = takeDirectory $ makeRelative dataDir file
@@ -121,7 +121,7 @@ galleryFromIndex :: FilePath -> FilePath -> IO GalleryInfo
galleryFromIndex file prefix = do
IndexInfo {galleries} <- readYAML file
maybe (fail $ "no gallery with prefix " ++ prefix) pure $
- List.find (\g -> #prefix g == prefix) galleries
+ List.find (\g -> g.prefix == prefix) galleries
decode1Must :: YAML.FromYAML a => FilePath -> ByteString -> IO a
decode1Must file txt =
diff --git a/make-pages/RSS.hs b/make-pages/RSS.hs
index f9b1f97..8a75604 100644
--- a/make-pages/RSS.hs
+++ b/make-pages/RSS.hs
@@ -3,7 +3,6 @@ module RSS (make, make') where
import Date
import Info
import BuilderQQ
-import Records ()
import Data.List (sortBy)
import Data.Maybe (isJust)
@@ -38,10 +37,10 @@ make' root ginfo@(GalleryInfo {title, desc, prefix}) output infos = [b|@0
|]
where
link = [b|$root/$prefix|]
- nsfw = #nsfw ginfo
+ nsfw = ginfo.nsfw
items = map (uncurry $ makeItem root prefix nsfw) $
- sortBy (flip (compareFor nsfw `on` #second)) $
- filter (not . #unlisted . snd) infos
+ sortBy (flip (compareFor nsfw `on` snd)) $
+ filter (not . (.unlisted) . snd) infos
selflink = case output of
Nothing -> ""
Just o -> [b||]
@@ -57,7 +56,7 @@ makeItem root prefix nsfw path i@(Info {title, artist}) = [b|@4
|]
where
- up = if #updated i nsfw then [b| (updated)|] else ""
+ up = if hasUpdatesFor nsfw i then [b| (updated)|] else ""
dir = takeDirectory path
link = [b|$root/$prefix/$dir|]
artist' = ifJust artist \case
@@ -65,7 +64,7 @@ makeItem root prefix nsfw path i@(Info {title, artist}) = [b|@4
Artist {name, url = Just url} -> [b|
by $name|]
desc = descFor nsfw i
desc' = makeDesc desc
- descArtist' = if #exists desc || isJust artist then [b|@6
+ descArtist' = if desc.exists || isJust artist then [b|@6
|]
else ""
- date = formatRSS $ #latestDate i nsfw
+ date = formatRSS $ latestDateFor nsfw i
makeDesc :: Desc -> Builder
makeDesc NoDesc = ""
diff --git a/make-pages/Records.hs b/make-pages/Records.hs
deleted file mode 100644
index 4f804b6..0000000
--- a/make-pages/Records.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-{-# OPTIONS_GHC -Wno-orphans #-}
-module Records (HasField (..)) where
-
-import GHC.Records
-import GHC.OverloadedLabels
-
-instance HasField x r a => IsLabel x (r -> a) where
- fromLabel = getField @x
-
-
-instance HasField "first" (a, b) a where getField (x, _) = x
-instance HasField "second" (a, b) b where getField (_, y) = y
-
-instance HasField "first" (a, b, c) a where getField (x, _, _) = x
-instance HasField "second" (a, b, c) b where getField (_, y, _) = y
-instance HasField "third" (a, b, c) c where getField (_, _, z) = z
-
-instance HasField "first" (a, b, c, d) a where getField (x, _, _, _) = x
-instance HasField "second" (a, b, c, d) b where getField (_, y, _, _) = y
-instance HasField "third" (a, b, c, d) c where getField (_, _, z, _) = z
-instance HasField "fourth" (a, b, c, d) d where getField (_, _, _, w) = w
diff --git a/make-pages/SinglePage.hs b/make-pages/SinglePage.hs
index a75ddfb..98e2b03 100644
--- a/make-pages/SinglePage.hs
+++ b/make-pages/SinglePage.hs
@@ -4,7 +4,6 @@ module SinglePage (make) where
import Date
import Info
import BuilderQQ
-import Records ()
import qualified NsfwWarning
import Control.Exception
@@ -17,6 +16,7 @@ import System.FilePath (joinPath, splitPath)
import qualified Data.HashSet as Set
import Data.Traversable
import Data.Semigroup
+import Data.List.NonEmpty (toList)
-- | e.g. only nsfw images are present for a non-nsfw page
@@ -51,7 +51,7 @@ make' root siteName prefix nsfw _dataDir dir
let buttonBar = makeButtonBar title $ addIds images
- let image0 :| otherImages = #all images
+ let image0 :| otherImages = allImages images
let Image {path = path0, download = download0'} = image0
let download0 = fromMaybe (bigFile path0) download0'
@@ -79,9 +79,9 @@ make' root siteName prefix nsfw _dataDir dir
if you can let me know i'd appreciate it
|]
let warning'
- | Just w <- #warning image0 = makeWarning w
- | #nsfw image0 = makeWarning defWarning
- | otherwise = mempty
+ | Just w <- image0.warning = makeWarning w
+ | image0.nsfw = makeWarning defWarning
+ | otherwise = mempty
let warningT = makeWarning [b|.|]
let bgStyle = case bg of
@@ -103,7 +103,7 @@ make' root siteName prefix nsfw _dataDir dir
let desc = case artist of
Just (Artist {name}) -> [b|by $name|]
Nothing -> "by niss"
- let thumb = getThumb "" info
+ let thumbnail = getThumb "" info
let updateDate = ifJust (last' updates) \(d, _) ->
let updated = formatLong d in
@@ -114,12 +114,12 @@ make' root siteName prefix nsfw _dataDir dir
let nsfwDialog = NsfwWarning.dialog nsfw'
let imageMeta =
- if #sfw image0 && isNothing (#warning image0) then [b|@0
+ if image0.sfw && isNothing image0.warning then [b|@0
|] else [b|@0
-
+
|]
@@ -249,7 +249,7 @@ addIds = snd . mapAccumL makeId Set.empty where
makeId used img = (Set.insert newId used, (img, newId)) where
newId = headI $ filterI (\i -> not $ i `Set.member` used) ids
ids = fmap (\i -> toStrictText [b|$label$i|]) suffixes
- label = escId $ #label img
+ label = escId $ img.label
pattern One :: a -> NonEmpty a
@@ -287,7 +287,7 @@ makeButtonBar title images =
|]
where elems = fmap (uncurry altButton) imgs
skipAll =
- if any (isJust . #warning . fst) images then
+ if any (isJust . (.warning) . fst) images then
[b|@0