filter updates & figure fixups

blog-meta/blog-meta.cabal

@@ -6,26 +6,28 @@ author: rhiannon morris <rhi@rhiannon.website>
 maintainer: rhiannon morris <rhi@rhiannon.website>
 
 common deps
-  default-language: Haskell2010
+  default-language: GHC2024
   default-extensions:
     BlockArguments,
     DuplicateRecordFields,
     OverloadedStrings,
     OverloadedLists,
-    NamedFieldPuns,
     NondecreasingIndentation,
     RecordWildCards,
     ViewPatterns
   build-depends:
-    base >= 4.14.2.0 && < 4.18,
+    base >= 4.14.2.0 && < 4.21,
+    mtl,
     HsYAML ^>= 0.2.1.0,
     bytestring ^>= 0.11.4.0,
     containers ^>= 0.6.4.1,
     filemanip,
     filepath ^>= 1.4.2.1,
     pandoc-types ^>= 1.23,
-    text ^>= 1.2.4.1,
+    text >= 2 && < 2.2,
     time ^>= 1.9.3
+  build-tool-depends:
+    langfilter:langfilter
   ghc-options: -Wall
 
 common exe
@@ -58,3 +60,8 @@ executable slug-tags
   import: deps, exe
   hs-source-dirs: .
   main-is: slug-tags.hs
+
+executable fix-figures
+  import: deps, exe
+  hs-source-dirs: .
+  main-is: fix-figures.hs

blog-meta/fix-figures.hs

@@ -0,0 +1,15 @@
+import Text.Pandoc.JSON
+
+main :: IO ()
+main = toJSONFilter $ expandable . shaped where
+  expandable (Figure attr@(_, cs, _) cap [Plain img@[Image _ _ t]])
+    | "expandable" `elem` cs = Figure attr cap $ [Plain [Link blank img t]]
+  expandable b = b
+
+  blank = ("", [], [("target", "_blank")])
+
+  shaped (Figure (i, cs, as) cap [Plain img@[Image _ _ (url, _)]])
+    | "shaped" `elem` cs =
+        let shape = "shape-outside: url(" <> url <> ")" in
+        Figure (i, cs, ("style", shape) : as) cap [Plain img]
+  shaped b = b

blog-meta/nice-date.hs

@@ -2,16 +2,26 @@ import Text.Pandoc.Definition
 import qualified Data.Map.Strict as Map
 import Text.Pandoc.JSON
 import Misc
+import Control.Monad.Writer
+import Data.Monoid
 
 -- | replaces the @date@ field, which starts in YYYY-MM-DD format, with
 -- something prettier
 main :: IO ()
-main = toJSONFilter \(Pandoc (Meta m) body) -> do
-  m' <- Map.alterF reformat "date" m
-  pure $ Pandoc (Meta m') body
+main = toJSONFilter \(Meta m) -> do
+  (res', mdate) <- run $ Map.alterF reformat' "date" m
+  let res = maybe m (\d -> Map.insert "date-iso" d res') mdate
+  pure $ Meta res
 
-reformat :: Maybe MetaValue -> IO (Maybe MetaValue)
-reformat Nothing = pure Nothing
-reformat (Just (toText -> Just txt)) =
-  Just . MetaString . showDate <$> parseIsoDate txt
-reformat (Just d) = fail $ "date is\n" <> show d <> "\nwanted a string"
+type T = WriterT (Alt Maybe MetaValue) IO
+
+run :: T a -> IO (a, Maybe MetaValue)
+run = fmap (fmap getAlt) . runWriterT
+
+reformat' :: Maybe MetaValue -> T (Maybe MetaValue)
+reformat' Nothing = pure Nothing
+reformat' (Just d) = do tell $ pure d; Just <$> reformat d
+
+reformat :: MetaValue -> T MetaValue
+reformat (toText -> Just txt) = MetaString . showDate <$> parseIsoDate txt
+reformat d = fail $ "date is\n" <> show d <> "\nwanted a string"

blog-meta/post-lists.hs

@@ -99,6 +99,7 @@ data PostInfo =
     file    :: FilePath,
     title   :: Text,      -- ^ post @title@
     date    :: IsoDate,   -- ^ post @date@
+    dateStr :: Text,      -- ^ post @date@, but as text
     tags    :: [Text],    -- ^ post @tags@
     summary :: Maybe Text -- ^ post @summary@ (optional)
   }
@@ -116,6 +117,7 @@ getInfo dir file = do
       Info <$> pure file'
            <*> m .:  "title"
            <*> m .:  "date"
+           <*> m .:  "date"
            <*> m .:  "tags" .!= []
            <*> m .:? "summary"
 
@@ -123,6 +125,7 @@ instance YAML.ToYAML PostInfo where
   toYAML (Info {..}) = YAML.obj
     ["date"     ##= showDate date,
      "date-rss" ##= rssDate date,
+     "date-iso" ##= dateStr,
      "title"    ##= title,
      "tags"     ##= tags,
      "file"     ##= htmlFile file,

cabal.project

@@ -4,13 +4,13 @@ packages:
 source-repository-package
   type: git
   location: https://git.rhiannon.website/rhi/lang.git
-  tag: 3cd2c59be2195e5b2e79e4a90c80bd6015c1f0bd
+  tag: a7bbfd5035adf67e128e030e3ba47c6fb8ed3be5
   subdir: langfilter
 
 source-repository-package
   type: git
   location: https://git.rhiannon.website/rhi/lang.git
-  tag: 3cd2c59be2195e5b2e79e4a90c80bd6015c1f0bd
+  tag: a7bbfd5035adf67e128e030e3ba47c6fb8ed3be5
   subdir: laantas-script
 
 source-repository-package
@@ -20,10 +20,11 @@ source-repository-package
 
 source-repository-package
   type: git
-  location: https://git.rhiannon.website/rhi/svg-builder
-  tag: 1cbcd594d3009f9fd71f253b52ac82673bf5482e
-
-allow-newer: *
+  location: https://git.rhiannon.website/rhi/svg-builder.git
+  tag: 9c09fcea4ac316dd5e0709b40f85952047070bf1
 
 constraints:
   pandoc-types == 1.23.1
+
+shared: False
+executable-dynamic: False