diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,25 @@ # Revision history for typst-hs +## 0.10 + + * Add --input option to cli for passing key-value pairs to the + evaluator (as can be done with `typst`). + + * Use optparse-applicative for CLI option parsing. + + * Add `inputs` parameter to `evalTypst`. + + * Remove `sysModule` from `Module.Standard` [API change]. + We now generate `sys` in `initialEvalState`, since only then + do we know the inputs. + + * Properly locate package root for imports (#98). + We need to go up the directory hierarchy til we find typst.toml. + + * Use released version of typst-symbols-0.2 with new typst-symbols API. + + * app/Main: remove unused options. + ## 0.9.0.1 * Fix typo that caused close single quote to be parsed as double diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -4,17 +4,19 @@ module Main where -import Control.Monad (foldM, when) +import Control.Monad (when) import qualified Data.ByteString as BS import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.IO as TIO +import Options.Applicative import System.Directory (doesFileExist) -import System.Environment (getArgs, lookupEnv) +import System.Environment (lookupEnv) import System.Exit import System.IO (hPutStrLn, stderr) import System.Timeout (timeout) -import Text.Read (readMaybe) import Text.Show.Pretty (pPrint) import Typst (evaluateTypst, parseTypst) import Typst.Types (Val (..), repr, Operations(..)) @@ -25,10 +27,9 @@ { optShowParse :: Bool, optShowEval :: Bool, optShowRepr :: Bool, - optShowLaTeX :: Bool, - optShowHtml :: Bool, - optStandalone :: Bool, - optTimeout :: Maybe (Maybe Int) + optTimeout :: Maybe Int, + optInputs :: [(Text, Text)], + optFile :: Maybe FilePath } deriving (Show, Eq) @@ -37,22 +38,29 @@ hPutStrLn stderr msg exitWith (ExitFailure 1) -parseArgs :: [String] -> IO (Maybe FilePath, Opts) -parseArgs = foldM go (Nothing, Opts False False False False False False Nothing) +optsParser :: Parser Opts +optsParser = + Opts + <$> switch (long "parse" <> help "Show parse tree") + <*> switch (long "eval" <> help "Show evaluated result") + <*> switch (long "repr" <> help "Show repr output") + <*> optional (option auto (long "timeout" <> metavar "MS" <> help "Timeout in milliseconds")) + <*> many (option (eitherReader parseInput) + (long "input" <> metavar "KEY=VALUE" <> help "Set an input key-value pair (repeatable)")) + <*> optional (argument str (metavar "FILE" <> help "Input file (reads stdin if omitted)")) + +parseInput :: String -> Either String (Text, Text) +parseInput s = + case break (== '=') s of + (_, []) -> Left "Expected KEY=VALUE format" + (k, '=' : v) -> Right (T.pack k, T.pack (unquote v)) + _ -> Left "Expected KEY=VALUE format" where - go (f, opts) "--parse" = pure (f, opts {optShowParse = True}) - go (f, opts) "--eval" = pure (f, opts {optShowEval = True}) - go (f, opts) "--repr" = pure (f, opts {optShowRepr = True}) - go (f, opts) "--latex" = pure (f, opts {optShowLaTeX = True}) - go (f, opts) "--html" = pure (f, opts {optShowHtml = True}) - go (f, opts) "--standalone" = pure (f, opts {optStandalone = True}) - go (f, opts) "--timeout" = pure (f, opts {optTimeout = Just Nothing }) - go (f, opts) x - | optTimeout opts == Just Nothing = - pure (f, opts {optTimeout = Just (readMaybe x) }) - go _ ('-' : xs) = err $ "Unknown option -" ++ xs - go (Nothing, opts) f = pure (Just f, opts) - go _ _ = err $ "Only one file can be specified as input." + unquote ('"' : rest) + | not (null rest) && last rest == '"' = init rest + unquote ('\'' : rest) + | not (null rest) && last rest == '\'' = init rest + unquote x = x operations :: Operations IO operations = Operations @@ -65,14 +73,15 @@ main :: IO () main = () <$ do - (mbfile, opts) <- getArgs >>= parseArgs + opts <- execParser (info (optsParser <**> helper) + (fullDesc <> progDesc "Parse and evaluate Typst documents")) + let mbfile = optFile opts let showAll = case opts of - Opts False False False False False False _ -> True + Opts False False False _ _ _ -> True _ -> False ( case optTimeout opts of Nothing -> fmap Just - Just Nothing -> timeout 1000 - Just (Just ms) -> timeout (ms * 1000) + Just ms -> timeout (ms * 1000) ) $ do bs <- maybe B.getContents B.readFile mbfile @@ -83,7 +92,7 @@ when (optShowParse opts || showAll) $ do when showAll $ putStrLn "--- parse tree ---" pPrint parseResult - result <- evaluateTypst operations "stdin" parseResult + result <- evaluateTypst operations (optInputs opts) "stdin" parseResult case result of Left e -> err $ show e Right c -> do diff --git a/src/Typst/Evaluate.hs b/src/Typst/Evaluate.hs --- a/src/Typst/Evaluate.hs +++ b/src/Typst/Evaluate.hs @@ -46,6 +46,8 @@ import Typst.Util (makeFunction, nthArg) import qualified Toml as Toml import qualified Toml.Schema as Toml +import Paths_typst (version) +import Data.Version (showVersion) -- import Debug.Trace @@ -55,12 +57,14 @@ Monad m => -- | Dictionary of functions for IO operations Operations m -> + -- | Parameters that would be set with --input in typst, for sys.inputs + [(Text, Text)] -> -- | Path of parsed content FilePath -> -- | Markup produced by 'parseTypst' [Markup] -> m (Either ParseError Content) -evaluateTypst operations fp = +evaluateTypst operations inputs fp = runParserT (do contents <- mconcat <$> many pContent <* eof -- "All documents are automatically wrapped in a document element." @@ -70,27 +74,38 @@ case toList els of [e] -> pure e _ -> fail "element returned something other than a singleton") - initialEvalState { evalOperations = operations, - evalLocalDir = takeDirectory fp } + (initialEvalState inputs) { evalOperations = operations, + evalLocalDir = takeDirectory fp } fp -initialEvalState :: EvalState m -initialEvalState = +initialEvalState :: [(Text, Text)] -> EvalState m +initialEvalState inputs = emptyEvalState { evalIdentifiers = [(BlockScope, mempty)] , evalMathIdentifiers = [(BlockScope, mathModule <> symModule)] - , evalStandardIdentifiers = [(BlockScope, standardModule'')] + , evalStandardIdentifiers = [(BlockScope, standardModule''')] , evalPackageRoot = "." + , evalInputs = inputs } where standardModule' = M.insert "eval" evalFunction standardModule - standardModule'' = M.insert "std" (VModule "std" standardModule') standardModule' + standardModule'' = M.insert + "sys" + (VModule "sys" $ M.fromList + [ ("version", VVersion [0,14,0]) + , ("inputs", VDict $ + OM.fromList (map (\(k,v) -> (Identifier k, VString v)) + inputs')) + ]) + standardModule' + standardModule''' = M.insert "std" (VModule "std" standardModule') standardModule'' + inputs' = ("typst-hs-version", T.pack (showVersion version)) : inputs evalFunction = makeFunction $ do code :: Text <- nthArg 1 case parseTypst "eval" ("#{\n" <> code <> "\n}") of Left e -> fail $ "eval: " <> show e Right [Code _ expr] -> -- run in Either monad so we can't access file system - case runParserT (evalExpr expr) initialEvalState "eval" [] of + case runParserT (evalExpr expr) (initialEvalState inputs) "eval" [] of Failure e -> fail $ "eval: " <> e Success (Left e) -> fail $ "eval: " <> show e Success (Right val) -> pure val @@ -940,7 +955,7 @@ findPackageEntryPoint modname = do let (namespace, rest) = break (=='/') (drop 1 $ T.unpack modname) let (name, rest') = break (==':') $ drop 1 rest - let version = drop 1 rest' + let pkgversion = drop 1 rest' operations <- evalOperations <$> getState let getEnv var = do mbv <- lift $ lookupEnvVar operations var @@ -965,7 +980,7 @@ let localDir = dataDir "typst" let cacheDir = cacheDir' "typst" #endif - let subpath = "packages" namespace name version + let subpath = "packages" namespace name pkgversion inLocal <- lift $ checkExistence operations (localDir subpath "typst.toml") tomlPath <- if inLocal @@ -993,11 +1008,19 @@ fp' <- findPackageEntryPoint modname operations <- evalOperations <$> getState txt <- lift $ TE.decodeUtf8 <$> loadBytes operations fp' + let findPkgRoot "" = fail $ "Could not find package root for " <> fp' + findPkgRoot dir' = do + exists <- lift $ checkExistence operations + (dir' "typst.toml") + if exists + then pure dir' + else findPkgRoot (takeDirectory dir') + pkgroot <- findPkgRoot (takeDirectory fp') pure ( takeFileName fp', Identifier (T.pack $ takeWhile (/= ':') . takeBaseName $ T.unpack modname), - Just (takeDirectory fp'), + Just pkgroot, txt ) else do let fp = T.unpack modname @@ -1013,6 +1036,7 @@ operations <- evalOperations <$> getState currentLocalDir <- evalLocalDir <$> getState currentPackageRoot <- evalPackageRoot <$> getState + inputs <- evalInputs <$> getState let (pkgroot , localdir) = case mbPackageRoot of Just r -> (r , takeDirectory fp) @@ -1027,9 +1051,9 @@ s <- getState pure (cs, s) ) - initialEvalState{evalOperations = operations, - evalLocalDir = localdir, - evalPackageRoot = pkgroot } + (initialEvalState inputs){evalOperations = operations, + evalLocalDir = localdir, + evalPackageRoot = pkgroot } fp ms case res of diff --git a/src/Typst/Module/Standard.hs b/src/Typst/Module/Standard.hs --- a/src/Typst/Module/Standard.hs +++ b/src/Typst/Module/Standard.hs @@ -7,15 +7,12 @@ module Typst.Module.Standard ( standardModule, symModule, - sysModule, loadFileText, getPath, applyPureFunction ) where -import Paths_typst (version) -import Data.Version (showVersion) import Control.Applicative ((<|>)) import Control.Monad (mplus, unless) import Control.Monad.Reader (lift, ReaderT) @@ -36,10 +33,9 @@ import Text.Read (readMaybe) import qualified Text.XML as XML import qualified Toml -import Typst.Emoji (typstEmojis) import Typst.Module.Calc (calcModule) import Typst.Module.Math (mathModule) -import Typst.Symbols (typstSymbols) +import Typst.Symbols (typstSymbols, typstEmojis) import Typst.Types import Typst.Util import System.FilePath.Posix ((), normalise) @@ -52,9 +48,9 @@ M.fromList $ [ ("math", VModule "math" mathModule), ("sym", VModule "sym" symModule), - ("sys", VModule "sys" sysModule), ("emoji", VModule "emoji" emojiModule), ("calc", VModule "calc" calcModule) + -- sys module is added in initialEvalState ] ++ types ++ colors @@ -68,14 +64,6 @@ ++ construct ++ time ++ dataLoading - -sysModule :: M.Map Identifier Val -sysModule = - M.fromList [ ("version", VVersion [0,12,0]) - , ("inputs", VDict (OM.fromList - [("typst-hs-version", - VString (T.pack (showVersion version)))])) - ] symModule :: M.Map Identifier Val symModule = M.map VSymbol $ makeSymbolMap typstSymbols diff --git a/src/Typst/Parse.hs b/src/Typst/Parse.hs --- a/src/Typst/Parse.hs +++ b/src/Typst/Parse.hs @@ -20,7 +20,7 @@ import Text.Parsec.Expr import Text.Read (readMaybe) import Typst.Syntax -import Typst.Shorthands (mathSymbolShorthands) +import Typst.Symbols (mathSymbolShorthands) -- import Debug.Trace diff --git a/src/Typst/Types.hs b/src/Typst/Types.hs --- a/src/Typst/Types.hs +++ b/src/Typst/Types.hs @@ -624,7 +624,8 @@ evalFlowDirective :: FlowDirective, evalPackageRoot :: FilePath, evalLocalDir :: FilePath, - evalOperations :: Operations m + evalOperations :: Operations m, + evalInputs :: [(Text, Text)] } emptyEvalState :: EvalState m @@ -640,7 +641,8 @@ evalFlowDirective = FlowNormal, evalPackageRoot = mempty, evalLocalDir = mempty, - evalOperations = undefined + evalOperations = undefined, + evalInputs = [] } data Attempt a diff --git a/src/Typst/Util.hs b/src/Typst/Util.hs --- a/src/Typst/Util.hs +++ b/src/Typst/Util.hs @@ -29,6 +29,7 @@ import qualified Data.Vector as V import Text.Parsec (getPosition) import Typst.Types +import Typst.Symbols (Sym(..)) data TypeSpec = One ValType @@ -148,11 +149,13 @@ allArgs :: Monad m => ReaderT Arguments (MP m) [Val] allArgs = asks positional -makeSymbolMap :: [(Text, Bool, Text)] -> M.Map Identifier Symbol +makeSymbolMap :: [Sym] -> M.Map Identifier Symbol makeSymbolMap = foldl' go mempty where - go :: M.Map Identifier Symbol -> (Text, Bool, Text) -> M.Map Identifier Symbol - go m (name, accent, v) = + go :: M.Map Identifier Symbol -> Sym -> M.Map Identifier Symbol + go m (Sym{ symName = name, + symIsAccent = accent, + symText = v }) = case T.split (== '.') name of [] -> m (k : ks) -> diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -67,7 +67,7 @@ case parseResult of Left e -> pure $ fromText $ T.pack $ show e Right parsed -> do - evalResult <- evaluateTypst operations input (testParse <> parsed) + evalResult <- evaluateTypst operations [] input (testParse <> parsed) let parseOutput = "--- parse tree ---\n" <> T.pack (ppShow parsed) <> "\n" case evalResult of Left e -> diff --git a/typst.cabal b/typst.cabal --- a/typst.cabal +++ b/typst.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: typst -version: 0.9.0.1 +version: 0.10 synopsis: Parsing and evaluating typst syntax. description: A library for parsing and evaluating typst syntax. Typst () is a document layout and @@ -62,7 +62,7 @@ -- other-extensions: build-depends: base >= 4.14 && < 5, - typst-symbols >= 0.1.9 && < 0.1.10, + typst-symbols >= 0.2 && < 0.3, mtl, vector, parsec, @@ -112,7 +112,8 @@ bytestring, time, pretty-show, - ordered-containers + ordered-containers, + optparse-applicative else Buildable: False