diff --git a/Makefile b/Makefile index cf807c5..69a9dff 100644 --- a/Makefile +++ b/Makefile @@ -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 $@ $< \ diff --git a/langfilter/LaantasImage.hs b/langfilter/LaantasImage.hs index fc8ff5b..27844c8 100644 --- a/langfilter/LaantasImage.hs +++ b/langfilter/LaantasImage.hs @@ -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 } diff --git a/langfilter/Lang.hs b/langfilter/Lang.hs index 6459142..66d36e1 100644 --- a/langfilter/Lang.hs +++ b/langfilter/Lang.hs @@ -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 ℓ - pure Nothing +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 diff --git a/langfilter/Main.hs b/langfilter/Main.hs index b704193..a96cacd 100644 --- a/langfilter/Main.hs +++ b/langfilter/Main.hs @@ -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