make less inefficient
- do all filters in one go - do all post lists in one run of the program - only write files if they are changed (so make repeats less work) - simplify pandoc command for meta pages (this might not actually make a difference)
This commit is contained in:
parent
0385c3215b
commit
5a94aae932
13 changed files with 187 additions and 167 deletions
33
Makefile
33
Makefile
|
@ -25,12 +25,10 @@ OUTPUT = $(OUTPUTPOSTS) $(OUTPUTSTYLE)
|
|||
|
||||
ALL_TAGS = $(TMPDIR)/all-tags
|
||||
POST_LISTS = $(TMPDIR)/post-lists
|
||||
NICE_DATE = $(TMPDIR)/nice-date
|
||||
SLUG_TAGS = $(TMPDIR)/slug-tags
|
||||
FIXFIGS = $(TMPDIR)/fix-figures
|
||||
COMBO_FILTER = $(TMPDIR)/combo-filter
|
||||
EXECS = \
|
||||
$(LAANTAS_SCRIPT) \
|
||||
$(ALL_TAGS) $(POST_LISTS) $(NICE_DATE) $(SLUG_TAGS) $(FIXFIGS)
|
||||
$(ALL_TAGS) $(POST_LISTS) $(COMBO_FILTER)
|
||||
|
||||
CABAL_FLAGS ?= -O
|
||||
|
||||
|
@ -44,10 +42,6 @@ all: build
|
|||
.PHONY: build
|
||||
build: $(EXECS) $(OUTPUT)
|
||||
|
||||
|
||||
LANGFILTER != cabal list-bin langfilter
|
||||
LAANTAS_SCRIPT != cabal list-bin laantas-script
|
||||
|
||||
POSTDEPS = \
|
||||
$(TEMPLATEDIR)/* \
|
||||
$(SYNTAXFILES) acm.csl quox.bib
|
||||
|
@ -59,7 +53,7 @@ build: $(BUILDDIR)/all-tags.html
|
|||
include $(TMPDIR)/tags.mk
|
||||
|
||||
$(BUILDDIR)/%.html: $(POSTSDIR)/%.md $(POSTDEPS) ; $(call pandoc,post.html)
|
||||
$(BUILDDIR)/%.html: $(TMPDIR)/%.md $(POSTDEPS) ; $(call pandoc,meta.html)
|
||||
$(BUILDDIR)/%.html: $(TMPDIR)/%.md $(POSTDEPS) ; $(call pandoc-simple,meta.html)
|
||||
|
||||
$(BUILDDIR)/rss.xml: $(TMPDIR)/index.md $(POSTDEPS)
|
||||
$(call pandoc,rss.xml,--metadata-file rss.yaml --write html)
|
||||
|
@ -73,18 +67,23 @@ define pandoc
|
|||
@echo "[pandoc] $(subst $(TMPDIR)/,,$(subst $(BUILDDIR)/,,$@))"
|
||||
mkdir -p $(dir $@)
|
||||
mkdir -p $(basename $@)
|
||||
LAANTAS_SCRIPT="$(LAANTAS_SCRIPT)" LANG_COLOR="currentcolor" \
|
||||
DIRNAME="$(basename $@)" \
|
||||
FILENAME="$@" \
|
||||
LANG_COLOR="currentcolor" \
|
||||
pandoc -s --toc --toc-depth=2 --template $(TEMPLATEDIR)/$(1) -o $@ $< \
|
||||
-f markdown+emoji $(2) \
|
||||
-M filename=$(subst $(BUILDDIR)/,,$@) --metadata-file=rss.yaml \
|
||||
$(SYNTAXFLAGS) \
|
||||
--filter $(LANGFILTER) --filter $(NICE_DATE) --filter $(SLUG_TAGS) \
|
||||
--filter $(FIXFIGS) \
|
||||
$(SYNTAXFLAGS) --filter $(COMBO_FILTER) \
|
||||
--mathml --citeproc --csl=apa-eu.csl
|
||||
endef
|
||||
|
||||
# $(1): template file
|
||||
define pandoc-simple
|
||||
@echo "[pandoc] $(subst $(TMPDIR)/,,$(subst $(BUILDDIR)/,,$@))"
|
||||
mkdir -p $(dir $@)
|
||||
mkdir -p $(basename $@)
|
||||
pandoc -s --template $(TEMPLATEDIR)/$(1) -o $@ $< \
|
||||
-M filename=$(subst $(BUILDDIR)/,,$@) --metadata-file=rss.yaml
|
||||
endef
|
||||
|
||||
|
||||
$(BUILDDIR)/%: $(POSTSDIR)/% ; $(call copy)
|
||||
$(BUILDDIR)/%: $(TMPDIR)/% ; $(call copy)
|
||||
|
@ -101,9 +100,7 @@ BLOG_META_DEPS != find blog-meta -type f
|
|||
|
||||
$(ALL_TAGS): $(BLOG_META_DEPS) ; $(call cabal-exe,blog-meta:)
|
||||
$(POST_LISTS): $(BLOG_META_DEPS) ; $(call cabal-exe,blog-meta:)
|
||||
$(NICE_DATE): $(BLOG_META_DEPS) ; $(call cabal-exe,blog-meta:)
|
||||
$(SLUG_TAGS): $(BLOG_META_DEPS) ; $(call cabal-exe,blog-meta:)
|
||||
$(FIXFIGS): $(BLOG_META_DEPS) ; $(call cabal-exe,blog-meta:)
|
||||
$(COMBO_FILTER): $(BLOG_META_DEPS) ; $(call cabal-exe,blog-meta:)
|
||||
|
||||
define cabal-exe
|
||||
@echo "[build] $(notdir $@)"
|
||||
|
|
|
@ -1,20 +1,19 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
module Main (main) where
|
||||
|
||||
import qualified Data.ByteString.Lazy as LazyBS
|
||||
import Data.ByteString.Lazy qualified as LazyBS
|
||||
import Data.Foldable
|
||||
import Data.Function ((&))
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Data.Set qualified as Set
|
||||
import Data.Text (Text)
|
||||
import Data.Text qualified as Text
|
||||
import Misc
|
||||
import qualified System.FilePath.Find as Find
|
||||
import YAML ((##=), (.!=), (.:))
|
||||
import qualified YAML
|
||||
import System.Environment
|
||||
import qualified Data.Text.IO as Text
|
||||
import qualified Data.Text as Text
|
||||
import System.FilePath.Find qualified as Find
|
||||
import YAML ((##=), (.!=), (.:))
|
||||
import YAML qualified
|
||||
|
||||
|
||||
-- |
|
||||
|
@ -33,8 +32,8 @@ main = do
|
|||
Opts {dir, yaml, make} <- getOptions
|
||||
files <- Find.findL True (pure True) (Find.extension Find.==? ".md") dir
|
||||
tags <- traverse getTags files
|
||||
LazyBS.writeFile yaml $ makeYAML tags
|
||||
Text.writeFile make $ makeMake tags
|
||||
writeIfDifferentBS yaml $ makeYAML tags
|
||||
writeIfDifferentT make $ makeMake tags
|
||||
|
||||
-- | reads tags from a single file
|
||||
getTags :: FilePath -> IO (Set Text)
|
||||
|
@ -90,21 +89,18 @@ makeYAML tags = "---\n" <> yaml <> "\n...\n" where
|
|||
-- @find@ returns)
|
||||
-- * @POST_LISTS@ (path to the @post-lists@ executable)
|
||||
makeMake :: [Set Text] -> Text
|
||||
makeMake tags' = Text.unlines $ build : allPosts : map makeRule tags where
|
||||
makeMake tags' = Text.unlines $ [build, postLists] where
|
||||
build = Text.unwords $
|
||||
"build:" : ["$(BUILDDIR)/" <> t <> ".html" | t <- map slug' tags]
|
||||
makeRule' opt title file =
|
||||
"$(TMPDIR)/" <> file <> ".md : $(POSTS) $(POST_LISTS)\n\
|
||||
\\t@echo \"[post-lists] " <> file <> "\"\n\
|
||||
\\t$(POST_LISTS) " <> opt <> " --out $@ \\\n\
|
||||
\\t $(POSTSDIR) \"" <> title <> "\""
|
||||
allPosts = makeRule' "" "all posts" "index"
|
||||
makeRule t =
|
||||
makeRule' ("--tag \"" <> name t <> "\"")
|
||||
("posts tagged ‘" <> name t <> "’")
|
||||
(slug' t)
|
||||
postLists =
|
||||
Text.unwords (target' "index" : map target tags)
|
||||
<> " &: $(POSTS) $(POST_LISTS)\n\
|
||||
\\t@echo \"[post-lists] <tag files>\"\n\
|
||||
\\t$(POST_LISTS) $(POSTSDIR) $(TMPDIR)"
|
||||
slug' (Tag {slug}) = "tag-" <> slug
|
||||
tags = collate tags'
|
||||
target' name = "$(TMPDIR)/" <> name <> ".md"
|
||||
target = target' . slug'
|
||||
|
||||
-- | info about a tag
|
||||
data Tag =
|
||||
|
|
|
@ -18,11 +18,13 @@ common deps
|
|||
build-depends:
|
||||
base >= 4.14.2.0 && < 4.21,
|
||||
mtl,
|
||||
transformers,
|
||||
HsYAML ^>= 0.2.1.0,
|
||||
bytestring ^>= 0.11.4.0,
|
||||
containers ^>= 0.6.4.1,
|
||||
filemanip,
|
||||
filepath ^>= 1.4.2.1,
|
||||
directory ^>= 1.3.8.3,
|
||||
pandoc-types ^>= 1.23,
|
||||
text >= 2 && < 2.2,
|
||||
time ^>= 1.9.3
|
||||
|
@ -31,7 +33,7 @@ common deps
|
|||
ghc-options: -Wall
|
||||
|
||||
common exe
|
||||
build-depends: blog-meta
|
||||
build-depends: blog-meta, langfilter
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
|
||||
library
|
||||
|
@ -39,7 +41,10 @@ library
|
|||
hs-source-dirs: lib
|
||||
exposed-modules:
|
||||
YAML,
|
||||
Misc
|
||||
Misc,
|
||||
SlugTags,
|
||||
FixFigures,
|
||||
NiceDate
|
||||
|
||||
executable post-lists
|
||||
import: deps, exe
|
||||
|
@ -51,17 +56,7 @@ executable all-tags
|
|||
hs-source-dirs: .
|
||||
main-is: all-tags.hs
|
||||
|
||||
executable nice-date
|
||||
executable combo-filter
|
||||
import: deps, exe
|
||||
hs-source-dirs: .
|
||||
main-is: nice-date.hs
|
||||
|
||||
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
|
||||
main-is: combo-filter.hs
|
||||
|
|
12
blog-meta/combo-filter.hs
Normal file
12
blog-meta/combo-filter.hs
Normal file
|
@ -0,0 +1,12 @@
|
|||
import FixFigures
|
||||
import LangFilter
|
||||
import NiceDate
|
||||
import SlugTags
|
||||
import Text.Pandoc.JSON
|
||||
import Text.Pandoc.Walk
|
||||
|
||||
main :: IO ()
|
||||
main = toJSONFilter $
|
||||
langFilter "currentcolor" .
|
||||
walk (niceDate . slugTags) .
|
||||
walk fixFigures
|
|
@ -1,15 +0,0 @@
|
|||
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
|
21
blog-meta/lib/FixFigures.hs
Normal file
21
blog-meta/lib/FixFigures.hs
Normal file
|
@ -0,0 +1,21 @@
|
|||
module FixFigures (fixFigures, expandable, shaped) where
|
||||
|
||||
import Text.Pandoc.Definition
|
||||
|
||||
fixFigures :: Block -> Block
|
||||
fixFigures = expandable . shaped
|
||||
|
||||
expandable :: Block -> Block
|
||||
expandable (Figure attr@(_, cs, _) cap [Plain img@[Image _ _ t]])
|
||||
| "expandable" `elem` cs = Figure attr cap $ [Plain [Link blank img t]]
|
||||
expandable b = b
|
||||
|
||||
shaped :: Block -> Block
|
||||
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
|
||||
|
||||
blank :: Attr
|
||||
blank = ("", [], [("target", "_blank")])
|
|
@ -1,12 +1,16 @@
|
|||
module Misc where
|
||||
|
||||
import qualified System.Console.GetOpt as GetOpt
|
||||
import Control.Monad
|
||||
import Data.ByteString.Lazy qualified as LazyBS
|
||||
import Data.Char (isAlphaNum, isAscii, toLower)
|
||||
import Data.Text (Text)
|
||||
import Data.Text qualified as Text
|
||||
import Data.Text.IO qualified as Text
|
||||
import Data.Time
|
||||
import System.Console.GetOpt qualified as GetOpt
|
||||
import System.Directory qualified as Dir
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import Data.Text (Text)
|
||||
import Data.Time
|
||||
import qualified Data.Text as Text
|
||||
import Data.Char (isAlphaNum, isAscii, toLower)
|
||||
import Text.Pandoc.Definition
|
||||
|
||||
-- | exception on 'Left'
|
||||
|
@ -97,3 +101,15 @@ rssDate (ID d) =
|
|||
showDate :: IsoDate -> Text
|
||||
showDate (ID d) =
|
||||
Text.pack $ toLower <$> formatTime defaultTimeLocale "%a %-d %B %Y" d
|
||||
|
||||
writeIfDifferentBS :: FilePath -> LazyBS.ByteString -> IO ()
|
||||
writeIfDifferentBS fn content = do
|
||||
exists <- Dir.doesFileExist fn
|
||||
old <- if exists then Just <$> LazyBS.readFile fn else pure Nothing
|
||||
unless (old == Just content) $ LazyBS.writeFile fn content
|
||||
|
||||
writeIfDifferentT :: FilePath -> Text -> IO ()
|
||||
writeIfDifferentT fn content = do
|
||||
exists <- Dir.doesFileExist fn
|
||||
old <- if exists then Just <$> Text.readFile fn else pure Nothing
|
||||
unless (old == Just content) $ Text.writeFile fn content
|
||||
|
|
27
blog-meta/lib/NiceDate.hs
Normal file
27
blog-meta/lib/NiceDate.hs
Normal file
|
@ -0,0 +1,27 @@
|
|||
module NiceDate (niceDate) where
|
||||
|
||||
import Text.Pandoc.Definition
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Misc
|
||||
import Control.Monad.Writer
|
||||
import Data.Monoid
|
||||
|
||||
niceDate :: Meta -> Meta
|
||||
niceDate (Meta m) =
|
||||
let (res', mdate) = run $ Map.alterF reformat' "date" m
|
||||
res = maybe m (\d -> Map.insert "date-iso" d res') mdate in
|
||||
Meta res
|
||||
|
||||
type T = Writer (Alt Maybe MetaValue)
|
||||
|
||||
run :: T a -> (a, Maybe MetaValue)
|
||||
run = fmap getAlt . runWriter
|
||||
|
||||
reformat' :: Maybe MetaValue -> T (Maybe MetaValue)
|
||||
reformat' Nothing = pure Nothing
|
||||
reformat' (Just d) = do tell $ pure d; pure $ reformat d
|
||||
|
||||
reformat :: MetaValue -> Maybe MetaValue
|
||||
reformat (toText -> Just txt) =
|
||||
MetaString . showDate <$> parseIsoDate txt
|
||||
reformat _ = Nothing
|
20
blog-meta/lib/SlugTags.hs
Normal file
20
blog-meta/lib/SlugTags.hs
Normal file
|
@ -0,0 +1,20 @@
|
|||
module SlugTags (slugTags) where
|
||||
|
||||
import Text.Pandoc.Definition
|
||||
import qualified Data.Map.Strict as Map
|
||||
-- import Text.Pandoc.JSON
|
||||
import Data.Text (Text)
|
||||
import Misc
|
||||
|
||||
slugTags :: Meta -> Meta
|
||||
slugTags (Meta m) = Meta $ Map.adjust addSlugs "tags" m
|
||||
|
||||
-- | if @tags@ exists and is a list of strings, add the slugs. if it exists and
|
||||
-- is something else, explode
|
||||
addSlugs :: MetaValue -> MetaValue
|
||||
addSlugs (toTextList -> Just tags) = MetaList $ map addSlug1 tags
|
||||
addSlugs t = error $ "'tags' is\n" <> show t <> "\nwanted a list of strings"
|
||||
|
||||
addSlug1 :: Text -> MetaValue
|
||||
addSlug1 tag = MetaMap $ Map.fromList
|
||||
[("name", MetaString tag), ("slug", MetaString $ makeSlug tag)]
|
|
@ -1,27 +0,0 @@
|
|||
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 \(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
|
||||
|
||||
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"
|
|
@ -1,15 +1,21 @@
|
|||
import qualified Data.ByteString.Lazy as LazyBS
|
||||
import Data.ByteString.Lazy qualified as LazyBS
|
||||
import Data.Function ((&))
|
||||
import Data.List (sortBy)
|
||||
import Data.Ord (comparing)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Text qualified as Text
|
||||
import Misc
|
||||
import qualified YAML
|
||||
import System.FilePath qualified as Path
|
||||
import System.FilePath.Find qualified as Find
|
||||
import YAML ((.:), (.:?), (.!=), (##=))
|
||||
import qualified System.Console.GetOpt as GetOpt
|
||||
import qualified System.FilePath.Find as Find
|
||||
import qualified System.FilePath as Path
|
||||
import YAML qualified
|
||||
import System.Environment
|
||||
import System.IO
|
||||
import System.Exit
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import System.FilePath
|
||||
import Data.Foldable
|
||||
|
||||
-- | generates a yaml list for a list of posts; either for a given tag, or all
|
||||
-- posts. the posts are in chronological order, newest first.
|
||||
|
@ -40,18 +46,29 @@ import qualified System.FilePath as Path
|
|||
main :: IO ()
|
||||
main = do
|
||||
Opts {..} <- getOptions
|
||||
files <- Find.findL True (pure True) (Find.extension Find.==? ".md") dir
|
||||
infos <- filter (checkTag tag) <$> traverse (getInfo dir) files
|
||||
files <- Find.findL True (pure True) (Find.extension Find.==? ".md") indir
|
||||
infos <- traverse (getInfo indir) files
|
||||
for_ (allTags infos) \tag -> do
|
||||
let title = "pages tagged ‘" <> tag <> "’"
|
||||
let basename = "tag-" <> Text.unpack (makeSlug tag) <.> "md"
|
||||
let tagged = filter (checkTag $ Just tag) infos
|
||||
makeTagInfo tagged title basename outdir
|
||||
makeTagInfo infos "all posts" "index.md" outdir
|
||||
|
||||
makeTagInfo :: [PostInfo] -> Text -> String -> FilePath -> IO ()
|
||||
makeTagInfo infos title basename outdir = do
|
||||
let content = makeContent title infos
|
||||
case out of
|
||||
Nothing -> LazyBS.putStr content
|
||||
Just fn -> LazyBS.writeFile fn content
|
||||
let filename = outdir </> basename
|
||||
writeIfDifferentBS filename content
|
||||
|
||||
makeContent :: Text -> [PostInfo] -> LazyBS.ByteString
|
||||
makeContent title is' = "---\n" <> YAML.encode1 val <> "...\n" where
|
||||
is = sortBy (flip $ comparing date) is'
|
||||
val = YAML.obj [("title" ##= title), ("posts" ##= is)]
|
||||
|
||||
allTags :: Foldable t => t PostInfo -> Set Text
|
||||
allTags = foldMap (Set.fromList . tags)
|
||||
|
||||
|
||||
-- | whether a post has the given tag
|
||||
checkTag :: Maybe Text -> PostInfo -> Bool
|
||||
|
@ -63,33 +80,22 @@ checkTag (Just t) i = t `elem` tags i
|
|||
data Options =
|
||||
Opts {
|
||||
-- | first argument: directory containing the .md files
|
||||
dir :: !FilePath,
|
||||
-- | second argument: title for the output page
|
||||
title :: !Text,
|
||||
-- | @-t, --tag@: filter by tag
|
||||
tag :: !(Maybe Text),
|
||||
-- | @-o, --out@: write output to file (otherwise stdout)
|
||||
out :: !(Maybe FilePath)
|
||||
indir :: !FilePath,
|
||||
-- | second argument: write output to file
|
||||
outdir :: !FilePath
|
||||
}
|
||||
|
||||
getOptions :: IO Options
|
||||
getOptions = getOptionsWith hdr defOpts optDescrs where
|
||||
hdr prog = "usage: " <> prog <> " [OPTION...] DIR TITLE\n\
|
||||
\ --- get info about posts in DIR and use given title"
|
||||
|
||||
optDescrs :: [GetOpt.OptDescr (Options -> Options)]
|
||||
optDescrs =
|
||||
[GetOpt.Option "t" ["tag"]
|
||||
(GetOpt.ReqArg (\t o -> o {tag = Just $ Text.pack t}) "TAG")
|
||||
"list only posts with the given tag",
|
||||
GetOpt.Option "o" ["out"]
|
||||
(GetOpt.ReqArg (\f o -> o {out = Just f}) "FILE")
|
||||
"write output to FILE"]
|
||||
|
||||
defOpts :: [String] -> Maybe Options
|
||||
defOpts [dir, Text.pack -> title] =
|
||||
Just $ Opts {dir, title, tag = Nothing, out = Nothing}
|
||||
defOpts _ = Nothing
|
||||
getOptions = do
|
||||
prog <- getProgName
|
||||
args <- getArgs
|
||||
case args of
|
||||
[indir, outdir] -> pure $ Opts {..}
|
||||
_ -> do
|
||||
hPutStrLn stderr $
|
||||
"usage: " <> prog <> " INDIR OUTDIR\n\
|
||||
\ --- collect tags in posts in INDIR into yaml files in OUTDIR"
|
||||
exitFailure
|
||||
|
||||
|
||||
-- | the front matter info we care about
|
||||
|
|
|
@ -1,28 +0,0 @@
|
|||
import Text.Pandoc.Definition
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Text.Pandoc.JSON
|
||||
import Data.Text (Text)
|
||||
import Misc
|
||||
|
||||
-- | adds the slugs to the tags in a post
|
||||
--
|
||||
-- the fact this program doesn't look at @all-tags.md@ is the reason clashing
|
||||
-- slugs blow up instead of doing something better. i'll just rename one tag,
|
||||
-- it's fine.
|
||||
main :: IO ()
|
||||
main = toJSONFilter \(Pandoc (Meta m) body) -> do
|
||||
m' <- Map.alterF addSlugs "tags" m
|
||||
pure $ Pandoc (Meta m') body
|
||||
|
||||
-- | if @tags@ exists and is a list of strings, add the slugs. if it exists and
|
||||
-- is something else, explode
|
||||
addSlugs :: Maybe MetaValue -> IO (Maybe MetaValue)
|
||||
addSlugs Nothing = pure Nothing
|
||||
addSlugs (Just (toTextList -> Just tags)) =
|
||||
pure $ Just $ MetaList $ map addSlug1 tags
|
||||
addSlugs (Just t) = fail $
|
||||
"'tags' is\n" <> show t <> "\nwanted a list of strings"
|
||||
|
||||
addSlug1 :: Text -> MetaValue
|
||||
addSlug1 tag = MetaMap $ Map.fromList
|
||||
[("name", MetaString tag), ("slug", MetaString $ makeSlug tag)]
|
|
@ -4,13 +4,13 @@ packages:
|
|||
source-repository-package
|
||||
type: git
|
||||
location: https://git.rhiannon.website/rhi/lang.git
|
||||
tag: e8d46973fac634d8ee589697e19cf0cc2c39ce00
|
||||
tag: ed54ec4c5af5b2b8ea25f0274e11c2f8c87714c3
|
||||
subdir: langfilter
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://git.rhiannon.website/rhi/lang.git
|
||||
tag: e8d46973fac634d8ee589697e19cf0cc2c39ce00
|
||||
tag: ed54ec4c5af5b2b8ea25f0274e11c2f8c87714c3
|
||||
subdir: laantas-script
|
||||
|
||||
source-repository-package
|
||||
|
|
Loading…
Add table
Reference in a new issue