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] $<" @echo "[pandoc] $<"
mkdir -p $(dir $@) mkdir -p $(dir $@)
mkdir -p $(basename $@) mkdir -p $(basename $@)
LAANTAS_SCRIPT="$(LAANTAS_SCRIPT)" \ LAANTAS_SCRIPT="$(LAANTAS_SCRIPT)" LANG_COLOR="hsl(340deg, 50%, 35%)" \
DIRNAME="$(basename $@)" \ DIRNAME="$(basename $@)" \
FILENAME="$@" \ FILENAME="$@" \
pandoc -s --toc --template $(TEMPLATE) -o $@ $< \ pandoc -s --toc --template $(TEMPLATE) -o $@ $< \

View file

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

View file

@ -4,16 +4,28 @@ import Text.Pandoc.Definition
import Data.Char (toLower) import Data.Char (toLower)
import qualified Data.Text as Text import qualified Data.Text as Text
import System.IO import System.IO
import Data.Text (Text)
data Lang = Lántas deriving (Eq, Show) 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 :: Maybe MetaValue -> IO (Maybe Lang)
toLang (Just (MetaInlines [Str s])) = toLang (Just (MetaString s)) -- ugh toLang m = do
toLang (Just (MetaString (Text.map toLower -> s))) mres <- fmap (Text.map toLower) <$> toText m
| s == "lántas" || s == "laantas" = pure $ Just Lántas case mres of
toLang Nothing = pure Nothing Just res -> do
toLang (Just ) = do if res `elem` ["laantas", "lántas"] then
hPutStrLn stderr $ "[WARN] unknown language: " <> show pure $ Just Lántas
pure Nothing 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.JSON
import Text.Pandoc.Walk import Text.Pandoc.Walk
import Data.Maybe import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import Control.Applicative import Control.Applicative
import Control.Monad import Control.Monad
import System.Environment
main :: IO () main :: IO ()
main = toJSONFilter filter where main = toJSONFilter filter where
filter p@(Pandoc (Meta m) _) = do filter p@(Pandoc (Meta m) _) = do
lang' <- toLang $ Map.lookup "conlang" m lang <- toLang $ Map.lookup "conlang" m
let ?lang = lang' defColor <- getDefColor m
let ?lang = lang
let ?defColor = defColor
fmap (walk makeEbnf . fmap (walk makeEbnf .
walk makeQuotes . walk makeQuotes .
walk (concatMap makeBlocks) . walk (concatMap makeBlocks) .
@ -27,6 +32,14 @@ main = toJSONFilter filter where
walkM spans =<< walkM spans =<<
walkM (fmap concat . traverse glosses) p 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 :: Eq a => a -> [a] -> Maybe [a]
pluck _ [] = Nothing pluck _ [] = Nothing