make lántas script color configurable with LANG_COLOR

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 $@ $< \

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 :: Text -> Text -> Image
-defaultImage txt =
+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
     }
 

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 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

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
+    lang <- toLang $ Map.lookup "conlang" m
-    let ?lang = lang'
+    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

pages/laantas/words.yaml

@@ -195,7 +195,9 @@ ustai:
   - t: {v: i}
     d: sing
   - t: n
-    d: song
+    d:
+      - song
+      - ustail: (also) magic
 
 purai:
   p: ˈpu.ɾaj
@@ -311,7 +313,9 @@ gimimli:
 sá:
   p: ˈsaː
   t: adv
-  d: now
+  d:
+    - now
+    - sá sá: these days
   n: usually fronted in sentence
 
 gimimƶu:
@@ -476,6 +480,7 @@ júli:
   p: ˈjuː.li
   t: {v: t}
   d:
+    - use (with direct object)
     - put (with lative cases)
     - take (with ablative cases)
 
@@ -1494,8 +1499,8 @@ ki:
     - kisa: low
     - kisas: downwards
 
-nuasga:
+gulai:
-  p: ˈnuəs.ɡa
+  p: ˈgu.lai
   t: {v: i}
   d: jump
 
@@ -1686,7 +1691,9 @@ nis:
 siha:
   p: ˈsi.xa
   t: {v: t}
-  d: remember
+  d:
+    - remember
+    - be careful with
 
 siham:
   t: n
@@ -2041,7 +2048,13 @@ aga:
 tisu:
   t: {v: aux}
   d: if...then
-  n: see the grammar for details (when i write them)
+  n:
+    - see the grammar for details (when i write them)
+    - if-clause nominalised in in-abl
+    - then-clause is main, with tisu as aux verb
+  e:
+    o: bairunagulinḿ ákkínam tisu
+    t: if i see you i will scream
 
 duguwa:
   t: {v: t}
@@ -2061,7 +2074,10 @@ duguwa:
 igis:
   p: ˈiɡ.is
   t: n
-  d: ice
+  d:
+    - ice
+    - crystal (also kut igis)
+  see: kus
 
 igisi:
   p: ˈi.ɡi.si
@@ -2084,3 +2100,20 @@ susuru:
   t: {v: i}
   d: be deep
   n: not a noun, unlike most adjectives. who knows why
+
+patta:
+  p: ˈpat.ta
+  t: n
+  d: door
+
+šil:
+  p: ʃil
+  t: n
+  d:
+    - layer
+    - floor (level in building)
+
+kus:
+  p: kus
+  t: n
+  d: [stone, rock]