diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs index 27374a81f..ffb7c5eb8 100644 --- a/src/Text/Pandoc/App/CommandLineOptions.hs +++ b/src/Text/Pandoc/App/CommandLineOptions.hs @@ -4,6 +4,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.App.CommandLineOptions Copyright : Copyright (C) 2006-2022 John MacFarlane @@ -37,6 +38,7 @@ import Data.List (isPrefixOf) #endif import Data.Maybe (fromMaybe, isJust) import Data.Text (Text) +import HsLua (Exception, getglobal, openlibs, peek, run, top) import Safe (tailDef) import Skylighting (Style, Syntax (..), defaultSyntaxMap, parseTheme) import System.Console.GetOpt @@ -946,10 +948,14 @@ options = (\_ -> do prg <- getProgName defaultDatadir <- defaultUserDataDir + luaVersion <- HsLua.run @HsLua.Exception $ do + openlibs + getglobal "_VERSION" + peek top UTF8.hPutStrLn stdout $ T.pack $ prg ++ " " ++ T.unpack pandocVersion ++ - compileInfo ++ + compileInfo ++ "\nScripting engine: " ++ luaVersion ++ "\nUser data directory: " ++ defaultDatadir ++ ('\n':copyrightMessage) exitSuccess ))