lang/langfilter/LaantasImage.hs

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"
  parent <- dropFileName <$> getEnv "FILENAME"
  dir    <- getEnv "DIRNAME"
  let fullFile = dir </> file
  let relFile  = Text.pack $ makeRelative parent fullFile
  callProcess exe
    ["-S", show size, "-K", show stroke, "-W", show width,
     "-C", Text.unpack color, "-t", Text.unpack text, "-o", fullFile]
  pure $ Pandoc.Image ("", ["scr","laantas"], []) [] (relFile, title)

weirdUrl :: Char -> Bool
weirdUrl c = c `elem` ("#\\?&_/.·,{} " :: String)

notPunc :: Char -> Bool
notPunc c = c `notElem` ("{}·" :: String)