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)