diff --git a/make-pages/Info.hs b/make-pages/Info.hs
index 063c57c..c78a5e2 100644
--- a/make-pages/Info.hs
+++ b/make-pages/Info.hs
@@ -5,6 +5,8 @@ module Info
Day (..), Text)
where
+import Records
+
import Data.YAML (FromYAML (..), (.:), (.:?), (.!=))
import qualified Data.YAML as YAML
import Data.Time.Calendar (Day (..))
@@ -52,6 +54,11 @@ data Link =
}
deriving (Eq, Show)
+instance HasField "nsfw" Info Bool where getField = all #nsfw . #images
+instance HasField "sfw" Info Bool where getField = not . #nsfw
+instance HasField "sfw" Image Bool where getField = not . #nsfw
+instance HasField "sfw" Link Bool where getField = not . #nsfw
+
instance FromYAML Info where
parseYAML = YAML.withMap "info" \m ->
diff --git a/make-pages/Records.hs b/make-pages/Records.hs
new file mode 100644
index 0000000..245e773
--- /dev/null
+++ b/make-pages/Records.hs
@@ -0,0 +1,12 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE
+ FlexibleInstances, InstanceSigs, MultiParamTypeClasses, ScopedTypeVariables,
+ TypeApplications
+ #-}
+module Records (HasField (..)) where
+
+import GHC.Records
+import GHC.OverloadedLabels
+
+instance HasField x r a => IsLabel x (r -> a) where
+ fromLabel = getField @x
diff --git a/make-pages/SinglePage.hs b/make-pages/SinglePage.hs
index 56b4424..00d84b7 100644
--- a/make-pages/SinglePage.hs
+++ b/make-pages/SinglePage.hs
@@ -1,5 +1,6 @@
module SinglePage (make) where
+import Records ()
import Info hiding (Text)
import BuildVar
@@ -57,11 +58,13 @@ make' nsfw (Info {date, title, tags, nsfwTags,
|]
where
- titleTag = ifJust title \t -> [b|
$*t|]
+ titleTag = ifJust title \t -> [b|$*t|]
titleHeader = ifJust title \t -> [b|$*t
|]
+
formattedDate = formatDate date
+
buttonBar = makeButtonBar (fromMaybe path0 title) nsfw images
- path0 = let Image {path} = head images in path
+ path0 = #path $ head images
descSection = ifJust description makeDesc
tagsList = makeTags nsfw tags nsfwTags
@@ -96,9 +99,8 @@ makeButtonBar title nsfw allImages =
|]
where
images | nsfw = allImages
- | otherwise = filter (\Image {nsfw} -> not nsfw) allImages
- iimages = zip [0..] images
- alts = map (uncurry altButton) iimages
+ | otherwise = filter #sfw allImages
+ alts = map (uncurry altButton) $ zip [0..] images
altButton :: Int -> Image -> Builder
altButton i (Image {label, path, nsfw}) = [b|@6
@@ -145,8 +147,7 @@ extLinks nsfw allLinks =
|]
where
- links | nsfw = allLinks
- | otherwise = filter (\Link {nsfw} -> not nsfw) allLinks
+ links = if nsfw then allLinks else filter #sfw allLinks
linkList = map extLink links
extLink :: Link -> Builder
diff --git a/make-pages/make-pages.cabal b/make-pages/make-pages.cabal
index 29064ec..9a76ed1 100644
--- a/make-pages/make-pages.cabal
+++ b/make-pages/make-pages.cabal
@@ -9,15 +9,17 @@ maintainer: Rhiannon Morris
executable make-pages
hs-source-dirs: .
main-is: Main.hs
- other-modules: Info, SinglePage, BuildVar
+ other-modules: Info, SinglePage, BuildVar, Records
default-language: Haskell2010
default-extensions:
BlockArguments,
+ DataKinds,
DeriveAnyClass,
DerivingStrategies,
DuplicateRecordFields,
LambdaCase,
NamedFieldPuns,
+ OverloadedLabels,
OverloadedStrings,
PatternSynonyms,
QuasiQuotes,