make lántas script color configurable with LANG_COLOR

This commit is contained in:
Rhiannon Morris 2024-06-03 03:33:36 +02:00
parent 22ae984c8a
commit 97c3457744
4 changed files with 44 additions and 18 deletions

View file

@ -38,7 +38,7 @@ $(BUILDDIR)/%.html: $(PAGESDIR)/%.md $(TEMPLATE) $(LANGFILTER) $(LAANTAS_SCRIPT)
@echo "[pandoc] $<"
mkdir -p $(dir $@)
mkdir -p $(basename $@)
LAANTAS_SCRIPT="$(LAANTAS_SCRIPT)" \
LAANTAS_SCRIPT="$(LAANTAS_SCRIPT)" LANG_COLOR="hsl(340deg, 50%, 35%)" \
DIRNAME="$(basename $@)" \
FILENAME="$@" \
pandoc -s --toc --template $(TEMPLATE) -o $@ $< \

View file

@ -2,6 +2,7 @@ module LaantasImage
(Image (..), splitImage, splitImage', makeImage)
where
import Lang
import Text.Pandoc.Definition hiding (Image)
import qualified Text.Pandoc.Definition as Pandoc
import Data.Bifunctor
@ -26,22 +27,22 @@ data Image =
showText :: Bool
} deriving (Eq, Show)
splitImage :: Text -> Maybe Image
splitImage :: Vars => Text -> Maybe Image
splitImage (Text.uncons -> Just (c, txt))
| c == '!' = Just $ splitImage' txt
| c == '#' = Just $ (splitImage' txt) {showText = False}
splitImage _ = Nothing
splitImage' :: Text -> Image
splitImage' :: Vars => Text -> Image
splitImage' txt =
case imageOpts txt of
Just (txt, opts) -> defaultImage txt
Just (txt, opts) -> defaultImage txt ?defColor
& withOpt opts "file" (\f i -> i {file = makeFile f})
& withOpt opts "size" (\s i -> i {size = readt s})
& withOpt opts "stroke" (\k i -> i {stroke = readt k})
& withOpt opts "width" (\w i -> i {width = readt w})
& withOpt opts "color" (\c i -> i {color = c})
Nothing -> defaultImage txt
Nothing -> defaultImage txt ?defColor
where readt x = read $ Text.unpack x
withOpt :: Ord k => Map k v -> k -> (v -> a -> a) -> (a -> a)
@ -50,8 +51,8 @@ withOpt m k f =
Just v -> f v
Nothing -> id
defaultImage :: Text -> Image
defaultImage txt =
defaultImage :: Text -> Text -> Image
defaultImage txt color =
Image {
text = Text.filter notPunc txt,
title = toTitle txt,
@ -59,7 +60,7 @@ defaultImage txt =
size = 20,
stroke = 0.75,
width = 600,
color = "hsl(340deg, 50%, 35%)",
color = color,
showText = True
}

View file

@ -4,16 +4,28 @@ import Text.Pandoc.Definition
import Data.Char (toLower)
import qualified Data.Text as Text
import System.IO
import Data.Text (Text)
data Lang = Lántas deriving (Eq, Show)
type Vars = (?lang :: Maybe Lang)
type Vars = (?lang :: Maybe Lang, ?defColor :: Text)
toText :: Maybe MetaValue -> IO (Maybe Text)
toText (Just (MetaInlines [Str s])) = toText (Just (MetaString s)) -- ugh
toText (Just (MetaString s)) = pure $ Just s
toText Nothing = pure Nothing
toText (Just ) = do
hPutStrLn stderr $ "[WARN] expected a string, got: " <> show
pure Nothing
toLang :: Maybe MetaValue -> IO (Maybe Lang)
toLang (Just (MetaInlines [Str s])) = toLang (Just (MetaString s)) -- ugh
toLang (Just (MetaString (Text.map toLower -> s)))
| s == "lántas" || s == "laantas" = pure $ Just Lántas
toLang Nothing = pure Nothing
toLang (Just ) = do
hPutStrLn stderr $ "[WARN] unknown language: " <> show
toLang m = do
mres <- fmap (Text.map toLower) <$> toText m
case mres of
Just res -> do
if res `elem` ["laantas", "lántas"] then
pure $ Just Lántas
else do
hPutStrLn stderr $ "[WARN] unknown language: " <> show res
pure Nothing
Nothing -> pure Nothing

View file

@ -9,17 +9,22 @@ import Text.Pandoc.Definition
import Text.Pandoc.JSON
import Text.Pandoc.Walk
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as Text
import Control.Applicative
import Control.Monad
import System.Environment
main :: IO ()
main = toJSONFilter filter where
filter p@(Pandoc (Meta m) _) = do
lang' <- toLang $ Map.lookup "conlang" m
let ?lang = lang'
lang <- toLang $ Map.lookup "conlang" m
defColor <- getDefColor m
let ?lang = lang
let ?defColor = defColor
fmap (walk makeEbnf .
walk makeQuotes .
walk (concatMap makeBlocks) .
@ -27,6 +32,14 @@ main = toJSONFilter filter where
walkM spans =<<
walkM (fmap concat . traverse glosses) p
getDefColor :: Map Text MetaValue -> IO Text
getDefColor m = do
res <- toText $ Map.lookup "lang-color" m
case res of
Just col -> pure col
Nothing -> do
env <- lookupEnv "LANG_COLOR"
pure $ maybe "black" Text.pack env
pluck :: Eq a => a -> [a] -> Maybe [a]
pluck _ [] = Nothing