lots of langfilter stuff, mostly lántas script

langfilter/LaantasImage.hs

@@ -0,0 +1,106 @@
+module LaantasImage
+  (Image (..), splitImage, splitImage', makeImage)
+where
+
+import Text.Pandoc.Definition hiding (Image)
+import qualified Text.Pandoc.Definition as Pandoc
+import Data.Bifunctor
+import Data.Function
+import Data.Maybe
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Text (Text)
+import qualified Data.Text as Text
+import System.Environment
+import System.FilePath
+import System.Process
+
+
+data Image =
+  Image {
+    text, title  :: Text,
+    file         :: FilePath,
+    size, stroke :: Double,
+    width        :: Int,
+    color        :: Text,
+    showText     :: Bool
+  } deriving (Eq, Show)
+
+splitImage :: 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' txt₀ =
+  case imageOpts txt₀ of
+    Just (txt, opts) -> defaultImage txt
+      & 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₀
+  where readt x = read $ Text.unpack x
+
+withOpt :: Ord k => Map k v -> k -> (v -> a -> a) -> (a -> a)
+withOpt m k f =
+  case Map.lookup k m of
+    Just v  -> f v
+    Nothing -> id
+
+defaultImage :: Text -> Image
+defaultImage txt =
+    Image {
+      text = Text.filter notPunc txt,
+      title = toTitle txt,
+      file = makeFile txt,
+      size = 20,
+      stroke = 0.75,
+      width = 600,
+      color = "hsl(340deg, 50%, 35%)",
+      showText = True
+    }
+
+split1 :: Text -> Text -> Maybe (Text, Text)
+split1 s txt =
+  let (a, b) = Text.breakOn s txt in
+  if Text.null b then
+    Nothing
+  else
+    Just (Text.strip a, Text.strip $ Text.drop (Text.length s) b)
+
+type Opts = Map Text Text
+
+imageOpts :: Text -> Maybe (Text, Opts)
+imageOpts = fmap (second splitOpts) . getOpts
+
+getOpts :: Text -> Maybe (Text, Text)
+getOpts = split1 "|"
+
+splitOpts :: Text -> Map Text Text
+splitOpts = Map.fromList . map splitOpt . Text.splitOn ";" where
+  splitOpt txt = fromMaybe ("file", txt) $ split1 "=" txt
+
+makeFile :: Text -> FilePath
+makeFile txt = map stripWeird (Text.unpack txt) <.> "svg"
+  where stripWeird c = if weirdUrl c then '_' else c
+
+toTitle :: Text -> Text
+toTitle = Text.filter \c -> c /= '\\' && c /= '#'
+
+makeImage :: Image -> IO Inline
+makeImage (Image {..}) = do
+  exe <- getEnv "LAANTAS_SCRIPT"
+  dir <- getEnv "DIRNAME"
+  callProcess exe
+    ["-S", show size, "-K", show stroke, "-W", show width,
+     "-C", Text.unpack color, "-t", Text.unpack text, "-o", dir </> file]
+  pure $ Pandoc.Image ("", ["scr","laantas"], []) [] (Text.pack file, title)
+
+weirdUrl :: Char -> Bool
+weirdUrl c = c `elem` ("#\\?&_/.·,{} " :: String)
+
+notPunc :: Char -> Bool
+notPunc c = c `notElem` ("{}·" :: String)