change how script colour is handled

langfilter/lib/LangFilter.hs

@@ -8,35 +8,23 @@ import Glosses
 import Text.Pandoc.Definition
 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
 
 
-langFilter :: Pandoc -> IO Pandoc
+langFilter :: Text -> Pandoc -> IO Pandoc
-langFilter p@(Pandoc (Meta m) _) = do
+langFilter col p@(Pandoc (Meta m) _) = do
   lang <- toLang $ Map.lookup "conlang" m
-  defColor <- getDefColor m
   let ?lang = lang
-  let ?defColor = defColor
+  let ?defColor = col
   let f = map (walk spans . fixFigureClass . makeEbnf .
                makeQuotes . letterList) .
           concatMap (makeBlocks <=< glosses)
   pure $ walk f 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
 pluck x (y:ys) | x == y    = Just ys

langfilter/main/Main.hs

@@ -1,4 +1,17 @@
+import qualified Data.Map as Map
+import qualified Data.Text as Text
 import LangFilter
+import System.Environment
 import Text.Pandoc.JSON
+import Lang
 
-main = toJSONFilter langFilter
+main =
+  toJSONFilter $ \p@(Pandoc (Meta m) _) -> do
+    col <- getDefColor m
+    langFilter col p
+ where
+  getDefColor m = do
+    res <- toText $ Map.lookup "lang-color" m
+    case res of
+      Just col -> pure $ col
+      Nothing  -> maybe "currentcolor" Text.pack <$> lookupEnv "LANG_COLOR"