add nsfw warning dialog

make-pages/GalleryPage.hs

@@ -4,6 +4,7 @@ module GalleryPage (make) where
 import BuilderQQ
 import Date
 import Info
+import qualified NsfwWarning
 
 import Data.Foldable
 import Data.Function (on, (&))
@@ -38,45 +39,50 @@ make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b|@0
     <meta name=twitter:card content=summary>
 
     <script src=/script/gallery.js></script>
+    $0.nsfwScript
 
     <title>$title</title>
 
-    <header>
-      <h1>$title</h1>
-      <h2 class="right corner">
-        <a href=rss.xml>rss</a>
-      </h2>
-    </header>
+    $0.nsfwDialog
 
-    <nav id=filters>
-      <details id=filters-details>
-        <summary><h2>filters</h2></summary>
-        <div>
-          <h3>show only</h3>
-          <ul id=require class="buttonbar bb-choice">
-            $8.requireFilters
-          </ul>
+    <div class=page>
+      <header>
+        <h1>$title</h1>
+        <h2 class="right corner">
+          <a href=rss.xml>rss</a>
+        </h2>
+      </header>
 
-          <h3>exclude</h3>
-          <ul id=exclude class="buttonbar bb-choice">
-            $8.excludeFilters
-          </ul>
+      <nav id=filters>
+        <details id=filters-details>
+          <summary><h2>filters</h2></summary>
+          <div>
+            <h3>show only</h3>
+            <ul id=require class="buttonbar bb-choice">
+              $10.requireFilters
+            </ul>
 
-          <a href=# id=clear>clear</a>
-          <a href=# id=singles>toggle single-use tags</a>
-        </div>
-      </details>
-    </nav>
+            <h3>exclude</h3>
+            <ul id=exclude class="buttonbar bb-choice">
+              $10.excludeFilters
+            </ul>
 
-    <main>
-      <ul class=grid>
-        $4.items
-      </ul>
-    </main>
+            <a href=# id=clear>clear</a>
+            <a href=# id=singles>toggle single-use tags</a>
+          </div>
+        </details>
+      </nav>
 
-    <footer>
-      <a href=$undir>all galleries</a>
-    </footer>
+      <main>
+        <ul class=grid>
+          $6.items
+        </ul>
+      </main>
+
+      <footer>
+        <a href=$undir>all galleries</a>
+      </footer>
+    </div>
   |]
  where
   items = map (uncurry $ makeYearItems nsfw) infosByYear
@@ -106,8 +112,11 @@ make' root (GalleryInfo {title, desc, prefix, filters, hidden}) infos = [b|@0
     | (_, (p0, i0) : _) : _ <- infosByYear = getThumb (takeDirectory p0) i0
     | otherwise                            = "/style/card.png"
 
+  nsfwScript = NsfwWarning.script nsfw
+  nsfwDialog = NsfwWarning.dialog nsfw
+
 makeFilter :: Text -> HashSet Text -> Text -> Int -> Builder
-makeFilter prefix initial tag count = [b|@8
+makeFilter prefix initial tag count = [b|@0
     <li>
       <input type=checkbox id="$id'" value="$tag"$checked>
       <label for="$id'" data-count=$count>$tag</label>
@@ -121,17 +130,17 @@ makeYearItems :: Bool -- ^ nsfw
               -> Int -- ^ year
               -> [(FilePath, Info)]
               -> Builder
-makeYearItems nsfw year infos = [b|@4
+makeYearItems nsfw year infos = [b|@0
     <li class="item year-marker" id="marker-$year">
       <span class=year-text>$year'</span>
-    $4.items
+    $0.items
   |]
  where
   items = map (uncurry $ makeItem nsfw) infos
   year' = show year & foldMap \c -> [b|<span class=y>$c</span>|]
 
 makeItem :: Bool -> FilePath -> Info -> Builder
-makeItem nsfw file info@(Info {title, bg}) = [b|@4
+makeItem nsfw file info@(Info {title, bg}) = [b|@0
     <li class="item post$nsfw'" data-date="$date'" data-year=$year'
         data-updated="$updated'"
         data-tags="$tags'">

make-pages/IndexPage.hs

@@ -27,30 +27,32 @@ make' root (IndexInfo {title, desc, galleries, links, footer}) = [b|@0
 
     <title>$title</title>
 
-    <header>
-      <h1 id=title>$title</h1>
-    </header>
+    <div class=page>
+      <header>
+        <h1 id=title>$title</h1>
+      </header>
 
-    <main>
-      $galleryList
-      $linkList
-    </main>
+      <main>
+        $4.galleryList
+        $4.linkList
+      </main>
 
-    $footer'
+      $2.footer'
+    </div>
   |]
  where
-  galleryList = if null galleries then "" else [b|@2
+  galleryList = if null galleries then "" else [b|@0
       <nav aria-label="gallery list">
         <ul id=gallery-list class=list>
-          $6.items
+          $4.items
         </ul>
       </nav>
     |]
     where items = map makeItem galleries
-  linkList = if null links then "" else [b|@2
+  linkList = if null links then "" else [b|@0
       <nav aria-label="other links">
         <ul id=link-list class=list>
-          $6.items
+          $4.items
         </ul>
       </nav>
     |]
@@ -65,13 +67,13 @@ make' root (IndexInfo {title, desc, galleries, links, footer}) = [b|@0
   url = [b|$root|]
 
 makeItem :: GalleryInfo -> Builder
-makeItem (GalleryInfo {title, desc, prefix, filters}) = [b|@6
+makeItem (GalleryInfo {title, desc, prefix, filters}) = [b|@0
     <li$nsfw><a href=$prefix title="$desc">$title</a></li>
   |]
   where nsfw = if hasNsfw filters then [b| class=nsfw|] else ""
 
 makeLink :: Link -> Builder
-makeLink (Link {title, url, nsfw}) = [b|@6
+makeLink (Link {title, url, nsfw}) = [b|@0
     <li$nsfw'><a href=$url>$title</a>
   |]
   where nsfw' = if nsfw then [b| class=nsfw|] else ""

make-pages/NsfwWarning.hs

@@ -0,0 +1,30 @@
+{-# OPTIONS_GHC -fdefer-typed-holes #-}
+
+module NsfwWarning (script, dialog) where
+
+import BuilderQQ
+
+script :: Bool -> Builder
+script False = ""
+script True  = [b|<script src=/script/nsfw-warning.js></script>|]
+
+dialog :: Bool -> Builder
+dialog False = ""
+dialog True  = [b|@0
+  <div class=dialog id=nsfw-dialog>
+    <div class=dialog-inner>
+      <h1>cw: lewd</h1>
+
+      <img class=dialog-icon src=/style/stop_hand.svg>
+
+      <div class=dialog-message>
+        are you an adult? <br> if not please don't look!
+      </div>
+
+      <div class=dialog-buttons>
+        <button id=nsfw-yes class=yes>yes i am and i wanna see</button>
+        <button id=nsfw-no class=no>no i’m not</button>
+      </div>
+    </div>
+  </div>
+  |]

make-pages/SinglePage.hs

@@ -4,6 +4,7 @@ import Date
 import Info
 import BuilderQQ
 import Records ()
+import qualified NsfwWarning
 
 import Control.Exception
 import qualified Data.Map.Strict as Map
@@ -60,7 +61,7 @@ make' root prefix nsfw dataDir dir
   let makePrefetch (Image {path}) = [b|<link rel=prefetch href=$path>|]
   let prefetches = map (makePrefetch . #first) $ tail images
 
-  let makeWarning w = [b|@4
+  let makeWarning w = [b|@0
         <figcaption id=cw aria-role=button tabindex=0>
           <span id=cw-text>$w</span>
         </figcaption>
@@ -82,6 +83,9 @@ make' root prefix nsfw dataDir dir
   let updateDate = ifJust (Map.lookupMax updates) \(formatLong -> u, _) ->
         [b|<br> <span class=updated>updated $u</span>|]
 
+  let nsfwScript = NsfwWarning.script nsfw
+  let nsfwDialog = NsfwWarning.dialog nsfw
+
   pure [b|@0
     <!DOCTYPE html>
     <html lang=en>
@@ -100,44 +104,49 @@ make' root prefix nsfw dataDir dir
     <meta name=twitter:card content=summary>
 
     <script src=/script/single.js></script>
+    $nsfwScript
     $bgStyle
 
     $0.prefetches
 
     <title>$title</title>
 
-    <header>
-      <h1>$title</h1>
-      $artistTag
-      <h2 id=date class="right corner">
-        $formattedDate $updateDate
-      </h2>
-    </header>
+    $nsfwDialog
 
-    $buttonBar
+    <div class=page>
+      <header>
+        <h1>$title</h1>
+        $artistTag
+        <h2 id=date class="right corner">
+          $formattedDate $updateDate
+        </h2>
+      </header>
 
-    <main>
-      <figure id=mainfig data-width=$width0 data-height=$height0>
-        $warning'
-        <a id=mainlink href="$download0" title="download full version">
-          <img id=mainimg src="$path0'" alt="">
-        </a>
-      </figure>
+      $2.buttonBar
 
-      <div id=info>
-        $descSection
+      <main>
+        <figure id=mainfig data-width=$width0 data-height=$height0>
+          $warning'
+          <a id=mainlink href="$download0" title="download full version">
+            <img id=mainimg src="$path0'" alt="">
+          </a>
+        </figure>
 
-        $tagsList
+        <div id=info>
+          $6.descSection
 
-        $linksList
+          $6.tagsList
 
-        $updatesList
-      </div>
-    </main>
+          $6.linksList
 
-    <footer>
-      <a href=$undir>back to gallery</a>
-    </footer>
+          $6.updatesList
+        </div>
+      </main>
+
+      <footer>
+        <a href=$undir>back to gallery</a>
+      </footer>
+    </div>
 
     <template id=cw-template>
       $warningT
@@ -153,11 +162,11 @@ makeArtist (Artist {name, url}) =
     Nothing -> [b|$name|]
 
 makeDesc :: Maybe Strict.Text -> Builder
-makeDesc mdesc = ifJust mdesc \desc -> [b|@4
+makeDesc mdesc = ifJust mdesc \desc -> [b|@0
     <section id=desc class=info-section>
       <h2>about</h2>
       <div>
-        $8.desc
+        $4.desc
       </div>
     </section>
   |]
@@ -177,7 +186,7 @@ makeButtonBar title images =
  where alts = map (\(i, (im, sz)) -> altButton i im sz) $ zip [0..] images
 
 altButton :: Int -> Image -> Size -> Builder
-altButton i (Image {label, path, nsfw, warning}) (Size {width, height}) = [b|@4
+altButton i (Image {label, path, nsfw, warning}) (Size {width, height}) = [b|@0
   <li$nsfwClass>
     <input type=radio$checked name=variant id="$idLabel" value="$path'"
            data-link="$path"$warning'
@@ -194,11 +203,11 @@ altButton i (Image {label, path, nsfw, warning}) (Size {width, height}) = [b|@4
 
 makeTags :: FilePath -> [Strict.Text] -> Builder
 makeTags undir tags =
-  if null tags then "" else [b|@4
+  if null tags then "" else [b|@0
     <nav id=tags class=info-section>
       <h2>tags</h2>
       <ul class="buttonbar bb-links">
-        $8.tagList
+        $4.tagList
       </ul>
     </nav>
   |]
@@ -209,11 +218,11 @@ makeTags undir tags =
 
 extLinks :: [Link] -> Builder
 extLinks links =
-  if null links then "" else [b|@4
+  if null links then "" else [b|@0
     <nav id=links class=info-section>
       <h2>links</h2>
       <ul class="buttonbar bb-links">
-        $8.linkList
+        $4.linkList
       </ul>
     </nav>
   |]

make-pages/make-pages.cabal

@@ -15,16 +15,17 @@ executable make-pages
   main-is: Main.hs
   other-modules:
     BuilderQQ,
-    Date,
-    Depend,
-    GalleryPage,
-    Info,
-    IndexPage,
-    ListTags,
-    Options,
     Records,
+    Date,
+    Info,
+    Depend,
+    NsfwWarning,
+    GalleryPage,
+    IndexPage,
     SinglePage,
-    RSS
+    RSS,
+    ListTags,
+    Options
   default-language: Haskell2010
   default-extensions:
     BlockArguments,