diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,25 @@ # Revision history for typst-hs +## 0.5.0.1 + + * Set `evalPackageRoot` to working dir to start, even if the file to be + converted is somewhere else. This seems to be what the test suite expects. + + * Make file loading relative to package root if present (#39). + + * Parser: remove `pBindExpr` from `pBaseExpr`. It does not seem + to be necessary, and it causes problems with things like `$#x = $y$` (#34). + + * Fix assignment of module name in package imports (#30). + + * Don't allow `container.at` to insert new values (#26). + + * Handle `dict.at(variable) = expression` (#25). + + * Remove dependency on the unmaintained digits library (#24). + We just copy the code for the function we need (with + attribution): it is BSD3-licensed. + ## 0.5 * Support "as" keyword in imports (#21). diff --git a/src/Typst/Evaluate.hs b/src/Typst/Evaluate.hs --- a/src/Typst/Evaluate.hs +++ b/src/Typst/Evaluate.hs @@ -59,14 +59,13 @@ -- | Markup produced by 'parseTypst' [Markup] -> m (Either ParseError Content) -evaluateTypst operations fp = +evaluateTypst operations = runParserT (do contents <- mconcat <$> many pContent <* eof -- "All documents are automatically wrapped in a document element." pure $ Elt "document" Nothing [("body", VContent contents)]) initialEvalState { evalOperations = operations, - evalPackageRoot = takeDirectory fp } - fp + evalPackageRoot = "." } initialEvalState :: EvalState m initialEvalState = @@ -989,17 +988,24 @@ -> MP m (Seq Content, (Identifier, M.Map Identifier Val)) loadModule modname = do pos <- getPosition - (fp, mbPackageRoot) <- + (fp, modid, mbPackageRoot) <- if T.take 1 modname == "@" then do fp' <- findPackageEntryPoint modname - pure (fp', Just (takeDirectory fp')) + pure (fp', + Identifier + (T.pack $ takeWhile (/= ':') . takeBaseName $ + T.unpack modname), + Just (takeDirectory fp')) else if T.take 1 modname == "/" -- refers to path relative to package root then do packageRoot <- evalPackageRoot <$> getState - pure (packageRoot drop 1 (T.unpack modname), Nothing) - else pure (replaceFileName (sourceName pos) (T.unpack modname), Nothing) - let modid = Identifier (T.pack $ takeBaseName fp) + pure (packageRoot drop 1 (T.unpack modname), + Identifier (T.pack $ takeBaseName $ T.unpack modname), + Nothing) + else pure (replaceFileName (sourceName pos) (T.unpack modname), + Identifier (T.pack $ takeBaseName $ T.unpack modname), + Nothing) txt <- loadFileText fp case parseTypst fp txt of Left err -> fail $ show err @@ -1130,57 +1136,60 @@ pure result updateExpression :: Monad m => Expr -> Val -> MP m () -updateExpression e val = - case e of - Ident i -> updateIdentifier i val - FuncCall - (FieldAccess (Ident (Identifier "at")) e') - [NormalArg (Literal (Int idx))] -> - do - ival <- evalExpr e' - case ival of - VArray v -> - updateExpression e' $ VArray $ v V.// [(fromIntegral idx, val)] - _ -> fail $ "Cannot update expression " <> show e - FuncCall (FieldAccess (Ident (Identifier "first")) e') [] -> - updateExpression - ( FuncCall - (FieldAccess (Ident (Identifier "at")) e') - [NormalArg (Literal (Int 0))] - ) - val - FuncCall (FieldAccess (Ident (Identifier "last")) e') [] -> - updateExpression - ( FuncCall - (FieldAccess (Ident (Identifier "at")) e') - [NormalArg (Literal (Int (-1)))] - ) - val - FuncCall - (FieldAccess (Ident (Identifier "at")) e') - [NormalArg (Literal (String fld))] -> - do - ival <- evalExpr e' - case ival of - VDict d -> - updateExpression e' $ - VDict $ - OM.alter - ( \case - Just _ -> Just val - Nothing -> Just val - ) - (Identifier fld) - d - _ -> fail $ "Cannot update expression " <> show e - FieldAccess (Ident (Identifier fld)) e' -> - updateExpression - ( FuncCall - (FieldAccess (Ident (Identifier "at")) e') - [NormalArg (Literal (String fld))] - ) - val - _ -> fail $ "Cannot update expression " <> show e +updateExpression + (FuncCall (FieldAccess (Ident (Identifier "first")) e') []) val + = updateExpression ( FuncCall + (FieldAccess (Ident (Identifier "at")) e') + [NormalArg (Literal (Int 0))] + ) val +updateExpression + (FuncCall (FieldAccess (Ident (Identifier "last")) e') []) val + = updateExpression ( FuncCall + (FieldAccess (Ident (Identifier "at")) e') + [NormalArg (Literal (Int (-1)))] + ) val +updateExpression + (FieldAccess (Ident (Identifier fld)) e') val + = updateExpression' True e' (Literal (String fld)) val -- see #26 +updateExpression (Ident i) val = updateIdentifier i val +updateExpression + (FuncCall + (FieldAccess (Ident (Identifier "at")) e') [NormalArg arg]) val + = updateExpression' False e' arg val +updateExpression e _ = fail $ "Cannot update expression " <> show e + +updateExpression' :: Monad m => Bool -> Expr -> Expr -> Val -> MP m () +updateExpression' allowNewIndices e arg val = do + container <- evalExpr e + idx <- evalExpr arg + case container of + VArray v -> + case idx of + VInteger i -> + let i' = fromIntegral i + in case v V.!? i' of + Nothing | not allowNewIndices + -> fail $ "Vector does not contain index " <> show i' + _ -> updateExpression e $ VArray $ v V.// [(i', val)] + _ -> fail $ "Cannot index array with " <> show idx + VDict d -> + case idx of + VString fld -> + case OM.lookup (Identifier fld) d of + Nothing | not allowNewIndices + -> fail $ "Dictionary does not contain key " <> show fld + _ -> updateExpression e $ + VDict $ + OM.alter + ( \case + Just _ -> Just val + Nothing -> Just val + ) + (Identifier fld) + d + _ -> fail $ "Cannot index dictionary with " <> show idx + _ -> fail $ "Cannot update expression " <> show e + toSelector :: Monad m => Val -> MP m Selector toSelector (VSelector s) = pure s 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 @@ -42,10 +42,11 @@ import Typst.Symbols (typstSymbols) import Typst.Types import Typst.Util +import System.FilePath (()) +import Data.List (genericTake) import Data.Time (UTCTime(..)) import Data.Time.Calendar (fromGregorianValid) import Data.Time.Clock (secondsToDiffTime) -import Data.Digits (mDigits) standardModule :: M.Map Identifier Val standardModule = @@ -485,12 +486,14 @@ loadFileLazyBytes :: Monad m => FilePath -> MP m BL.ByteString loadFileLazyBytes fp = do operations <- evalOperations <$> getState - lift $ BL.fromStrict <$> loadBytes operations fp + root <- evalPackageRoot <$> getState + lift $ BL.fromStrict <$> loadBytes operations (root fp) loadFileText :: Monad m => FilePath -> MP m T.Text loadFileText fp = do operations <- evalOperations <$> getState - lift $ TE.decodeUtf8 <$> loadBytes operations fp + root <- evalPackageRoot <$> getState + lift $ TE.decodeUtf8 <$> loadBytes operations (root fp) getUTCTime :: Monad m => MP m UTCTime getUTCTime = (currentUTCTime . evalOperations <$> getState) >>= lift @@ -609,3 +612,28 @@ initialEvalState :: MonadFail m => EvalState m initialEvalState = emptyEvalState { evalIdentifiers = [(BlockScope, standardModule)] } + +-- mDigitsRev, mDigits from the unmaintained digits package +-- https://hackage.haskell.org/package/digits-0.3.1 +-- (c) 2009-2016 Henry Bucklow, Charlie Harvey -- BSD-3-Clause license. +mDigitsRev :: Integral n + => n -- ^ The base to use. + -> n -- ^ The number to convert to digit form. + -> Maybe [n] -- ^ Nothing or Just the digits of the number in list form, in reverse. +mDigitsRev base i = if base < 1 + then Nothing -- We do not support zero or negative bases + else Just $ dr base i + where + dr _ 0 = [] + dr b x = case base of + 1 -> genericTake x $ repeat 1 + _ -> let (rest, lastDigit) = quotRem x b + in lastDigit : dr b rest + +-- | Returns the digits of a positive integer as a Maybe list. +-- or Nothing if a zero or negative base is given +mDigits :: Integral n + => n -- ^ The base to use. + -> n -- ^ The number to convert to digit form. + -> Maybe [n] -- ^ Nothing or Just the digits of the number in list form +mDigits base i = reverse <$> mDigitsRev base i diff --git a/src/Typst/Parse.hs b/src/Typst/Parse.hs --- a/src/Typst/Parse.hs +++ b/src/Typst/Parse.hs @@ -755,7 +755,6 @@ pLiteral <|> pKeywordExpr <|> pFuncExpr - <|> pBindExpr <|> pIdent <|> pArrayExpr <|> pDictExpr @@ -1190,7 +1189,3 @@ pIncludeExpr :: P Expr pIncludeExpr = Include <$> (pKeyword "include" *> pExpr) - -pBindExpr :: P Expr -pBindExpr = - Binding <$> try (pBind <* lookAhead (op "=")) diff --git a/test/out/compiler/break-continue-00.out b/test/out/compiler/break-continue-00.out --- a/test/out/compiler/break-continue-00.out +++ b/test/out/compiler/break-continue-00.out @@ -69,9 +69,7 @@ , Block (CodeBlock [ Break - , Assign - (Binding (BasicBind (Just (Identifier "error")))) - (Literal (Boolean True)) + , Assign (Ident (Identifier "error")) (Literal (Boolean True)) ]) ) ] diff --git a/test/out/compiler/closure-03.out b/test/out/compiler/closure-03.out --- a/test/out/compiler/closure-03.out +++ b/test/out/compiler/closure-03.out @@ -70,9 +70,7 @@ [ NormalArg (Literal (String "Typst")) ]) , NormalArg (Literal (String "Hi, Typst!")) ] - , Assign - (Binding (BasicBind (Just (Identifier "mark")))) - (Literal (String "?")) + , Assign (Ident (Identifier "mark")) (Literal (String "?")) , FuncCall (Ident (Identifier "test")) [ NormalArg diff --git a/test/out/compiler/content-field-00.out b/test/out/compiler/content-field-00.out --- a/test/out/compiler/content-field-00.out +++ b/test/out/compiler/content-field-00.out @@ -146,8 +146,7 @@ , Block (CodeBlock [ Assign - (Binding - (BasicBind (Just (Identifier "value")))) + (Ident (Identifier "value")) (FuncCall (FieldAccess (Ident (Identifier "pow")) diff --git a/test/out/compiler/for-01.out b/test/out/compiler/for-01.out --- a/test/out/compiler/for-01.out +++ b/test/out/compiler/for-01.out @@ -184,9 +184,7 @@ , Block (CodeBlock [ Literal (String ", ") ]) ) ] - , Assign - (Binding (BasicBind (Just (Identifier "first")))) - (Literal (Boolean False)) + , Assign (Ident (Identifier "first")) (Literal (Boolean False)) , Ident (Identifier "c") ])))) , ParBreak diff --git a/test/out/compiler/if-03.out b/test/out/compiler/if-03.out --- a/test/out/compiler/if-03.out +++ b/test/out/compiler/if-03.out @@ -51,7 +51,7 @@ , Let (BasicBind (Just (Identifier "y"))) (Literal (Int 2)) , Let (BasicBind (Just (Identifier "z"))) (Literal None) , Assign - (Binding (BasicBind (Just (Identifier "z")))) + (Ident (Identifier "z")) (If [ ( LessThan (Ident (Identifier "x")) (Ident (Identifier "y")) , Block (CodeBlock [ Literal (String "ok") ]) @@ -63,7 +63,7 @@ , NormalArg (Literal (String "ok")) ] , Assign - (Binding (BasicBind (Just (Identifier "z")))) + (Ident (Identifier "z")) (If [ ( GreaterThan (Ident (Identifier "x")) (Ident (Identifier "y")) , Block (CodeBlock [ Literal (String "bad") ]) @@ -78,7 +78,7 @@ , NormalArg (Literal (String "ok")) ] , Assign - (Binding (BasicBind (Just (Identifier "z")))) + (Ident (Identifier "z")) (If [ ( GreaterThan (Ident (Identifier "x")) (Ident (Identifier "y")) , Block (CodeBlock [ Literal (String "bad") ]) diff --git a/test/out/compiler/ops-03.out b/test/out/compiler/ops-03.out --- a/test/out/compiler/ops-03.out +++ b/test/out/compiler/ops-03.out @@ -125,7 +125,7 @@ (CodeBlock [ Let (BasicBind (Just (Identifier "x"))) (Literal None) , Assign - (Binding (BasicBind (Just (Identifier "x")))) + (Ident (Identifier "x")) (And (GreaterThanOrEqual (Plus @@ -133,9 +133,7 @@ (Literal (Int 21))) (Block (CodeBlock - [ Assign - (Binding (BasicBind (Just (Identifier "x")))) - (Literal (String "a")) + [ Assign (Ident (Identifier "x")) (Literal (String "a")) , Equals (Plus (Ident (Identifier "x")) (Literal (String "b"))) (Literal (String "ab")) diff --git a/test/out/compiler/ops-10.out b/test/out/compiler/ops-10.out --- a/test/out/compiler/ops-10.out +++ b/test/out/compiler/ops-10.out @@ -49,8 +49,7 @@ , Code "test/typ/compiler/ops-10.typ" ( line 5 , column 2 ) - (Assign - (Binding (BasicBind (Just (Identifier "x")))) (Literal (Int 10))) + (Assign (Ident (Identifier "x")) (Literal (Int 10))) , Space , Code "test/typ/compiler/ops-10.typ" @@ -128,9 +127,7 @@ , Code "test/typ/compiler/ops-10.typ" ( line 10 , column 2 ) - (Assign - (Binding (BasicBind (Just (Identifier "x")))) - (Literal (String "some"))) + (Assign (Ident (Identifier "x")) (Literal (String "some"))) , Space , Code "test/typ/compiler/ops-10.typ" diff --git a/test/out/compiler/ops-11.out b/test/out/compiler/ops-11.out --- a/test/out/compiler/ops-11.out +++ b/test/out/compiler/ops-11.out @@ -1,3 +1,3 @@ -"test/typ/compiler/ops-11.typ" (line 25, column 5): +"test/typ/compiler/ops-11.typ" (line 19, column 5): unexpected ":" expecting "//", "/*", operator or ")" diff --git a/test/out/compiler/ops-invalid-29.out b/test/out/compiler/ops-invalid-29.out --- a/test/out/compiler/ops-invalid-29.out +++ b/test/out/compiler/ops-invalid-29.out @@ -49,9 +49,7 @@ , Code "test/typ/compiler/ops-invalid-29.typ" ( line 5 , column 2 ) - (Assign - (Binding (BasicBind (Just (Identifier "rect")))) - (Literal (String "hi"))) + (Assign (Ident (Identifier "rect")) (Literal (String "hi"))) , ParBreak ] --- evaluated --- diff --git a/test/out/compiler/while-00.out b/test/out/compiler/while-00.out --- a/test/out/compiler/while-00.out +++ b/test/out/compiler/while-00.out @@ -81,9 +81,7 @@ (Ident (Identifier "iter")) (Block (CodeBlock - [ Assign - (Binding (BasicBind (Just (Identifier "iter")))) - (Literal (Boolean False)) + [ Assign (Ident (Identifier "iter")) (Literal (Boolean False)) , Literal (String "Hi.") ]))) , ParBreak diff --git a/test/out/meta/figure-02.out b/test/out/meta/figure-02.out --- a/test/out/meta/figure-02.out +++ b/test/out/meta/figure-02.out @@ -63,7 +63,7 @@ , Block (CodeBlock [ Assign - (Binding (BasicBind (Just (Identifier "name")))) + (Ident (Identifier "name")) (Block (Content [ Space @@ -83,10 +83,7 @@ , ( Literal (Boolean True) , Block (CodeBlock - [ Assign - (Binding (BasicBind (Just (Identifier "name")))) - (Block (Content [])) - ]) + [ Assign (Ident (Identifier "name")) (Block (Content [])) ]) ) ] , Let (BasicBind (Just (Identifier "title"))) (Literal None) @@ -99,7 +96,7 @@ , Block (CodeBlock [ Assign - (Binding (BasicBind (Just (Identifier "title")))) + (Ident (Identifier "title")) (FieldAccess (Ident (Identifier "supplement")) (Ident (Identifier "it"))) , If @@ -135,7 +132,7 @@ ) ] , Assign - (Binding (BasicBind (Just (Identifier "title")))) + (Ident (Identifier "title")) (FuncCall (Ident (Identifier "strong")) [ NormalArg (Ident (Identifier "title")) ]) diff --git a/test/out/regression/issue25.out b/test/out/regression/issue25.out new file mode 100644 --- /dev/null +++ b/test/out/regression/issue25.out @@ -0,0 +1,82 @@ +--- parse tree --- +[ Code + "test/typ/regression/issue25.typ" + ( line 1 , column 2 ) + (Let + (BasicBind (Just (Identifier "test"))) + (FuncExpr + [ NormalParam (Identifier "x") , NormalParam (Identifier "y") ] + (Block + (CodeBlock + [ If + [ ( Equals (Ident (Identifier "x")) (Ident (Identifier "y")) + , Block (Content [ Text "\9989" ]) + ) + , ( Literal (Boolean True) + , Block + (Content + [ Text "\10060" + , Text "(" + , Code + "test/typ/regression/issue25.typ" + ( line 1 , column 47 ) + (FuncCall + (Ident (Identifier "repr")) + [ NormalArg (Ident (Identifier "x")) ]) + , Space + , Text "/" + , Text "=" + , Space + , Code + "test/typ/regression/issue25.typ" + ( line 1 , column 59 ) + (FuncCall + (Ident (Identifier "repr")) + [ NormalArg (Ident (Identifier "y")) ]) + , Text ")" + ]) + ) + ] + ])))) +, SoftBreak +, Code + "test/typ/regression/issue25.typ" + ( line 2 , column 2 ) + (Let + (BasicBind (Just (Identifier "x"))) + (Dict [ Reg ( Ident (Identifier "a") , Literal (Int 5) ) ])) +, SoftBreak +, Code + "test/typ/regression/issue25.typ" + ( line 3 , column 2 ) + (Let (BasicBind (Just (Identifier "key"))) (Literal (String "a"))) +, SoftBreak +, Code + "test/typ/regression/issue25.typ" + ( line 4 , column 2 ) + (Block + (CodeBlock + [ Assign + (FuncCall + (FieldAccess (Ident (Identifier "at")) (Ident (Identifier "x"))) + [ NormalArg (Ident (Identifier "key")) ]) + (Literal (Int 6)) + ])) +, SoftBreak +, Code + "test/typ/regression/issue25.typ" + ( line 7 , column 2 ) + (Ident (Identifier "x")) +, ParBreak +] +--- evaluated --- +document(body: { text(body: [ +]), + text(body: [ +]), + text(body: [ +]), + text(body: [ +]), + text(body: [(a: 6)]), + parbreak() }) diff --git a/test/out/regression/issue26.out b/test/out/regression/issue26.out new file mode 100644 --- /dev/null +++ b/test/out/regression/issue26.out @@ -0,0 +1,68 @@ +--- parse tree --- +[ Code + "test/typ/regression/issue26.typ" + ( line 1 , column 2 ) + (Let + (BasicBind (Just (Identifier "test"))) + (FuncExpr + [ NormalParam (Identifier "x") , NormalParam (Identifier "y") ] + (Block + (CodeBlock + [ If + [ ( Equals (Ident (Identifier "x")) (Ident (Identifier "y")) + , Block (Content [ Text "\9989" ]) + ) + , ( Literal (Boolean True) + , Block + (Content + [ Text "\10060" + , Text "(" + , Code + "test/typ/regression/issue26.typ" + ( line 1 , column 47 ) + (FuncCall + (Ident (Identifier "repr")) + [ NormalArg (Ident (Identifier "x")) ]) + , Space + , Text "/" + , Text "=" + , Space + , Code + "test/typ/regression/issue26.typ" + ( line 1 , column 59 ) + (FuncCall + (Ident (Identifier "repr")) + [ NormalArg (Ident (Identifier "y")) ]) + , Text ")" + ]) + ) + ] + ])))) +, SoftBreak +, Code + "test/typ/regression/issue26.typ" + ( line 2 , column 2 ) + (Let + (BasicBind (Just (Identifier "x"))) + (Dict [ Reg ( Ident (Identifier "a") , Literal (Int 4) ) ])) +, SoftBreak +, Code + "test/typ/regression/issue26.typ" + ( line 3 , column 2 ) + (Block + (CodeBlock + [ Assign + (FuncCall + (FieldAccess (Ident (Identifier "at")) (Ident (Identifier "x"))) + [ NormalArg (Literal (String "b")) ]) + (Literal (Int 5)) + ])) +, SoftBreak +, Code + "test/typ/regression/issue26.typ" + ( line 6 , column 2 ) + (Ident (Identifier "x")) +, ParBreak +] +"test/typ/regression/issue26.typ" (line 3, column 2): +Dictionary does not contain key "b" diff --git a/test/out/text/lorem-01.out b/test/out/text/lorem-01.out --- a/test/out/text/lorem-01.out +++ b/test/out/text/lorem-01.out @@ -95,9 +95,7 @@ , Block (CodeBlock [ FuncCall (Ident (Identifier "parbreak")) [] - , Assign - (Binding (BasicBind (Just (Identifier "used")))) - (Literal (Int 0)) + , Assign (Ident (Identifier "used")) (Literal (Int 0)) ]) ) ] diff --git a/test/out/text/space-00.out b/test/out/text/space-00.out --- a/test/out/text/space-00.out +++ b/test/out/text/space-00.out @@ -125,9 +125,7 @@ [ Code "test/typ/text/space-00.typ" ( line 8 , column 28 ) - (Assign - (Binding (BasicBind (Just (Identifier "c")))) - (Literal (Boolean False))) + (Assign (Ident (Identifier "c")) (Literal (Boolean False))) , Text "O" ]))) , Space @@ -148,9 +146,7 @@ (Ident (Identifier "c")) (Block (CodeBlock - [ Assign - (Binding (BasicBind (Just (Identifier "c")))) - (Literal (Boolean False)) + [ Assign (Ident (Identifier "c")) (Literal (Boolean False)) , Literal (String "R") ]))) , Space diff --git a/test/typ/regression/issue25.typ b/test/typ/regression/issue25.typ new file mode 100644 --- /dev/null +++ b/test/typ/regression/issue25.typ @@ -0,0 +1,6 @@ +#let x = (a: 5) +#let key = "a" +#{ + x.at(key) = 6 +} +#x diff --git a/test/typ/regression/issue26.typ b/test/typ/regression/issue26.typ new file mode 100644 --- /dev/null +++ b/test/typ/regression/issue26.typ @@ -0,0 +1,5 @@ +#let x = (a: 4) +#{ + x.at("b") = 5 +} +#x 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.5 +version: 0.5.0.1 synopsis: Parsing and evaluating typst syntax. description: A library for parsing and evaluating typst syntax. Typst () is a document layout and @@ -75,8 +75,7 @@ regex-tdfa, array, time, - pretty, - digits + pretty hs-source-dirs: src if os(darwin) cpp-options: -D__MACOS__